diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 7ae0ce831..eecb37d4c 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -144,12 +144,15 @@ CourseFilterRegistered: Registriert CourseFilterNone: Egal CourseDeleteQuestion: Wollen Sie den unten aufgeführten Kurs wirklich löschen? CourseDeleted: Kurs gelöscht +CourseUserTutorials: Angemeldete Tutorien CourseUserNote: Notiz CourseUserNoteTooltip: Nur für Dozenten dieses Kurses einsehbar CourseUserNoteSaved: Notizänderungen gespeichert CourseUserNoteDeleted: Teilnehmernotiz gelöscht CourseUserDeregister: Vom Kurs abmelden CourseUsersDeregistered count@Int64: #{show count} Teilnehmer vom Kurs abgemeldet +CourseUserRegisterTutorial: Zu einem Tutorium anmelden +CourseUsersTutorialRegistered count@Int64: #{show count} Teilnehmer zum Tutorium angemeldet CourseUserSendMail: Mitteilung verschicken TutorialUserDeregister: Vom Tutorium Abmelden TutorialUserSendMail: Mitteilung verschicken diff --git a/src/CryptoID.hs b/src/CryptoID.hs index 803ccd64d..1f6c3bf0d 100644 --- a/src/CryptoID.hs +++ b/src/CryptoID.hs @@ -50,6 +50,7 @@ decCryptoIDs [ ''SubmissionId , ''CourseId , ''CourseNewsId , ''CourseEventId + , ''TutorialId ] -- CryptoIDNamespace (CI FilePath) SubmissionId ~ "Submission" diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index bd1f80e12..d70bc1983 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -116,6 +116,14 @@ colUserComment tid ssh csh = where courseLink = CourseR tid ssh csh . CUserR +colUserTutorials :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) +colUserTutorials tid ssh csh = sortable (Just "tutorials") (i18nCell MsgCourseUserTutorials) + $ \(view _userTutorials -> tuts') -> + let tuts = sortOn (tutorialName . entityVal) $ (tuts' ^. _1) ++ (tuts' ^.. _2 . folded . _Just) + in (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell tuts $ anchorCell' + (\(Entity _ Tutorial{..}) -> CTutorialR tid ssh csh tutorialName TUsersR) + (tutorialName . entityVal) + colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) colUserSemester = sortable (Just "semesternr") (i18nCell MsgStudyFeatureAge) $ foldMap numCell . preview _rowUserSemester @@ -219,7 +227,9 @@ userTableCsvHeader UserCsvExportData{..} tuts = Csv.header $ regGroups = Set.toList $ setOf (folded . _entityVal . _tutorialRegGroup . _Just) tuts -data CourseUserAction = CourseUserSendMail | CourseUserDeregister +data CourseUserAction = CourseUserSendMail + | CourseUserDeregister + | CourseUserRegisterTutorial deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) instance Universe CourseUserAction @@ -231,6 +241,9 @@ data CourseUserActionData = CourseUserSendMailData | CourseUserDeregisterData { deregisterReason :: Maybe Text } + | CourseUserRegisterTutorialData + { registerTutorial :: TutorialId + } deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -260,7 +273,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do let regGroups = setOf (folded . _entityVal . _tutorialRegGroup . _Just) tutorials tuts' = filter (\(Entity tutId _) -> any ((== tutId) . tutorialParticipantTutorial . entityVal) tuts'') tutorials - tuts = foldr (\tut@(Entity _ Tutorial{..}) -> maybe (over _1 $ cons tut) (over _2 . flip (Map.insertWith (<|>)) (Just tut)) tutorialRegGroup) ([], Map.fromSet (const Nothing) regGroups) regGroups) tuts' + tuts = foldr (\tut@(Entity _ Tutorial{..}) -> maybe (over _1 $ cons tut) (over _2 . flip (Map.insertWith (<|>)) (Just tut)) tutorialRegGroup) ([], Map.fromSet (const Nothing) regGroups) tuts' return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms), tuts) dbtColonnade = colChoices dbtSorting = Map.fromList @@ -280,6 +293,13 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote) return . E.max_ $ edit E.^. CourseUserNoteEditTime ) + , ("tutorials" , SortColumn $ queryUser >>> \user -> + E.sub_select . E.from $ \(tutorial `E.InnerJoin` participant) -> do + E.on $ tutorial E.^. TutorialId E.==. participant E.^. TutorialParticipantTutorial + E.&&. tutorial E.^. TutorialCourse E.==. E.val cid + E.where_ $ participant E.^. TutorialParticipantUser E.==. user E.^. UserId + return . E.min_ $ tutorial E.^. TutorialName + ) ] dbtFilter = Map.fromList [ fltrUserNameLink queryUser @@ -407,20 +427,26 @@ postCUsersR tid ssh csh = do (Entity cid course, numParticipants, (participantRes,participantTable)) <- runDB $ do mayRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR ent@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh - let colChoices = mconcat - [ dbSelect (applying _2) id (return . view (hasEntity . _entityKey)) - , colUserNameLink (CourseR tid ssh csh . CUserR) - , colUserEmail - , colUserMatriclenr - , colUserDegreeShort - , colUserField - , colUserSemester - , sortable (Just "registration") (i18nCell MsgRegisteredSince) (dateCell . view _userTableRegistration) - , colUserComment tid ssh csh + hasTutorials <- exists [TutorialCourse ==. cid] + let colChoices = mconcat $ catMaybes + [ pure $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey)) + , pure $ colUserNameLink (CourseR tid ssh csh . CUserR) + , pure $ colUserEmail + , pure $ colUserMatriclenr + , pure $ colUserDegreeShort + , pure $ colUserField + , pure $ colUserSemester + , guardOn hasTutorials $ colUserTutorials tid ssh csh + , pure $ sortable (Just "registration") (i18nCell MsgRegisteredSince) (dateCell . view _userTableRegistration) + , pure $ colUserComment tid ssh csh ] psValidator = def & defaultSortingByName acts = mconcat [ singletonMap CourseUserSendMail $ pure CourseUserSendMailData + , singletonMap CourseUserRegisterTutorial $ CourseUserRegisterTutorialData <$> + apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersistCryptoId [TutorialCourse ==. cid] [Asc TutorialName] tutorialName) + (fslI MsgCourseTutorial) + Nothing , if | mayRegister -> singletonMap CourseUserDeregister $ courseUserDeregisterForm cid @@ -448,6 +474,11 @@ postCUsersR tid ssh csh = do return 1 addMessageI Success $ MsgCourseUsersDeregistered nrDel redirect $ CourseR tid ssh csh CUsersR + (CourseUserRegisterTutorialData{..}, selectedUsers) -> do + runDB . forM_ selectedUsers $ + void . insertUnique . TutorialParticipant registerTutorial + addMessageI Success . MsgCourseUsersTutorialRegistered . fromIntegral $ Set.size selectedUsers + redirect $ CourseR tid ssh csh CUsersR let headingLong = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{tid}|] headingShort = prependCourseTitle tid ssh csh MsgCourseMembers siteLayout headingLong $ do diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index ddd9893bb..b4af46bc7 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -46,7 +46,7 @@ postTUsersR tid ssh csh tutn = do ] psValidator = def & defaultSortingByName - & restrictSorting (\name _ -> none (== name) ["note"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information + & restrictSorting (\name _ -> none (== name) ["note", "registration", "tutorials"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information isInTut q = E.exists . E.from $ \tutorialParticipant -> E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser q E.^. UserId E.&&. tutorialParticipant E.^. TutorialParticipantTutorial E.==. E.val tutid diff --git a/templates/i18n/changelog/de.hamlet b/templates/i18n/changelog/de.hamlet index d08b60e2b..aa982c1a3 100644 --- a/templates/i18n/changelog/de.hamlet +++ b/templates/i18n/changelog/de.hamlet @@ -1,5 +1,12 @@ $newline never
+
+ ^{formatGregorianW 2019 10 10} +
+