diff --git a/ChangeLog.md b/ChangeLog.md index c1ce2db41..f35e0e155 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ + * Version 27.03.2019 + + Kurse Veranstalter können nun mehrere Dozenten und Assistenten selbst eintragen + + Erfassung Studiengangsdaten + * Version 20.03.2019 Kursanmeldung benötigen assoziertes Hauptfach (für Studierende mit mehreren Hauptfächern) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 463937f70..b82d83a28 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -103,7 +103,7 @@ CourseUserNoteDeleted: Teilnehmernotiz gelöscht CourseLecturers: Kursverwalter CourseLecturer: Dozent CourseAssistant: Assistent -CourseLecturerAlreadyAdded email@UserEmail: Es gibt bereits einen Kursverwalter mit E-Mail #{email} +CourseLecturerAlreadyAdded email@UserEmail: Es gibt bereits einen Kursverwalter mit E-Mail #{email} NoSuchTerm tid@TermId: Semester #{display tid} gibt es nicht. NoSuchSchool ssh@SchoolId: Institut #{display ssh} gibt es nicht. @@ -363,6 +363,8 @@ AccessRightsFor: Berechtigungen für AdminFor: Administrator LecturerFor: Dozent LecturersFor: Dozenten +AssistantFor: Assistent +AssistantsFor: Assistenten ForSchools n@Int: für #{pluralDE n "Institut" "Institute"} UserListTitle: Komprehensive Benutzerliste AccessRightsSaved: Berechtigungsänderungen wurden gespeichert. diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index e7fa74ea1..ad59f17bb 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -270,7 +270,7 @@ getTermCourseListR tid = do getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCShowR tid ssh csh = do mbAid <- maybeAuthId - (course,schoolName,participants,registration,defSFid,lecturers) <- runDB . maybeT notFound $ do + (course,schoolName,participants,registration,defSFid,lecturers,assistants) <- runDB . maybeT notFound $ do [(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)] <- lift . E.select . E.from $ \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do @@ -286,12 +286,17 @@ getCShowR tid ssh csh = do return ( E.countRows :: E.SqlExpr (E.Value Int)) return (course,school E.^. SchoolName, numParticipants, participant) defSFid <- ifMaybeM mbAid Nothing $ \uid -> lift $ selectFirst [StudyFeaturesUser ==. uid, StudyFeaturesType ==. FieldPrimary, StudyFeaturesValid ==. True] [Desc StudyFeaturesUpdated, Desc StudyFeaturesDegree, Desc StudyFeaturesField] -- sorting by degree & field is an heuristic only, but this is okay for a default suggestion - lecturers <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do + staff <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ] - return (user E.^. UserDisplayName, user E.^. UserSurname, user E.^. UserEmail) - return (course,schoolName,participants,registration,entityKey <$> defSFid,lecturers) + return ( lecturer E.^. LecturerType + , user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname) + let partStaff :: (LecturerType, UserEmail, Text, Text) -> Either (UserEmail, Text, Text) (UserEmail, Text, Text) + partStaff (CourseLecturer ,name,surn,mail) = Right (name,surn,mail) + partStaff (_courseAssistant,name,surn,mail) = Left (name,surn,mail) + (assistants,lecturers) = partitionWith partStaff $ map $(unValueN 4) staff + return (course,schoolName,participants,registration,entityKey <$> defSFid,lecturers,assistants) mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index f795bb5eb..7683950d1 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -7,7 +7,7 @@ import Import import qualified Data.Text as T -- import qualified Data.Set (Set) import qualified Data.Set as Set -import Data.CaseInsensitive (CI, original) +import Data.CaseInsensitive (original) -- import qualified Data.CaseInsensitive as CI import Language.Haskell.TH (Q, Exp) @@ -49,12 +49,16 @@ nameWidget :: Text -- ^ userDisplayName nameWidget displayName surname = toWidget $ nameHtml displayName surname -- | toWidget-Version of @nameEmailHtml@, for convenience -nameEmailWidget :: CI Text -- ^ userEmail +nameEmailWidget :: UserEmail -- ^ userEmail -> Text -- ^ userDisplayName -> Text -- ^ userSurname -> Widget nameEmailWidget email displayName surname = toWidget $ nameEmailHtml email displayName surname +-- | uncurried Version for @nameEmailWidget@ needed in hamlet, where TH cannot be used +nameEmailWidget' :: (UserEmail, Text, Text)-> Widget +nameEmailWidget' = $(uncurryN 3) nameEmailWidget + -- | Show user's displayName, highlighting the surname if possible. -- Otherwise appends the surname in parenthesis nameHtml :: Text -> Text -> Html @@ -76,18 +80,18 @@ nameHtml displayName surname -- | Like nameHtml just show a users displayname with hightlighted surname, -- but also wrap the name with a mailto-link -nameEmailHtml :: CI Text -> Text -> Text -> Html +nameEmailHtml :: UserEmail -> Text -> Text -> Html nameEmailHtml email displayName surname = wrapMailto email $ nameHtml displayName surname -- | Wrap mailto around given Html using single hamlet-file for consistency -wrapMailto :: CI Text -> Html -> Html +wrapMailto :: UserEmail -> Html -> Html wrapMailto (original -> email) linkText | null email = linkText | otherwise = $(shamletFile "templates/widgets/link-email.hamlet") -- | Just show an email address in a standard way, for convenience inside hamlet files. -mailtoHtml :: CI Text -> Html +mailtoHtml :: UserEmail -> Html mailtoHtml email = wrapMailto email $ toHtml email -- | Generic i18n text for "edited at sometime by someone" diff --git a/src/Utils.hs b/src/Utils.hs index 1139ba7f2..018babd9d 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -320,6 +320,14 @@ mergeAttrs = mergeAttrs' `on` sort mergeAttrs' xs1 [] = xs1 +-- | Copied form Util from package ghc +partitionWith :: (a -> Either b c) -> [a] -> ([b], [c]) +-- ^ Uses a function to determine which of two output lists an input element should join +partitionWith _ [] = ([],[]) +partitionWith f (x:xs) = case f x of + Left b -> (b:bs, cs) + Right c -> (bs, c:cs) + where (bs,cs) = partitionWith f xs ---------- -- Sets -- @@ -530,10 +538,11 @@ ifM c m m' = do b <- c if b then m else m' --- | @ifNotM mc = ifM (not <$> mc)@ +-- | @ifNotM mc = ifM (not <$> mc)@ from Agda.Utils.Monad ifNotM :: Monad m => m Bool -> m a -> m a -> m a ifNotM c = flip $ ifM c +-- | Monadic boolean function, copied from Andreas Abel's utility function and2M, or2M :: Monad m => m Bool -> m Bool -> m Bool and2M ma mb = ifM ma mb (return False) or2M ma = ifM ma (return True) diff --git a/templates/course.hamlet b/templates/course.hamlet index 5ce025a4d..917a8271d 100644 --- a/templates/course.hamlet +++ b/templates/course.hamlet @@ -19,8 +19,18 @@