fix(day): fix #2347 by adding repeated examiner check to day consistency check for day exam occurrences

Makefile

@@ -69,13 +69,18 @@ clean:
 	-rm -rf .stack-work .stack-work.lock
 	-rm -rf bin .Dockerfile develop
 	-$(CONTAINER_COMMAND) container prune --force
-.PHONY: clean-all
-# HELP: like clean but with full container, image, and volume prune
-clean-all: clean
-	-rm -rf .stack
+.PHONY: clean-images
+# HELP: stop all running containers and clean all images from local repositories
+clean-images:
+	rm -rf develop
+	sleep 5
 	-$(CONTAINER_COMMAND) system prune --all --force --volumes
 	-$(CONTAINER_COMMAND) image prune --all --force
 	-$(CONTAINER_COMMAND) volume prune --force
+.PHONY: clean-all
+# HELP: like clean but with full container, image, and volume prune
+clean-all: clean-images
+	-rm -rf .stack
 
 .PHONY: release
 # HELP: create, commit and push a new release

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

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

messages/uniworx/categories/courses/exam/exam/de-de-formal.msg

@@ -73,6 +73,7 @@ ExamCorrectorEmail: E-Mail
 ExamCorrectors: Prüfer:innen
 ExamCorrectorsTip: Hier eingetragene Prüfer:innen können zwischen Beginn der Prüfung und "Bewertung abgeschlossen ab" Ergebnisse für alle Teilprüfungen und alle Teilnehmer:innen im System hinterlegen.
 ExamCorrectorAlreadyAdded: Ein Prüfer:innen mit dieser E-Mail ist bereits für diese Prüfung eingetragen
+ExamParticipant: Prüfungsteilnehmer:in
 ExamRoom: Raum
 ExamRoomManual': Keine automatische bzw. selbstständige Zuteilung
 ExamRoomSurname': Nach Nachname
@@ -226,6 +227,8 @@ ExamOccurrencesEdited num@Int del@Int: #{pluralENsN num "Prüfungstermin"} geän
 ExamOccurrenceCopyNoStartDate: Dieser Kurs hat noch keine eigene Termine um Prüfungstermine zeitlich damit zu assoziieren
 ExamOccurrenceCopyFail: Keine passenden Prüfungstermine zum Kopieren gefunden
 ExaminerReocurrence examiner@Text: Mehrfache Prüfung durch #{examiner}!
+ExamProblemReoccurrence: Prüfungen mit wiederholt gleichem Prüfer
+ExamNoProblemReoccurrence: Heute keine Prüfungen mit wiederholtem Prüfer.
 GradingFrom: Ab
 ExamNoShow: Nicht erschienen
 ExamVoided: Entwertet

messages/uniworx/categories/courses/exam/exam/en-eu.msg

@@ -73,6 +73,7 @@ ExamCorrectorEmail: Email
 ExamCorrectors: Examiner
 ExamCorrectorsTip: Examiners configured here may, after the start of the exam and until "Results visible from", enter exam part results for all exam parts and participants.
 ExamCorrectorAlreadyAdded: An examiner with this email address already exists
+ExamParticipant: Examinee
 ExamRoom: Room
 ExamRoomManual': No automatic or autonomous assignment
 ExamRoomSurname': By surname
@@ -226,6 +227,8 @@ ExamOccurrencesEdited num del: #{pluralENsN num "exam occurrence"} edited #{guar
 ExamOccurrenceCopyNoStartDate: This course needs its own occurrence to copy associated exam occurrences.
 ExamOccurrenceCopyFail: No suitable exam occurrences found to copy from.
 ExaminerReocurrence examiner: Multiple examinations by #{examiner}!
+ExamProblemReoccurrence: Exams with reoccurring examiner
+ExamNoProblemReoccurrence: Today there are no exams with a reoccurring examiner.
 GradingFrom: From
 
 #templates widgets/bonus-rule

messages/uniworx/categories/settings/personal_settings/de-de-formal.msg

@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+# SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 #
 # 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.

messages/uniworx/categories/settings/personal_settings/en-eu.msg

@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+# SPDX-FileCopyrightText: 2022-25 Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 #
 # 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.

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)
           ]

src/Handler/Course/Users.hs

@@ -10,7 +10,7 @@ module Handler.Course.Users
   , postCUsersR, getCUsersR
   , colUserSex'
   , colUserQualifications, colUserQualificationBlocked
-  , colUserExams, colUserExamOccurrences, colUserExamOccurrencesCheck, colUserExamOccurrencesCheckDB
+  , colUserExams, colUserExamOccurrences, colUserExamOccurrencesCheck
   , _userQualifications
   ) where
 
@@ -24,7 +24,7 @@ import Handler.Utils.Company
 import qualified Database.Esqueleto.Legacy      as E
 import qualified Database.Esqueleto.Utils       as E
 import qualified Database.Esqueleto.PostgreSQL  as E
-import qualified Database.Esqueleto.Experimental as X (from,on,table,innerJoin,leftJoin)
+import qualified Database.Esqueleto.Experimental as X (from,on,table,leftJoin)
 import           Database.Esqueleto.Experimental ((:&)(..))
 
 import Database.Esqueleto.Utils.TH
@@ -178,19 +178,19 @@ 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+
                               => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell (MForm Handler) c)
 colUserExamOccurrencesCheckDB  _tid _ssh _csh = sortable (Just "exam-occurrences") (i18nCell MsgCourseUserExamOccurrences)
@@ -215,6 +215,7 @@ colUserExamOccurrencesCheckDB  _tid _ssh _csh = sortable (Just "exam-occurrences
                                 (Just exname) -> messageTooltip <$> messageI Warning (MsgExaminerReocurrence exname)
               [whamlet|^{warnExaminer}#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|]
           )
+-}
 
 colUserSex' :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserSex' = colUserSex $ hasUser . _userSex

src/Handler/Exam/Correct.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -20,6 +20,7 @@ import Handler.Utils.Exam (fetchExam)
 
 import Utils.Exam.Correct
 
+{-# ANN module ("HLint: ignore Functor law" :: String) #-}
 
 -- | Minimum length of a participant identifier. Identifiers that are shorter would result in too many query results and are therefor rejected.
 minNeedleLength :: Int
@@ -72,7 +73,7 @@ postECorrectR tid ssh csh examn = do
     Entity eId Exam{} <- lift $ fetchExam tid ssh csh examn
     euid <- traverse decrypt ciqUser
 
-    guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $ 
+    guardMExceptT (maybe True ((>= minNeedleLength) . length) $ euid ^? _Left) $
       CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
 
     participantMatches <- lift . E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
@@ -84,14 +85,16 @@ postECorrectR tid ssh csh examn = do
         mUserIdent = euid ^? _Left
       E.where_ $ uidMatch
            E.||. (case mUserIdent of
-            Just userIdent -> user E.^. UserSurname E.==. E.val userIdent
-                        E.||. user E.^. UserSurname `E.hasInfix` E.val userIdent
-                        E.||. user E.^. UserFirstName E.==. E.val userIdent
-                        E.||. user E.^. UserFirstName `E.hasInfix` E.val userIdent
-                        E.||. user E.^. UserDisplayName E.==. E.val userIdent
-                        E.||. user E.^. UserDisplayName `E.hasInfix` E.val userIdent
-                        E.||. user E.^. UserMatrikelnummer E.==. E.val mUserIdent
-                        E.||. user E.^. UserMatrikelnummer `E.hasInfix` E.val mUserIdent
+            Just userIdent -> user E.^. UserSurname         E.==.         E.val  userIdent
+                        E.||. user E.^. UserSurname         `E.hasInfix`  E.val  userIdent
+                        E.||. user E.^. UserFirstName       E.==.         E.val  userIdent
+                        E.||. user E.^. UserFirstName       `E.hasInfix`  E.val  userIdent
+                        E.||. user E.^. UserDisplayName     E.==.         E.val  userIdent
+                        E.||. user E.^. UserDisplayName     `E.hasInfix`  E.val  userIdent
+                        E.||. user E.^. UserMatrikelnummer  E.==.         E.val mUserIdent
+                        E.||. user E.^. UserMatrikelnummer  `E.hasInfix`  E.val mUserIdent
+                        E.||. user E.^. UserEmail           E.==.         E.val (userIdent & CI.mk)
+                        E.||. user E.^. UserDisplayEmail    E.==.         E.val (userIdent & CI.mk)
             Nothing -> E.val False)
       E.limit $ succ maxCountUserMatches
       return user
@@ -200,8 +203,8 @@ postECorrectR tid ssh csh examn = do
           , ciraHasMore = length participantMatches > maxCountUserMatches
           , ciraUsers   = Set.fromList users
           }
-  
+
   whenM acceptsJson $
     sendResponseStatus (ciResponseStatus response) $ toJSON response
-  
+
   redirect $ CExamR tid ssh csh examn EShowR

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.

src/Handler/Profile.hs

@@ -1,11 +1,11 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- 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
@@ -46,7 +46,17 @@ import           Database.Esqueleto.Utils.TH
 import qualified Data.Text as Text
 import Data.List (inits)
 
-import qualified Data.CaseInsensitive as CI
+import qualified Data.CaseInsensitive as CI-- data TableHasData = TableHasData{tableHasRows :: Bool, tableWidget :: Widget}
+-- a poor man's record subsitute
+
+{-
+type TableHasData = (Bool, Widget)
+tableHasRows :: TableHasData -> Bool
+tableHasRows = fst
+tableWidget :: TableHasData -> Widget
+tableWidget  = snd
+-}
+
 
 import Jobs
 
@@ -601,41 +611,6 @@ getForProfileDataR cID = do
     setTitleI $ MsgHeadingForProfileData $ userDisplayName user
     dataWidget
 
--- data TableHasData = TableHasData{tableHasRows :: Bool, tableWidget :: Widget}
--- a poor man's record subsitute
-
-{-
-type TableHasData = (Bool, Widget)
-tableHasRows :: TableHasData -> Bool
-tableHasRows = fst
-tableWidget :: TableHasData -> Widget
-tableWidget  = snd
--}
-
--- | Given a header message, a bool and widget; display widget and header only if the boolean is true
-maybeTable :: (RenderMessage UniWorX a)
-           => a -> (Bool, Widget) -> Widget
-maybeTable m = maybeTable' m Nothing Nothing
-
-maybeTable' :: (RenderMessage UniWorX a)
-           => a -> Maybe a -> Maybe Widget -> (Bool, Widget) -> Widget
-maybeTable' _   Nothing       _ (False, _ ) = mempty
-maybeTable' _   (Just nodata) _ (False, _ ) =
-  [whamlet|
-    <div .container>
-      _{nodata}
-  |]
-maybeTable' hdr _ mbRemark      (True ,tbl) =
-  [whamlet|
-    <div .container>
-      <h2> _{hdr}
-      <div .container>
-        ^{tbl}
-        $maybe remark <- mbRemark
-          <em>_{MsgProfileRemark}
-          \ ^{remark}
-  |]
-
 
 makeProfileData :: Entity User -> DB Widget
 makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do
@@ -681,6 +656,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 +781,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 +1025,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 +1102,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 =

src/Handler/School/DayTasks.hs

@@ -353,7 +353,7 @@ colParkingField = colParkingField' _dailyFormParkingToken
 
 colParkingField' :: ASetter' a Bool -> Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
 colParkingField' l dday = sortable (Just "parking") (i18nCell $ MsgTableUserParkingToken dday) $ (cellAttrs %~ addAttrsClass "text--center") <$> formCell
-  id -- TODO: this should not be id! Refactor to simplify the thrid argument below
+  id -- TODO: this should not be id! Refactor to simplify the third argument below
   (views (resultParticipant . _entityKey) return)
   (\(preview (resultUserDay . _userDayParkingToken) -> parking) mkUnique ->
     over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
@@ -709,7 +709,7 @@ getSchoolDayCheckR ssh nd = do
   let nowaday = utctDay now
   dday <- formatTime SelFormatDate nd
 
-  (tuts, parts_avs) <- runDB $ do
+  (tuts, parts_avs, examProblemsTbl) <- runDB $ do
     tuts <- getDayTutorials ssh (nd,nd)
     parts_avs :: [ParticipantCheckData] <- $(unValueNIs 5 [2..5]) <<$>> E.select (do
         (tpa :& usr :& avs :& cmp) <- E.from $  E.table @TutorialParticipant
@@ -725,7 +725,9 @@ getSchoolDayCheckR ssh nd = do
       )
     -- additionally queue proper AVS synchs for all users, unless there were already done today
     void $ queueAvsUpdateByUID (foldMap (^. _1 . _entityVal . _tutorialParticipantUser . to Set.singleton) parts_avs) (Just nowaday)
-    return (tuts, parts_avs)
+    -- check for double examiners
+    examProblemsTbl <- mkExamProblemsTable ssh nd
+    return (tuts, parts_avs, examProblemsTbl)
   let getApi :: ParticipantCheckData -> Set AvsPersonId
       getApi = foldMap Set.singleton . view _4
   avsStats :: Map AvsPersonId AvsDataPerson <- catchAVShandler False False True mempty $ lookupAvsUsers $ foldMap getApi parts_avs -- query AVS, but does not affect DB (no update)
@@ -772,16 +774,104 @@ getSchoolDayCheckR ssh nd = do
                     $forall ((_udn,pid),pcd) <- Map.toList badis
                       <li>
                         ^{mkBaddieWgt pid pcd}
-        <p>
-          ^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))}
+        <section>
+          <p>
+            <h4 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
+              _{MsgPossibleCheckResults}
+            <p>
+              <ul>
+                $forall msg <- dcrMessages
+                  <li>_{msg}
+            <p>
+              _{MsgAvsUpdateDayCheck}
       <section>
-        <p>
-          <h4 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
-            _{MsgPossibleCheckResults}
-          <p>
-            <ul>
-              $forall msg <- dcrMessages
-                <li>_{msg}
-          <p>
-            _{MsgAvsUpdateDayCheck}
-    |]
+        ^{maybeTable' MsgExamProblemReoccurrence (Just MsgExamNoProblemReoccurrence) Nothing examProblemsTbl}
+      <section>
+        ^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))}
+    |]
+
+
+type TblExamPrbsExpr = (                E.SqlExpr (Entity Course)
+                      `E.InnerJoin`     E.SqlExpr (Entity Exam)
+                      `E.InnerJoin`     E.SqlExpr (Entity ExamRegistration)
+                      `E.InnerJoin`     E.SqlExpr (Entity ExamOccurrence)
+                      `E.InnerJoin`     E.SqlExpr (Entity User)
+                      `E.InnerJoin`     E.SqlExpr (Entity User)
+                    )
+type TblExamPrbsData = DBRow (Entity Course, Entity Exam, Entity ExamRegistration, Entity ExamOccurrence, Entity User, Entity User)
+
+-- | Table listing double examiner problems for a given school and day
+mkExamProblemsTable :: SchoolId -> Day -> DB (Bool, Widget)
+mkExamProblemsTable =
+  let dbtIdent = "exams-user" :: Text
+      dbtStyle = def
+      dbtSQLQuery' exOccs (crs `E.InnerJoin` exm `E.InnerJoin` reg `E.InnerJoin` occ `E.InnerJoin` usr `E.InnerJoin` xmr) = do
+        EL.on $ xmr E.^. UserId                     E.=?. occ E.^. ExamOccurrenceExaminer
+        EL.on $ usr E.^. UserId                     E.==. reg E.^. ExamRegistrationUser
+        EL.on $ occ E.^. ExamOccurrenceId           E.=?. reg E.^. ExamRegistrationOccurrence
+        EL.on $ exm E.^. ExamId                     E.==. reg E.^. ExamRegistrationExam
+        EL.on $ exm E.^. ExamCourse                 E.==. crs E.^. CourseId
+        E.where_ $ occ E.^. ExamOccurrenceId `E.in_` E.vals exOccs
+            E.&&.  E.exists (do
+                altReg :& altOcc <- E.from $ E.table @ExamRegistration `E.innerJoin` E.table @ExamOccurrence
+                                    `E.on` (\(altReg :& altOcc) -> altReg E.^. ExamRegistrationOccurrence E.?=. altOcc E.^. ExamOccurrenceId)
+                E.where_ $ altReg E.^. ExamRegistrationUser   E.==. reg E.^. ExamRegistrationUser
+                    E.&&.  altReg E.^. ExamRegistrationId     E.!=. reg E.^. ExamRegistrationId
+                    E.&&.  altOcc E.^. ExamOccurrenceExaminer E.==. occ E.^. ExamOccurrenceExaminer
+                    E.&&.  altOcc E.^. ExamOccurrenceId       E.!=. occ E.^. ExamOccurrenceId
+              )
+        return (crs,exm,reg,occ,usr,xmr)
+      queryExmCourse    :: TblExamPrbsExpr -> E.SqlExpr (Entity Course)
+      queryExmCourse    = $(sqlIJproj 6 1)
+      queryExam         :: TblExamPrbsExpr -> E.SqlExpr (Entity Exam)
+      queryExam         = $(sqlIJproj 6 2)
+      queryRegistration :: TblExamPrbsExpr -> E.SqlExpr (Entity ExamRegistration)
+      queryRegistration = $(sqlIJproj 6 3)
+      queryOccurrence   :: TblExamPrbsExpr -> E.SqlExpr (Entity ExamOccurrence)
+      queryOccurrence   = $(sqlIJproj 6 4)
+      queryTestee       :: TblExamPrbsExpr -> E.SqlExpr (Entity User)
+      queryTestee       = $(sqlIJproj 6 5)
+      queryExaminer     :: TblExamPrbsExpr -> E.SqlExpr (Entity User)
+      queryExaminer     = $(sqlIJproj 6 6)
+      resultExmCourse     :: Lens' TblExamPrbsData (Entity Course)
+      resultExmCourse     = _dbrOutput . _1
+      resultExam          :: Lens' TblExamPrbsData (Entity Exam)
+      resultExam          = _dbrOutput . _2
+      resultRegistration  :: Lens' TblExamPrbsData (Entity ExamRegistration)
+      resultRegistration  = _dbrOutput . _3
+      resultOccurrence    :: Lens' TblExamPrbsData (Entity ExamOccurrence)
+      resultOccurrence    = _dbrOutput . _4
+      resultTestee        :: Lens' TblExamPrbsData (Entity User)
+      resultTestee        = _dbrOutput . _5
+      resultExaminer      :: Lens' TblExamPrbsData (Entity User)
+      resultExaminer      = _dbrOutput . _6
+      dbtRowKey = queryRegistration >>> (E.^. ExamRegistrationId)
+      dbtProj   = dbtProjId
+      dbtColonnade = mconcat
+          [ sortable (Just "course")      (i18nCell MsgTableCourse)               $ fmap addIndicatorCell courseCell <$> view (resultExmCourse . _entityVal)
+          , sortable (Just "exam")        (i18nCell MsgCourseExam)                $ \row -> examCell (row ^. resultExmCourse . _entityVal) (row ^. resultExam . _entityVal)
+          , sortable (Just "registration")(i18nCell MsgCourseExamRegistrationTime)$ dateCell . view (resultRegistration . _entityVal . _examRegistrationTime)
+          , sortable (Just "occurrence")  (i18nCell MsgTableExamOccurrence)       $ examOccurrenceCell              . view  resultOccurrence
+          , sortable (Just "testee")      (i18nCell MsgExamParticipant)           $ cellHasUserLink ForProfileDataR . view  resultTestee
+          , sortable (Just "examiner")    (i18nCell MsgExamCorrectors)            $ cellHasUser                     . view  resultExaminer
+          ]
+      validator = def & defaultSorting [SortAscBy "course", SortAscBy "exam", SortAscBy "testee"] -- [SortDescBy "registration"]
+      dbtSorting  = Map.fromList
+          [ ( "course"      , SortColumn $ queryExmCourse     >>> (E.^. CourseName))
+          , ( "exam"        , SortColumn $ queryExam          >>> (E.^. ExamName))
+          , ( "registration", SortColumn $ queryRegistration  >>> (E.^. ExamRegistrationTime))
+          , ( "occurrence"  , SortColumn $ queryOccurrence    >>> (E.^. ExamOccurrenceName))
+          , ( "testee"      , SortColumn $ queryTestee        >>> (E.^. UserDisplayName))
+          , ( "examiner"    , SortColumn $ queryExaminer      >>> (E.^. UserDisplayName))
+          ]
+      dbtFilter   = mempty
+      dbtFilterUI = mempty
+      dbtParams = def
+      dbtCsvEncode = noCsvEncode
+      dbtCsvDecode = Nothing
+      dbtExtraReps = []
+  in \ssh nd -> do
+    exOccs <- getDayExamOccurrences False ssh Nothing (nd,nd)
+    let dbtSQLQuery = dbtSQLQuery' $ Map.keys exOccs
+    (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
+

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

src/Handler/Utils/Table.hs

@@ -6,6 +6,33 @@ module Handler.Utils.Table
   ( module Handler.Utils.Table
   ) where
 
+import Import hiding (link)
+
 import Handler.Utils.Table.Pagination as Handler.Utils.Table
 import Handler.Utils.Table.Columns as Handler.Utils.Table
 import Handler.Utils.Table.Cells as Handler.Utils.Table
+
+
+-- | Given a header message, a bool and widget; display widget and header only if the boolean is true
+maybeTable :: (RenderMessage UniWorX a)
+           => a -> (Bool, Widget) -> Widget
+maybeTable m = maybeTable' m Nothing Nothing
+
+maybeTable' :: (RenderMessage UniWorX a)
+           => a -> Maybe a -> Maybe Widget -> (Bool, Widget) -> Widget
+maybeTable' _   Nothing       _ (False, _ ) = mempty
+maybeTable' _   (Just nodata) _ (False, _ ) =
+  [whamlet|
+    <div .container>
+      _{nodata}
+  |]
+maybeTable' hdr _ mbRemark      (True ,tbl) =
+  [whamlet|
+    <div .container>
+      <h2> _{hdr}
+      <div .container>
+        ^{tbl}
+        $maybe remark <- mbRemark
+          <em>_{MsgProfileRemark}
+          \ ^{remark}
+  |]

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
-              <div>
-                ^{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
-              <div>
-                ^{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

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

src/Handler/Utils/Widgets.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -99,14 +99,14 @@ nameHtml displayName surname
           in [shamlet|$newline never
                 #{prefix} #
                 <b .surname>#{surname}
-                \ #{suffix}
+                #{withLeadingSpace suffix}
               |]
         | (suffix:prefixes) <- reverse $ T.splitOn (fullyNormalize surname) (fullyNormalize displayName), notNull prefixes ->
           let prefix = T.intercalate surname $ reverse prefixes
           in [shamlet|$newline never
                 #{prefix} #
                 <b .surname>#{surname}
-                \ #{suffix}
+                #{withLeadingSpace suffix}
               |]
         | otherwise -> [shamlet|$newline never
                             #{displayName} (
@@ -115,15 +115,21 @@ nameHtml displayName surname
       (suffix:prefixes) ->
         let prefix = T.intercalate surname $ reverse prefixes
         in [shamlet|$newline never
-              #{prefix} #
+              #{prefix}
               <b .surname>#{surname}
-              \ #{suffix}
+              #{withLeadingSpace suffix}
             |]
       [] -> error "Data.Text.splitOn returned empty list in violation of specification."
   where
     fullyNormalize :: Text -> Text
     fullyNormalize = T.toTitle . T.unwords . map text2asciiAlphaNum . T.words
 
+    withLeadingSpace :: Text -> Text
+    withLeadingSpace t
+      | T.null t                    = t
+      | Just (' ', _) <- T.uncons t = t
+      | otherwise                   = T.cons ' ' t
+
 nameHtml' :: HasUser u => u -> Html
 nameHtml' u = nameHtml (u ^. _userDisplayName) (u ^. _userSurname)
 

templates/profileData.hamlet

@@ -1,6 +1,6 @@
 $newline never
 
-$# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+$# SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -210,6 +210,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     <h2>_{MsgProfileQualifications}
     <div .container>
       ^{qualificationsTable}  
+  
+  ^{maybeTable MsgProfileEnrolledExams examsTable}
 
   ^{maybeTable MsgProfileCourses ownedCoursesTable}