feat(course-users): exams in dbtable and csv
This commit is contained in:
Sarah Vaupel
Gregor Kleen
parent
c795ee97f4
commit
c23becceb1
@ -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)
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user