From c23becceb1ef994a39204ab3df083f1bbc857c27 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Mon, 10 Feb 2020 13:21:27 +0100 Subject: [PATCH] feat(course-users): exams in dbtable and csv --- messages/uniworx/de-de-formal.msg | 2 ++ messages/uniworx/en-eu.msg | 2 ++ src/Handler/Course/Users.hs | 30 +++++++++++++++++++++++++++--- 3 files changed, 31 insertions(+), 3 deletions(-) diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 39b865efb..1a6b54a2d 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -158,6 +158,7 @@ BoolIrrelevant: — CourseDeleteQuestion: Wollen Sie den unten aufgeführten Kurs wirklich löschen? CourseDeleted: Kurs gelöscht CourseUserTutorials: Angemeldete Tutorien +CourseUserExams: Angemeldete Prüfungen CourseUserNote: Notiz CourseUserNoteTooltip: Nur für Verwalter dieses Kurses einsehbar CourseUserNoteSaved: Notizänderungen gespeichert @@ -1798,6 +1799,7 @@ 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". +CsvColumnUserExam: Prüfungen zu denen der Teilnehmer angemeldet ist, als Semikolon (;) separierte Liste. CsvColumnExamOfficeExamUserOccurrenceStart: Prüfungstermin (ISO 8601) diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 365496721..2b76cc741 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -159,6 +159,7 @@ CourseDeleteQuestion: Are you sure you want to delete the below-mentioned course CourseDeleted: Course deleted CourseUserRegister: Enrol for course CourseUserTutorials: Registered tutorials +CourseUserExams: Registered exams CourseUserNote: Note CourseUserNoteTooltip: Only visible to administrators of this course CourseUserNoteSaved: Successfully saved note changes @@ -1797,6 +1798,7 @@ CsvColumnUserSemester: Semester the participant is in wrt. to their associated f CsvColumnUserRegistration: Time of participant's enrollment (ISO 8601) CsvColumnUserNote: Course notes for the participant CsvColumnUserTutorial: Tutorials which the user is registered for, separated by semicolon (;). For each registration group among the tutorials there is a separate column. The registration group columns contain at most one tutorial per participant. If every tutorial has a registration group there is no column "tutorial". +CsvColumnUserExam: Exams which the user is registered for, separated by semicolon (;). CsvColumnExamOfficeExamUserOccurrenceStart: Exam occurrence (ISO 8601) diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index a3a0ee89b..551aeb679 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -82,6 +82,7 @@ type UserTableData = DBRow ( Entity User , Maybe CourseUserNoteId , (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms) , ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial))) + , [Entity Exam] ) instance HasEntity UserTableData User where @@ -106,11 +107,14 @@ _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester _userTutorials :: Lens' UserTableData ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial))) _userTutorials = _dbrOutput . _5 +_userExams :: Lens' UserTableData [Entity Exam] +_userExams = _dbrOutput . _6 + 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 @@ -124,6 +128,14 @@ colUserTutorials tid ssh csh = sortable (Just "tutorials") (i18nCell MsgCourseUs (\(Entity _ Tutorial{..}) -> CTutorialR tid ssh csh tutorialName TUsersR) (tutorialName . entityVal) +colUserExams :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) +colUserExams tid ssh csh = sortable (Just "exams") (i18nCell MsgCourseUserExams) + $ \(view _userExams -> exams') -> + let exams = sortOn (examName . entityVal) exams' + in (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell exams $ anchorCell' + (\(Entity _ Exam{..}) -> CExamR tid ssh csh examName EUsersR) + (examName . entityVal) + colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c) colUserSemester = sortable (Just "semesternr") (i18nCell MsgStudyFeatureAge) $ foldMap numCell . preview _rowUserSemester @@ -165,6 +177,7 @@ data UserTableCsv = UserTableCsv , csvUserRegistration :: UTCTime , csvUserNote :: Maybe Html , csvUserTutorials :: ([TutorialName], Map (CI Text) (Maybe TutorialName)) + , csvUserExams :: [ExamName] } deriving (Eq, Ord, Read, Show, Generic, Typeable) makeLenses_ ''UserTableCsv @@ -193,6 +206,9 @@ instance Csv.ToNamedRecord UserTableCsv where [ encodeUtf8 (CI.foldedCase regGroup) Csv..= (CI.original <$> mTut) | (regGroup, mTut) <- Map.toList $ csvUserTutorials ^. _2 ] ++ + [ let examsStr = Text.intercalate "; " $ map CI.original csvUserExams + in "exams" Csv..= examsStr + ] ++ [ "registration" Csv..= csvUserRegistration , "note" Csv..= csvUserNote ] @@ -207,6 +223,7 @@ instance CsvColumnsExplained UserTableCsv where , single "degree" MsgCsvColumnUserDegree , single "semester" MsgCsvColumnUserSemester , single "tutorial" MsgCsvColumnUserTutorial + , single "exams" MsgCsvColumnUserExam , single "registration" MsgCsvColumnUserRegistration , single "note" MsgCsvColumnUserNote ] @@ -228,7 +245,7 @@ userTableCsvHeader showSex UserCsvExportData{..} tuts = Csv.header $ ] ++ bool (pure "study-features") ["field", "degree", "semester"] csvUserSimplifiedFeaturesOfStudy ++ [ "tutorial" | hasEmptyRegGroup ] ++ map (encodeUtf8 . CI.foldedCase) regGroups ++ - [ "registration", "note" + [ "exams", "registration", "note" ] where hasEmptyRegGroup = has (folded . _entityVal . _tutorialRegGroup . _Nothing) tuts @@ -271,6 +288,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do Course{..} <- getJust cid csvName <- getMessageRender <*> pure (MsgCourseUserCsvName courseTerm courseSchool courseShorthand) tutorials <- selectList [ TutorialCourse ==. cid ] [] + exams <- selectList [ ExamCourse ==. cid ] [] -- -- psValidator has default sorting and filtering showSex <- getShowSex let dbtIdent = "courseUsers" :: Text @@ -279,11 +297,13 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do dbtRowKey = queryUser >>> (E.^. UserId) dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> do tuts'' <- lift $ selectList [ TutorialParticipantUser ==. entityKey user, TutorialParticipantTutorial <-. map entityKey tutorials ] [] + exams' <- lift $ selectList [ ExamRegistrationUser ==. entityKey user ] [] 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) tuts' - return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms), tuts) + exs = filter (\(Entity eId _) -> any ((== eId) . examRegistrationExam . entityVal) exams') exams + return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms), tuts, exs) dbtColonnade = colChoices dbtSorting = mconcat [ single $ sortUserNameLink queryUser -- slower sorting through clicking name column header @@ -409,6 +429,8 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do <*> view _userTableRegistration <*> userNote <*> (over (_2.traverse._Just) (tutorialName . entityVal) . over (_1.traverse) (tutorialName . entityVal) <$> view _userTutorials) + -- <*> (over (_2.traverse._Just) (examName . entityVal) . over (_1.traverse) (examName . entityVal) <$> view _userExams) + <*> (over traverse (examName . entityVal) <$> view _userExams) , dbtCsvName = unpack csvName , dbtCsvNoExportData = Nothing , dbtCsvHeader = return . Vector.filter csvColumns' . flip (userTableCsvHeader showSex) tutorials . fromMaybe def @@ -445,6 +467,7 @@ postCUsersR tid ssh csh = do mayRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR ent@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh hasTutorials <- exists [TutorialCourse ==. cid] + hasExams <- exists [ExamCourse ==. cid] let colChoices = mconcat $ catMaybes [ pure $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey)) , pure $ colUserNameLink (CourseR tid ssh csh . CUserR) @@ -455,6 +478,7 @@ postCUsersR tid ssh csh = do , pure $ colUserField , pure $ colUserSemester , guardOn hasTutorials $ colUserTutorials tid ssh csh + , guardOn hasExams $ colUserExams tid ssh csh , pure $ sortable (Just "registration") (i18nCell MsgRegisteredSince) (dateCell . view _userTableRegistration) , pure $ colUserComment tid ssh csh ]