From 134f18641d626e5afd21b667da6637b4305c9634 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 24 Feb 2025 17:10:54 +0100 Subject: [PATCH] chore(profile): show examiners in profile data, towards #2347 --- .../courses/courses/de-de-formal.msg | 2 +- .../categories/courses/courses/en-eu.msg | 2 +- .../personal_settings/de-de-formal.msg | 3 +- .../settings/personal_settings/en-eu.msg | 3 +- src/Handler/Course/User.hs | 2 +- src/Handler/Course/Users.hs | 9 ++-- src/Handler/News.hs | 6 +-- src/Handler/Profile.hs | 53 ++++++++++++------- src/Handler/Term.hs | 8 +-- src/Handler/Utils/Table/Cells.hs | 36 ++++++------- src/Handler/Utils/Table/Columns.hs | 6 +-- templates/profileData.hamlet | 4 +- 12 files changed, 73 insertions(+), 61 deletions(-) diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index 002b7a6ae..60115f17f 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -244,7 +244,7 @@ UtilEditedBy name@Text time@Text: #{time} durch #{name} CourseDate: Datum MailSubjectLecturerInvitation tid@TermId ssh@SchoolId csh@CourseShorthand: [#{tid}-#{ssh}-#{csh}] Einladung als Kursverwalter:in LecturerInvitationAccepted lType@Text csh@CourseShorthand: Sie wurden als #{lType} für #{csh} eingetragen -CourseExamRegistrationTime: Angemeldet seit +CourseExamRegistrationTime: Angemeldet am CourseParticipantStateIsActiveFilter: Ansicht CourseApply: Zur Kursart bewerben CourseAdministrator: Kursadministrator:in diff --git a/messages/uniworx/categories/courses/courses/en-eu.msg b/messages/uniworx/categories/courses/courses/en-eu.msg index bb3f231fb..5e6262c3d 100644 --- a/messages/uniworx/categories/courses/courses/en-eu.msg +++ b/messages/uniworx/categories/courses/courses/en-eu.msg @@ -243,7 +243,7 @@ UtilEditedBy name time: #{time} by #{name} CourseDate: Date MailSubjectLecturerInvitation tid ssh csh: [#{tid}-#{ssh}-#{csh}] Invitation to be a course administrator LecturerInvitationAccepted lType csh: You were registered as #{lType} for #{csh} -CourseExamRegistrationTime: Registered since +CourseExamRegistrationTime: Registered on CourseParticipantStateIsActiveFilter: View CourseApply: Apply for course CourseAdministrator: Course administrator diff --git a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg b/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg index 96c3cee2b..e0946ee3a 100644 --- a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg +++ b/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022 Gregor Kleen ,Steffen Jost ,Winnie Ros +# SPDX-FileCopyrightText: 2022-25 Gregor Kleen ,Steffen Jost ,Winnie Ros ,Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -19,6 +19,7 @@ ProfileSubmissionGroups: Abgabegruppen ProfileSubmissions: Abgaben ProfileRemark: Hinweis ProfileQualifications: Eigene Qualifikationen +ProfileEnrolledExams: Angemeldete Prüfungen PersonalInfoExamAchievementsWip: Die Anzeige von Prüfungsergebnissen wird momentan an dieser Stelle leider noch nicht unterstützt. PersonalInfoOwnTutorialsWip: Die Anzeige von Kurse, zu denen Sie als Ausbilder eingetragen sind wird momentan an dieser Stelle leider noch nicht unterstützt. PersonalInfoTutorialsWip: Die Anzeige von Kurse, zu denen Sie angemeldet sind wird momentan an dieser Stelle leider noch nicht unterstützt. diff --git a/messages/uniworx/categories/settings/personal_settings/en-eu.msg b/messages/uniworx/categories/settings/personal_settings/en-eu.msg index 9a1974d2a..97aae6f85 100644 --- a/messages/uniworx/categories/settings/personal_settings/en-eu.msg +++ b/messages/uniworx/categories/settings/personal_settings/en-eu.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022 Steffen Jost ,Winnie Ros +# SPDX-FileCopyrightText: 2022-25 Steffen Jost ,Winnie Ros ,Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later @@ -19,6 +19,7 @@ ProfileSubmissionGroups: Submission groups ProfileSubmissions: Submissions ProfileRemark: Remarks ProfileQualifications: Owned Qualifications +ProfileEnrolledExams: Enrolled Exams PersonalInfoExamAchievementsWip: The feature to display your exam achievements has not yet been implemented. PersonalInfoOwnTutorialsWip: The feature to display courses you have been assigned to as instructor has not yet been implemented. PersonalInfoTutorialsWip: The feature to display courses you have registered for has not yet been implemented. diff --git a/src/Handler/Course/User.hs b/src/Handler/Course/User.hs index 25b8bf904..feea4c118 100644 --- a/src/Handler/Course/User.hs +++ b/src/Handler/Course/User.hs @@ -307,7 +307,7 @@ courseUserExamsSection (Entity cid Course{..}) (Entity uid _) = do [ dbSelect (_2 . applying _2) _1 $ return . view (_dbrOutput . _1 . _entityKey) , sortable (Just "name") (i18nCell MsgTableExamName) $ tellCell (Any True, mempty) . anchorCell' (\(view $ _dbrOutput . _1 . _entityVal -> Exam{..}) -> CExamR courseTerm courseSchool courseShorthand examName EShowR) (view $ _dbrOutput . _1 . _entityVal . _examName) , sortable (Just "occurrence") (i18nCell MsgTableExamOccurrence) $ maybe mempty (cell . toWidget) . preview (_dbrOutput . _2 . _Just . _entityVal . _examOccurrenceName) - , sortable (Just "registration-time") (i18nCell MsgCourseExamRegistrationTime) $ maybe mempty (cell . formatTimeW SelFormatDateTime) . preview (_dbrOutput . _5 . _Just . _entityVal . _examRegistrationTime) + , sortable (Just "registration-time") (i18nCell MsgCourseExamRegistrationTime) $ foldMap dateTimeCell . preview (_dbrOutput . _5 . _Just . _entityVal . _examRegistrationTime) , sortable (Just "bonus") (i18nCell MsgExamBonusAchieved) $ maybe mempty i18nCell . preview (_dbrOutput . _3 . _Just . _entityVal . _examBonusBonus) , sortable (Just "result") (i18nCell MsgTableExamResult) $ maybe mempty i18nCell . preview (_dbrOutput . _4 . _Just . _entityVal . _examResultResult) ] diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 0453bab02..8f881fc81 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -178,17 +178,16 @@ colUserExamOccurrences :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand colUserExamOccurrences _tid _ssh _csh = sortable (Just "exam-occurrences") (i18nCell MsgCourseUserExamOccurrences) $ \(view _userExamOccurrences -> exams') -> let exams = sortOn (examOccurrenceName . entityVal) exams' - in (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) $ listCell exams - (\(Entity _ ExamOccurrence{..}) -> wgtCell [whamlet|#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|]) + in (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) $ listCell exams examOccurrenceCell colUserExamOccurrencesCheck :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) colUserExamOccurrencesCheck _tid _ssh _csh = sortable (Just "exam-occurrences") (i18nCell MsgCourseUserExamOccurrences) $ \(view _userExamOccsDblExaminers -> exams') -> let exams = sortOn (examOccurrenceName . entityVal .fst) exams' in (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) $ listCell exams - (\(Entity _ ExamOccurrence{..}, dblExmnr) -> wgtCell $ do - warnExaminer <- foldMapM (fmap messageTooltip . messageI Warning . MsgExaminerReocurrence) dblExmnr - [whamlet|^{warnExaminer}#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|] + (\(exOcc, dblExmnr) -> + let warnExaminer :: Widget = foldMapM (messageTooltip <=< messageI Warning . MsgExaminerReocurrence) dblExmnr + in wgtCell warnExaminer <> examOccurrenceCell exOcc ) colUserExamOccurrencesCheckDB :: (IsDBTable (MForm Handler) c, MonadHandler (DBCell (MForm Handler)), HandlerSite (DBCell (MForm Handler)) ~ UniWorX) -- this type seems to be unusable+ diff --git a/src/Handler/News.hs b/src/Handler/News.hs index 2ac689c39..e8c6d920a 100644 --- a/src/Handler/News.hs +++ b/src/Handler/News.hs @@ -153,7 +153,7 @@ newsUpcomingSheets uid = do , sortable (Just "sheet") (i18nCell MsgTableSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } -> anchorCell (CSheetR tid ssh csh shn SShowR) shn , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value mDeadline, _) } -> - maybe mempty (cell . formatTimeW SelFormatDateTime) mDeadline + cellMaybe dateTimeCell mDeadline , sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } -> case mbsid of Nothing -> cell $ do @@ -277,9 +277,9 @@ newsUpcomingExams uid = do , sortable (Just "register-to") (i18nCell MsgTableExamRegisterTo) $ \DBRow { dbrOutput = view lensExam -> Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo , sortable (Just "time") (i18nCell MsgTableExamTime) $ \DBRow{ dbrOutput } -> if | Just (Entity _ ExamOccurrence{..}) <- preview lensOccurrence dbrOutput - -> cell $ formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd + -> rangeCell examOccurrenceStart examOccurrenceEnd | Entity _ Exam{..} <- view lensExam dbrOutput - , Just start <- examStart -> cell $ formatTimeRangeW SelFormatDateTime start examEnd + , Just start <- examStart -> rangeCell start examEnd | otherwise -> mempty {- NOTE: We do not want thoughtless exam registrations, since many people click "register" and don't show up, causing logistic problems. Hence we force them here to click twice. Maybe add a captcha where users have to distinguish pictures showing pink elephants and course lecturers. diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 37d611034..1035954cd 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -1,11 +1,11 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Winnie Ros +-- SPDX-FileCopyrightText: 2022-25 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Winnie Ros ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later {-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity and HasUser instances -{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} -- TODO, only for develop -{-# OPTIONS_GHC -fno-warn-unused-local-binds #-} -- TODO, only for develop +-- OPTIONS_GHC -fno-warn-unused-top-binds -- only for develop +-- OPTIONS_GHC -fno-warn-unused-local-binds -- only for develop module Handler.Profile ( getProfileR, postProfileR @@ -681,6 +681,7 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do submissionGroupTable <- mkSubmissionGroupTable uid -- Tabelle mit allen Abgabegruppen correctionsTable <- mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben qualificationsTable <- mkQualificationsTable now uid -- Tabelle mit allen Qualifikationen + examsTable <- mkExamsTable uid -- Tabelle mit allen angemeldeten Prüfungen und Prüfern supervisorsTable <- mkSupervisorsTable uid -- Tabelle mit allen Supervisors superviseesTable <- mkSuperviseesTable actualPrefersPostal uid -- Tabelle mit allen Supervisees countUnderlings <- E.select $ do @@ -805,7 +806,7 @@ mkEnrolledCoursesTable uid = do <*> view _courseSchool , sortable (Just "course") (i18nCell MsgTableCourse) $ courseCell <$> view (_dbrOutput . _1 . _entityVal) - , sortable (Just "time") (i18nCell MsgProfileRegistered) $ do + , sortable (Just "time") (i18nCell MsgCourseExamRegistrationTime) $ do regTime <- view $ _dbrOutput . _2 return $ dateTimeCell regTime , sortable Nothing (i18nCell MsgCourseTutorials) $ \(view $ _dbrOutput . _1 -> Entity{entityKey=cid, entityVal=Course{..}}) -> @@ -1049,57 +1050,72 @@ mkCorrectionsTable = type TblExamsExpr = ( E.SqlExpr ( Entity Course) `E.InnerJoin` E.SqlExpr ( Entity Exam) `E.InnerJoin` E.SqlExpr ( Entity ExamRegistration) + `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamResult)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity ExamOccurrence)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) ) -- due to GHC staging restrictions, we use the preprocessor instead -#define TABLE_EXAMS_JOIN "IILL" +#define TABLE_EXAMS_JOIN "IILLL" -type TblExamsData = DBRow (Entity Course, Entity Exam, Entity ExamRegistration, Maybe (Entity ExamOccurrence), Maybe (Entity User)) +type TblExamsData = DBRow (Entity Course, Entity Exam, Entity ExamRegistration, Maybe (Entity ExamResult), Maybe (Entity ExamOccurrence), Maybe (Entity User)) -- | Table listing all exams that the given user is enrolled in mkExamsTable :: UserId -> DB (Bool, Widget) mkExamsTable = let dbtIdent = "exams-user" :: Text dbtStyle = def - dbtSQLQuery' uid (crs `E.InnerJoin` exm `E.InnerJoin` reg `E.LeftOuterJoin` occ `E.LeftOuterJoin` xmr) = do + dbtSQLQuery' uid (crs `E.InnerJoin` exm `E.InnerJoin` reg `E.LeftOuterJoin` res `E.LeftOuterJoin` occ `E.LeftOuterJoin` xmr) = do EL.on $ xmr E.?. UserId E.==. E.joinV (occ E.?. ExamOccurrenceExaminer) EL.on $ reg E.^. ExamRegistrationOccurrence E.==. occ E.?. ExamOccurrenceId + EL.on $ reg E.^. ExamRegistrationExam E.=?. res E.?. ExamResultExam + E.&&. reg E.^. ExamRegistrationUser E.=?. res E.?. ExamResultUser + E.&&. E.isJust (exm E.^. ExamFinished) EL.on $ reg E.^. ExamRegistrationExam E.==. exm E.^. ExamId EL.on $ crs E.^. CourseId E.==. exm E.^. ExamCourse E.where_ $ reg E.^. ExamRegistrationUser E.==. E.val uid - return (crs,exm,reg,occ,xmr) + return (crs,exm,reg,res,occ,xmr) queryCourse :: TblExamsExpr -> E.SqlExpr (Entity Course) queryCourse = $(sqlMIXproj TABLE_EXAMS_JOIN 1) queryExam :: TblExamsExpr -> E.SqlExpr (Entity Exam) queryExam = $(sqlMIXproj TABLE_EXAMS_JOIN 2) queryRegistration :: TblExamsExpr -> E.SqlExpr (Entity ExamRegistration) queryRegistration = $(sqlMIXproj TABLE_EXAMS_JOIN 3) + queryResult :: TblExamsExpr -> E.SqlExpr (Maybe (Entity ExamResult)) + queryResult = $(sqlMIXproj TABLE_EXAMS_JOIN 4) queryOccurrence :: TblExamsExpr -> E.SqlExpr (Maybe (Entity ExamOccurrence)) - queryOccurrence = $(sqlMIXproj TABLE_EXAMS_JOIN 4) + queryOccurrence = $(sqlMIXproj TABLE_EXAMS_JOIN 5) queryExaminer :: TblExamsExpr -> E.SqlExpr (Maybe (Entity User)) - queryExaminer = $(sqlMIXproj TABLE_EXAMS_JOIN 5) + queryExaminer = $(sqlMIXproj TABLE_EXAMS_JOIN 6) resultCourse :: Lens' TblExamsData (Entity Course) resultCourse = _dbrOutput . _1 resultExam :: Lens' TblExamsData (Entity Exam) resultExam = _dbrOutput . _2 resultRegistration :: Lens' TblExamsData (Entity ExamRegistration) resultRegistration = _dbrOutput . _3 + resultExamResult :: Traversal' TblExamsData ExamResult + resultExamResult = _dbrOutput . _4 . _Just . _entityVal resultOccurrence :: Traversal' TblExamsData (Entity ExamOccurrence) - resultOccurrence = _dbrOutput . _4 . _Just + resultOccurrence = _dbrOutput . _5 . _Just resultExaminer :: Traversal' TblExamsData (Entity User) - resultExaminer = _dbrOutput . _5 . _Just + resultExaminer = _dbrOutput . _6 . _Just dbtRowKey = queryRegistration >>> (E.^. ExamRegistrationId) dbtProj = dbtProjId dbtColonnade = mconcat - [ sortable (Just "course") (i18nCell MsgTableCourse) $ fmap addIndicatorCell courseCell <$> view (resultCourse . _entityVal) - , sortable (Just "exam") (i18nCell MsgCourseExam) $ \row -> examCell (row ^. resultCourse . _entityVal) (row ^. resultExam . _entityVal) + [ sortable (Just "course") (i18nCell MsgTableCourse) $ fmap addIndicatorCell courseCell <$> view (resultCourse . _entityVal) + , sortable (Just "exam") (i18nCell MsgCourseExam) $ \row -> examCell (row ^. resultCourse . _entityVal) (row ^. resultExam . _entityVal) + , sortable (Just "registration")(i18nCell MsgCourseExamRegistrationTime)$ dateCell . view (resultRegistration . _entityVal . _examRegistrationTime) + , sortable (Just "occurrence") (i18nCell MsgTableExamOccurrence) $ foldMap examOccurrenceCell . preview resultOccurrence + , sortable (Just "tester") (i18nCell MsgExamCorrectors) $ foldMap cellHasUser . preview resultExaminer + , sortable (Just "result") (i18nCell MsgTableExamResult) $ foldMap i18nCell . preview (resultExamResult . _examResultResult) ] - validator = def + validator = def & defaultSorting [SortAscBy "course", SortAscBy "exam", SortAscBy "tester"] -- [SortDescBy "registration"] dbtSorting = Map.fromList - [ ( "course", SortColumn $ queryCourse >>> (E.^. CourseName)) - , ( "exam" , SortColumn $ queryExam >>> (E.^. ExamName)) - -- TODO: continue here + [ ( "course" , SortColumn $ queryCourse >>> (E.^. CourseName)) + , ( "exam" , SortColumn $ queryExam >>> (E.^. ExamName)) + , ( "registration", SortColumn $ queryRegistration >>> (E.^. ExamRegistrationTime)) + , ( "occurrence" , SortColumn $ queryOccurrence >>> (E.?. ExamOccurrenceName)) + , ( "tester" , SortColumn $ queryExaminer >>> (E.?. UserDisplayName)) + , ( "result" , SortColumn $ queryResult >>> (E.?. ExamResultResult)) ] dbtFilter = mempty dbtFilterUI = mempty @@ -1111,7 +1127,6 @@ mkExamsTable = in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..} - -- | Table listing all qualifications that the given user is enrolled in mkQualificationsTable :: UTCTime -> UserId -> DB Widget mkQualificationsTable = diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index db52a96e1..569abfb37 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -64,17 +64,17 @@ getTermShowR = do #{iconMenuAdmin} |] , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_,_) - -> cell $ formatTime SelFormatDate termLectureStart >>= toWidget + -> dayCell termLectureStart , sortable (Just "lecture-end") (i18nCell MsgTermLectureEnd) $ \(Entity _ Term{..},_,_) - -> cell $ formatTime SelFormatDate termLectureEnd >>= toWidget + -> dayCell termLectureEnd , sortable Nothing (i18nCell MsgTermActive) $ \(_, _, E.Value isActive) -> tickmarkCell isActive , sortable Nothing (i18nCell MsgTermCourseCount) $ \(_, E.Value numCourses, _) -> cell [whamlet|_{MsgNumCourses numCourses}|] , sortable (Just "start") (i18nCell MsgTermStart) $ \(Entity _ Term{..},_, _) - -> cell $ formatTime SelFormatDate termStart >>= toWidget + -> dayCell termStart , sortable (Just "end") (i18nCell MsgTermEnd) $ \(Entity _ Term{..},_, _) - -> cell $ formatTime SelFormatDate termEnd >>= toWidget + -> dayCell termEnd , sortable Nothing (i18nCell MsgTermHolidays) $ \(Entity _ Term{..},_, _) -> cell $ do let termHolidays' = groupHolidays termHolidays diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 4545c88ea..3e6ff7337 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -183,6 +183,10 @@ markupCellLargeModal mup | markupIsSmallish mup = cell $ toWidget mup | otherwise = modalCell mup +addModalDescriptionCell :: IsDBTable m a => Maybe StoredMarkup -> DBCell m a +addModalDescriptionCell = foldMap ((spacerCell <>) . markupCellLargeModal) + + ----------------- -- Datatype cells timeCell :: IsDBTable m a => UTCTime -> DBCell m a @@ -194,6 +198,9 @@ dateTimeCell t = cell $ formatTimeW SelFormatDateTime t dateCell :: IsDBTable m a => UTCTime -> DBCell m a dateCell t = cell $ formatTimeW SelFormatDate t +rangeCell :: (IsDBTable m a, HasLocalTime t, HasLocalTime t') => t -> Maybe t' -> DBCell m a +rangeCell = (cell .) . formatTimeRangeW SelFormatDateTime + dayCell :: IsDBTable m a => Day -> DBCell m a dayCell utctDay = cell $ formatTimeW SelFormatDate UTCTime{..} where utctDayTime = 0 @@ -377,30 +384,21 @@ courseCellCL (tid,ssh,csh) = anchorCell link name name = toWgt csh courseCell :: IsDBTable m a => Course -> DBCell m a -courseCell Course{..} = anchorCell link name `mappend` desc +courseCell Course{..} = anchorCell link name <> addModalDescriptionCell courseDescription where link = CourseR courseTerm courseSchool courseShorthand CShowR name = citext2widget courseName - desc = case courseDescription of - Nothing -> mempty - (Just descr) -> cell [whamlet| - $newline never -
- ^{modal "Beschreibung" (Right $ toWidget descr)} - |] examCell :: IsDBTable m a => Course -> Exam -> DBCell m a -examCell Course{..} Exam{..} = anchorCell link name `mappend` desc +examCell Course{..} Exam{..} = anchorCell link name <> addModalDescriptionCell examDescription where link = CExamR courseTerm courseSchool courseShorthand examName EShowR name = citext2widget examName - desc = case examDescription of - Nothing -> mempty - (Just descr) -> cell [whamlet| - $newline never -
- ^{modal "Beschreibung" (Right $ toWidget descr)} - |] + +examOccurrenceCell :: IsDBTable m a => Entity ExamOccurrence -> DBCell m a +examOccurrenceCell Entity{entityVal = ExamOccurrence{..}} = + wgtCell [whamlet|#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|] + -- also see Handler.Utils.Widgets.companyWidget companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a @@ -449,11 +447,7 @@ qualificationShortCell (view hasQualification -> Qualification{..}) = anchorCell name = citext2widget qualificationShorthand qualificationDescrCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c -qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualificationCell q <> desc - where - desc = case qualificationDescription of - Nothing -> mempty - (Just descr) -> spacerCell <> markupCellLargeModal descr +qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualificationCell q <> addModalDescriptionCell qualificationDescription qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c qualificationValidIconCell d qb qu = do diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index 91605cbb5..37cac957e 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -166,7 +166,7 @@ colExamClosed :: OpticColonnade (Maybe UTCTime) colExamClosed resultClosed = Colonnade.singleton (fromSortable header) body where header = Sortable (Just "exam-closed") (i18nCell MsgUtilExamClosed) - body = views resultClosed $ maybe mempty (cell . formatTimeW SelFormatDateTime) + body = views resultClosed $ foldMap dateTimeCell sortExamClosed :: OpticSortColumn (Maybe UTCTime) sortExamClosed queryClosed = singletonMap "exam-closed" . SortColumn $ view queryClosed @@ -175,13 +175,13 @@ colExamFinished :: OpticColonnade (Maybe UTCTime) colExamFinished resultFinished = Colonnade.singleton (fromSortable header) body where header = Sortable (Just "exam-finished") (i18nCell MsgTableExamFinished) - body = views resultFinished $ maybe mempty (cell . formatTimeW SelFormatDateTime) + body = views resultFinished $ foldMap dateTimeCell colExamFinishedOffice :: OpticColonnade (Maybe UTCTime) colExamFinishedOffice resultFinished = Colonnade.singleton (fromSortable header) body where header = Sortable (Just "exam-finished") (i18nCell MsgExamFinishedOffice) - body = views resultFinished $ maybe mempty (cell . formatTimeW SelFormatDateTime) + body = views resultFinished $ foldMap dateTimeCell sortExamFinished :: OpticSortColumn (Maybe UTCTime) sortExamFinished queryFinished = singletonMap "exam-finished" . SortColumn $ view queryFinished diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index 363bb0739..a0c5d7f8d 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -1,6 +1,6 @@ $newline never -$# SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Steffen Jost ,Winnie Ros +$# SPDX-FileCopyrightText: 2022-25 Gregor Kleen ,Sarah Vaupel ,Steffen Jost ,Winnie Ros ,Steffen Jost $# $# SPDX-License-Identifier: AGPL-3.0-or-later @@ -210,6 +210,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

_{MsgProfileQualifications}
^{qualificationsTable} + + ^{maybeTable MsgProfileEnrolledExams examsTable} ^{maybeTable MsgProfileCourses ownedCoursesTable}