From 1d5ddd102ce49c83ab0b45cf2be590f76ca0f0d0 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 10 Oct 2019 11:19:45 +0200 Subject: [PATCH 001/292] feat(course-users): include tutorial in csv-export --- messages/uniworx/de.msg | 1 + src/Handler/Course/Users.hs | 147 +++++++++++++++++++++------------- src/Handler/Tutorial/Users.hs | 3 +- src/Utils/Lens.hs | 2 + 4 files changed, 98 insertions(+), 55 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 514420c38..7ae0ce831 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -1559,6 +1559,7 @@ CsvColumnUserDegree: Abschluss, den der Teilnehmer im assoziierten Studienfach a CsvColumnUserSemester: Fachsemester des Teilnehmers im assoziierten Studienfach CsvColumnUserRegistration: Zeitpunkt der Anmeldung zum Kurs (ISO 8601) CsvColumnUserNote: Notizen zum Teilnehmer +CsvColumnUserTutorial: Tutorien zu denen der Teilnehmer angemeldet ist, als Semikolon (;) separierte Liste. Für Registrierungs-Gruppen unter den Tutorien gibt es jeweils eine weitere Spalte. Die Registrierungs-Gruppen-Spalten enthalten jeweils maximal ein Tutorium pro Teilnehmer. Sind alle Tutorien in Registrierungs-Gruppen, so gibt es keine Spalte "tutorial". CsvColumnExamOfficeExamUserOccurrenceStart: Prüfungstermin (ISO 8601) diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 7fce82abf..bd1f80e12 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -19,6 +19,7 @@ import Data.Function ((&)) import qualified Data.Set as Set import qualified Data.Map as Map import qualified Data.Text as Text +import qualified Data.Vector as Vector import qualified Database.Esqueleto as E @@ -26,11 +27,17 @@ import qualified Data.Csv as Csv import qualified Data.Conduit.List as C +import qualified Data.CaseInsensitive as CI -type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) - `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote)) - `E.LeftOuterJoin` - (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin`E.SqlExpr (Maybe (Entity StudyTerms))) + +type UserTableExpr = ( E.SqlExpr (Entity User) + `E.InnerJoin` E.SqlExpr (Entity CourseParticipant) + ) + `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote)) + `E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity StudyFeatures)) + `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) + `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)) + ) -- forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a) -- forceUserTableType = id @@ -70,7 +77,12 @@ userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.L return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features) -type UserTableData = DBRow (Entity User, UTCTime, Maybe CourseUserNoteId, (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)) +type UserTableData = DBRow ( Entity User + , UTCTime + , Maybe CourseUserNoteId + , (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms) + , ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial))) + ) instance HasEntity UserTableData User where hasEntity = _dbrOutput . _1 @@ -91,11 +103,14 @@ _userTableFeatures = _dbrOutput . _4 _rowUserSemester :: Traversal' UserTableData Int _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester +_userTutorials :: Lens' UserTableData ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial))) +_userTutorials = _dbrOutput . _5 + colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) colUserComment tid ssh csh = sortable (Just "note") (i18nCell MsgCourseUserNote) - $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey,_) } -> + $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey, _, _) } -> maybeEmpty mbNoteKey $ const $ anchorCellM (courseLink <$> encrypt uid) (hasComment True) where @@ -137,6 +152,7 @@ data UserTableCsv = UserTableCsv , csvUserStudyFeatures :: Either (Maybe UserTableCsvStudyFeature) (Set UserTableCsvStudyFeature) , csvUserRegistration :: UTCTime , csvUserNote :: Maybe Html + , csvUserTutorials :: ([TutorialName], Map (CI Text) (Maybe TutorialName)) } deriving (Eq, Ord, Read, Show, Generic, Typeable) makeLenses_ ''UserTableCsv @@ -158,6 +174,12 @@ instance Csv.ToNamedRecord UserTableCsv where in [ "study-features" Csv..= featsStr ] ++ + [ let tutsStr = Text.intercalate "; " . map CI.original $ csvUserTutorials ^. _1 + in "tutorial" Csv..= tutsStr + ] ++ + [ encodeUtf8 (CI.foldedCase regGroup) Csv..= (CI.original <$> mTut) + | (regGroup, mTut) <- Map.toList $ csvUserTutorials ^. _2 + ] ++ [ "registration" Csv..= csvUserRegistration , "note" Csv..= csvUserNote ] @@ -170,6 +192,7 @@ instance CsvColumnsExplained UserTableCsv where , single "field" MsgCsvColumnUserField , single "degree" MsgCsvColumnUserDegree , single "semester" MsgCsvColumnUserSemester + , single "tutorial" MsgCsvColumnUserTutorial , single "registration" MsgCsvColumnUserRegistration , single "note" MsgCsvColumnUserNote ] @@ -183,12 +206,17 @@ newtype UserCsvExportData = UserCsvExportData instance Default UserCsvExportData where def = UserCsvExportData True -userTableCsvHeader :: UserCsvExportData -> Csv.Header -userTableCsvHeader UserCsvExportData{..} = Csv.header $ +userTableCsvHeader :: UserCsvExportData -> [Entity Tutorial] -> Csv.Header +userTableCsvHeader UserCsvExportData{..} tuts = Csv.header $ [ "name", "matriculation", "email" ] ++ bool (pure "study-features") ["field", "degree", "semester"] csvUserSimplifiedFeaturesOfStudy ++ + [ "tutorial" | hasEmptyRegGroup ] ++ + map (encodeUtf8 . CI.foldedCase) regGroups ++ [ "registration", "note" ] + where + hasEmptyRegGroup = has (folded . _entityVal . _tutorialRegGroup . _Nothing) tuts + regGroups = Set.toList $ setOf (folded . _entityVal . _tutorialRegGroup . _Just) tuts data CourseUserAction = CourseUserSendMail | CourseUserDeregister @@ -215,17 +243,25 @@ makeCourseUserTable :: forall h act act'. -> (UserTableExpr -> E.SqlExpr (E.Value Bool)) -> Colonnade h UserTableData (DBCell (MForm Handler) (FormResult (First act', DBFormResult UserId Bool UserTableData))) -> PSValidator (MForm Handler) (FormResult (First act', DBFormResult UserId Bool UserTableData)) + -> Maybe (Csv.Name -> Bool) -> DB (FormResult (act', Set UserId), Widget) -makeCourseUserTable cid acts restrict colChoices psValidator = do +makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do currentRoute <- fromMaybe (error "makeCourseUserTable called from 404-handler") <$> liftHandler getCurrentRoute Course{..} <- getJust cid csvName <- getMessageRender <*> pure (MsgCourseUserCsvName courseTerm courseSchool courseShorthand) + tutorials <- selectList [ TutorialCourse ==. cid ] [] -- -- psValidator has default sorting and filtering let dbtIdent = "courseUsers" :: Text dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtSQLQuery q = userTableQuery cid q <* E.where_ (restrict q) dbtRowKey = queryUser >>> (E.^. UserId) - dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms)) + dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> do + tuts'' <- lift $ selectList [ TutorialParticipantUser ==. entityKey user, TutorialParticipantTutorial <-. map entityKey tutorials ] [] + 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' + return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms), tuts) dbtColonnade = colChoices dbtSorting = Map.fromList [ sortUserNameLink queryUser -- slower sorting through clicking name column header @@ -294,50 +330,53 @@ makeCourseUserTable cid acts restrict colChoices psValidator = do , dbParamsFormResult = id , dbParamsFormIdent = def } - dbtCsvEncode = Just DBTCsvEncode - { dbtCsvExportForm = UserCsvExportData - <$> apopt checkBoxField (fslI MsgUserSimplifiedFeaturesOfStudyCsv & setTooltip MsgUserSimplifiedFeaturesOfStudyCsvTip) (Just $ csvUserSimplifiedFeaturesOfStudy def) - , dbtCsvDoEncode = \UserCsvExportData{..} -> C.mapM $ \(E.Value uid, row) -> flip runReaderT row $ - UserTableCsv - <$> view (hasUser . _userDisplayName) - <*> view (hasUser . _userMatrikelnummer) - <*> view (hasUser . _userEmail) - <*> if - | csvUserSimplifiedFeaturesOfStudy -> fmap Left . runMaybeT $ - UserTableCsvStudyFeature - <$> MaybeT (preview $ _userTableFeatures . _3 . _Just . _studyTermsName . _Just - <> _userTableFeatures . _3 . _Just . _studyTermsKey . to tshow - ) - <*> MaybeT (preview $ _userTableFeatures . _2 . _Just . _studyDegreeName . _Just - <> _userTableFeatures . _2 . _Just . _studyDegreeKey . to tshow - ) - <*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesSemester) - <*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesType) - | otherwise -> Right <$> do - feats <- lift . E.select . E.from $ \(feat `E.InnerJoin` terms `E.InnerJoin` degree) -> do - E.on $ degree E.^. StudyDegreeId E.==. feat E.^. StudyFeaturesDegree - E.on $ terms E.^. StudyTermsId E.==. feat E.^. StudyFeaturesField - let registered = E.exists . E.from $ \participant -> - E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid - E.&&. participant E.^. CourseParticipantUser E.==. E.val uid - E.&&. participant E.^. CourseParticipantField E.==. E.just (feat E.^. StudyFeaturesId) - E.where_ $ registered - E.||. feat E.^. StudyFeaturesValid - E.where_ $ feat E.^. StudyFeaturesUser E.==. E.val uid - return (terms, degree, feat) - return . Set.fromList . flip map feats $ \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> + dbtCsvEncode = do + csvColumns' <- csvColumns + return $ DBTCsvEncode + { dbtCsvExportForm = UserCsvExportData + <$> apopt checkBoxField (fslI MsgUserSimplifiedFeaturesOfStudyCsv & setTooltip MsgUserSimplifiedFeaturesOfStudyCsvTip) (Just $ csvUserSimplifiedFeaturesOfStudy def) + , dbtCsvDoEncode = \UserCsvExportData{..} -> C.mapM $ \(E.Value uid, row) -> flip runReaderT row $ + UserTableCsv + <$> view (hasUser . _userDisplayName) + <*> view (hasUser . _userMatrikelnummer) + <*> view (hasUser . _userEmail) + <*> if + | csvUserSimplifiedFeaturesOfStudy -> fmap Left . runMaybeT $ UserTableCsvStudyFeature - { csvUserField = fromMaybe (tshow studyTermsKey) studyTermsName - , csvUserDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName - , csvUserSemester = studyFeaturesSemester - , csvUserType = studyFeaturesType - } - <*> view _userTableRegistration - <*> userNote - , dbtCsvName = unpack csvName - , dbtCsvNoExportData = Nothing - , dbtCsvHeader = return . userTableCsvHeader . fromMaybe def - } + <$> MaybeT (preview $ _userTableFeatures . _3 . _Just . _studyTermsName . _Just + <> _userTableFeatures . _3 . _Just . _studyTermsKey . to tshow + ) + <*> MaybeT (preview $ _userTableFeatures . _2 . _Just . _studyDegreeName . _Just + <> _userTableFeatures . _2 . _Just . _studyDegreeKey . to tshow + ) + <*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesSemester) + <*> MaybeT (preview $ _userTableFeatures . _1 . _Just . _studyFeaturesType) + | otherwise -> Right <$> do + feats <- lift . E.select . E.from $ \(feat `E.InnerJoin` terms `E.InnerJoin` degree) -> do + E.on $ degree E.^. StudyDegreeId E.==. feat E.^. StudyFeaturesDegree + E.on $ terms E.^. StudyTermsId E.==. feat E.^. StudyFeaturesField + let registered = E.exists . E.from $ \participant -> + E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid + E.&&. participant E.^. CourseParticipantUser E.==. E.val uid + E.&&. participant E.^. CourseParticipantField E.==. E.just (feat E.^. StudyFeaturesId) + E.where_ $ registered + E.||. feat E.^. StudyFeaturesValid + E.where_ $ feat E.^. StudyFeaturesUser E.==. E.val uid + return (terms, degree, feat) + return . Set.fromList . flip map feats $ \(Entity _ StudyTerms{..}, Entity _ StudyDegree{..}, Entity _ StudyFeatures{..}) -> + UserTableCsvStudyFeature + { csvUserField = fromMaybe (tshow studyTermsKey) studyTermsName + , csvUserDegree = fromMaybe (tshow studyDegreeKey) studyDegreeName + , csvUserSemester = studyFeaturesSemester + , csvUserType = studyFeaturesType + } + <*> view _userTableRegistration + <*> userNote + <*> (over (_2.traverse._Just) (tutorialName . entityVal) . over (_1.traverse) (tutorialName . entityVal) <$> view _userTutorials) + , dbtCsvName = unpack csvName + , dbtCsvNoExportData = Nothing + , dbtCsvHeader = return . Vector.filter csvColumns' . flip userTableCsvHeader tutorials . fromMaybe def + } where userNote = runMaybeT $ do noteId <- MaybeT . preview $ _userTableNote . _Just @@ -389,7 +428,7 @@ postCUsersR tid ssh csh = do -> mempty ] numParticipants <- count [CourseParticipantCourse ==. cid] - table <- makeCourseUserTable cid acts (const E.true) colChoices psValidator + table <- makeCourseUserTable cid acts (const E.true) colChoices psValidator (Just $ const True) return (ent, numParticipants, table) formResult participantRes $ \case (CourseUserSendMailData, selectedUsers) -> do diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 4c33dd1ee..ddd9893bb 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -50,9 +50,10 @@ postTUsersR tid ssh csh tutn = do 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 + csvColChoices = flip elem ["name", "matriculation", "email", "field", "degree", "semester", "study-features"] cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh - table <- makeCourseUserTable cid (Map.fromList $ map (id &&& pure) universeF) isInTut colChoices psValidator + table <- makeCourseUserTable cid (Map.fromList $ map (id &&& pure) universeF) isInTut colChoices psValidator (Just csvColChoices) return (tut, table) formResult participantRes $ \case diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 234ab1075..4ed056e10 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -208,6 +208,8 @@ makeLenses_ ''CourseUserExamOfficeOptOut makeLenses_ ''CourseNewsFile makeLenses_ ''AllocationCourse + +makeLenses_ ''Tutorial -- makeClassy_ ''Load From d507d9bbdea035d2d83050e5a0bbf61a73ae3161 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 10 Oct 2019 11:58:38 +0200 Subject: [PATCH 002/292] feat(course-users): allow registering tutorial users manually include tutorials in course-user csv-export --- messages/uniworx/de.msg | 3 ++ src/CryptoID.hs | 1 + src/Handler/Course/Users.hs | 55 +++++++++++++++++++++++------- src/Handler/Tutorial/Users.hs | 2 +- templates/i18n/changelog/de.hamlet | 7 ++++ 5 files changed, 55 insertions(+), 13 deletions(-) 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} +
+