diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index c20485fc6..7e2cb7b8a 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022-24 Steffen Jost +# SPDX-FileCopyrightText: 2022-25 Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later AvsPersonInfo: AVS Personendaten @@ -61,6 +61,7 @@ AvsIdMismatch api1@AvsPersonId api2@AvsPersonId: AVS Suche für Id #{tshow api1} AvsUserCreationFailed api@AvsPersonId: Für AVS Id #{tshow api} konnte kein neuer Benutzer angelegt werden, da es eine gemeinsame Id (z.B. Personalnummer) mit einem existierenden, aber verschiedenen Nutzer gibt. AvsCardsEmpty: Suche im AVS lieferte keinerlei Ausweiskarten AvsCurrentData: Alle angezeigte Daten wurden kürzlich direkt über die AVS Schnittstelle abgerufen. +AvsUpdateDayCheck: Zusätzlich wird im Hintergrund ein AVS Datenabgleich für alle in der Tagesansicht vorkommenden Personen angestoßen (einmal pro Tag). AvsNoApronCard: Kein gültiger Ausweis mit Vorfeld-Zugang vorhanden AvsNoCompanyCard mcn@(Maybe CompanyName): Für buchende Firma #{maybeEmpty mcn ciOriginal} liegt kein gültiger Ausweis vor diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index 04cfa7397..2f3ba4b7c 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -1,4 +1,4 @@ -# SPDX-FileCopyrightText: 2022-24 Steffen Jost +# SPDX-FileCopyrightText: 2022-25 Steffen Jost # # SPDX-License-Identifier: AGPL-3.0-or-later AvsPersonInfo: AVS person info @@ -62,6 +62,7 @@ AvsIdMismatch api1 api2: AVS search for id #{tshow api1} returned id #{tshow api AvsUserCreationFailed api@AvsPersonId: No new user could be created for AVS Id #{tshow api}, since an existing user shares at least one id presumed as unique AvsCardsEmpty: AVS search returned no id cards AvsCurrentData: All shown data has been recently received via the AVS interface. +AvsUpdateDayCheck: In addition, a background AVS update has been scheduled for all persons occrring within the day agenda (once per Day). AvsNoApronCard: No valid card granting apron access found AvsNoCompanyCard mcn@(Maybe CompanyName): No valid card for booking company #{maybeEmpty mcn ciOriginal} found diff --git a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg index eec50dfed..21c1c0f91 100644 --- a/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg +++ b/messages/uniworx/categories/courses/exam/exam/de-de-formal.msg @@ -225,6 +225,7 @@ ExamOccurrencesCopied num@Int: #{pluralDEeN num "Prüfungstermin"} kopiert ExamOccurrencesEdited num@Int del@Int: #{pluralENsN num "Prüfungstermin"} geändert #{guardMonoid (del > 0) ("und " <> pluralENsN num "Prüfungstermin" <> " gelöscht")} 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}! GradingFrom: Ab ExamNoShow: Nicht erschienen ExamVoided: Entwertet diff --git a/messages/uniworx/categories/courses/exam/exam/en-eu.msg b/messages/uniworx/categories/courses/exam/exam/en-eu.msg index e08217a78..c8bd96d82 100644 --- a/messages/uniworx/categories/courses/exam/exam/en-eu.msg +++ b/messages/uniworx/categories/courses/exam/exam/en-eu.msg @@ -225,6 +225,7 @@ ExamOccurrencesCopied num: #{pluralENsN num "exam occurrence"} copied ExamOccurrencesEdited num del: #{pluralENsN num "exam occurrence"} edited #{guardMonoid (del > 0) ("and " <> pluralENsN num "exam occurrence" <> " deleted")} 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}! GradingFrom: From #templates widgets/bonus-rule diff --git a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg index b2d09757d..21d9960f2 100644 --- a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg +++ b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg @@ -60,6 +60,7 @@ TutorialDayAttendance day@Text: Anwesenheit #{day} TutorialDayNote day@Text: Anwesenheitsnotiz #{day} TutorialParticipantsDayEdits day@Text: Kursteilnehmer-Tagesnotizen aktualisiert für #{day} +PossibleCheckResults: Mögliche Prüfungsergebnisse CheckEyePermitMissing: Sehtest oder Führerschein fehlen noch CheckEyePermitIncompatible: Sehtest und Führerschein passen nicht zusammen diff --git a/messages/uniworx/categories/courses/tutorial/en-eu.msg b/messages/uniworx/categories/courses/tutorial/en-eu.msg index ed655698c..7d3a8468d 100644 --- a/messages/uniworx/categories/courses/tutorial/en-eu.msg +++ b/messages/uniworx/categories/courses/tutorial/en-eu.msg @@ -61,6 +61,7 @@ TutorialDayAttendance day: Attendance #{day} TutorialDayNote day: Attendance note #{day} TutorialParticipantsDayEdits day: course participant day notes updated for #{day} +PossibleCheckResults: Possible results CheckEyePermitMissing: Eye exam or driving permit missing CheckEyePermitIncompatible: Eye exam and driving permit are incompatible diff --git a/src/Handler/Course/Users.hs b/src/Handler/Course/Users.hs index 375fbec59..0453bab02 100644 --- a/src/Handler/Course/Users.hs +++ b/src/Handler/Course/Users.hs @@ -1,4 +1,4 @@ --- 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 @@ -10,7 +10,7 @@ module Handler.Course.Users , postCUsersR, getCUsersR , colUserSex' , colUserQualifications, colUserQualificationBlocked - , colUserExams, colUserExamOccurrences + , colUserExams, colUserExamOccurrences, colUserExamOccurrencesCheck, colUserExamOccurrencesCheckDB , _userQualifications ) where @@ -20,19 +20,23 @@ import Utils.Form import Handler.Utils import Handler.Utils.Course 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 Database.Esqueleto.Experimental ((:&)(..)) + import Database.Esqueleto.Utils.TH import Handler.Course.Register (deregisterParticipant) import qualified Data.Set as Set import qualified Data.Map as Map +import Data.Map ((!?)) import qualified Data.Text as Text import qualified Data.Vector as Vector -import qualified Database.Esqueleto.Legacy as E - import qualified Data.Csv as Csv import qualified Data.Conduit.List as C @@ -96,7 +100,7 @@ type UserTableData = DBRow ( Entity User , Entity CourseParticipant , Maybe CourseUserNoteId , ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial))) - , ([Entity Exam], [Entity ExamOccurrence]) + , ([Entity Exam], [(Entity ExamOccurrence, Maybe UserDisplayName)]) -- Paired with ExamOccurrence is an examiner name, iff user is registered for another ExamOccurrence with this examiner, regardless of CourseId and time , Maybe (Entity SubmissionGroup) , Map SheetName (SheetType SqlBackendKey, Maybe Points) , UserTableQualifications @@ -123,8 +127,11 @@ _userTutorials = _dbrOutput . _4 _userExams :: Lens' UserTableData [Entity Exam] _userExams = _dbrOutput . _5 . _1 -_userExamOccurrences :: Lens' UserTableData [Entity ExamOccurrence] -_userExamOccurrences = _dbrOutput . _5 . _2 +_userExamOccsDblExaminers :: Lens' UserTableData [(Entity ExamOccurrence, Maybe UserDisplayName)] +_userExamOccsDblExaminers = _dbrOutput . _5 . _2 + +_userExamOccurrences :: Getter UserTableData [Entity ExamOccurrence] +_userExamOccurrences = _userExamOccsDblExaminers . to (map fst) _userSubmissionGroup :: Traversal' UserTableData (Entity SubmissionGroup) _userSubmissionGroup = _dbrOutput . _6 . _Just @@ -136,14 +143,12 @@ _userSheets = _dbrOutput . _7 -- _userQualifications = _dbrOutput . _8 . (traverse _1) -- last part: ([Entity Qualification] -> f [Entity Qualification]) -> UserTableQualifications -> f UserTableQualifications -_userQualifications :: Getter UserTableData [Entity Qualification] -_userQualifications = _dbrOutput . _8 . to (fmap fst3) --- _userQualifications = _dbrOutput . _8 . each . _1 -- TODO: how to make this work - - _userCourseQualifications :: Lens' UserTableData UserTableQualifications _userCourseQualifications = _dbrOutput . _8 +_userQualifications :: Getter UserTableData [Entity Qualification] +_userQualifications = _userCourseQualifications . to (map fst3) + colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c) colUserComment tid ssh csh = @@ -176,6 +181,41 @@ colUserExamOccurrences _tid _ssh _csh = sortable (Just "exam-occurrences") (i18n in (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) $ listCell exams (\(Entity _ ExamOccurrence{..}) -> wgtCell [whamlet|#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|]) +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}|] + ) + +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) + $ \row -> do + let exams = sortOn (examOccurrenceName . entityVal) (row ^. _userExamOccurrences) + uid = row ^. hasEntity . _entityKey + (Map.fromAscList . map $(E.unValueN 2) -> dblExaminers) <- liftHandler . runDB $ E.select $ do + (reg :& occ :& usr) <- X.from $ X.table @ExamRegistration + `X.innerJoin` X.table @ExamOccurrence `X.on` (\(reg :& occ) -> occ E.^. ExamOccurrenceExam E.==. reg E.^. ExamRegistrationExam) + `X.innerJoin` X.table @User `X.on` (\(_ :& occ :& usr) -> occ E.^. ExamOccurrenceExaminer E.?=. usr E.^. UserId) + E.where_ $ reg E.^. ExamRegistrationUser E.==. E.val uid + E.&&. E.isJust (occ E.^. ExamOccurrenceExaminer) + E.&&. occ E.^. ExamOccurrenceId `E.notIn` E.valList (entityKey <$> exams) + E.&&. occ E.^. ExamOccurrenceExaminer `E.in_` E.valList (exams ^.. traverse . _entityVal . _examOccurrenceExaminer) + E.orderBy [E.asc $ usr E.^. UserId] + E.distinct $ pure (usr E.^. UserId, usr E.^. UserDisplayName) + (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) $ listCell exams + (\(Entity _ eo@ExamOccurrence{..}) -> wgtCell $ do + $logDebugS "ExOccWarning" [st|Problems: #{tshow dblExaminers}. ExamOccurrence: #{tshow eo}|] + warnExaminer <- case (dblExaminers !?) =<< examOccurrenceExaminer of + Nothing -> pure mempty + (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 @@ -383,8 +423,8 @@ data CourseUserActionData = CourseUserSendMailData makeCourseUserTable :: forall h p cols act act'. - ( Functor h, ToSortable h - , Ord act, PathPiece act, RenderMessage UniWorX act + ( Functor h, ToSortable h, Ord act, PathPiece act, RenderMessage UniWorX act + -- , HandlerSite (DBCell (MForm Handler)) ~ UniWorX, MonadHandler (DBCell (MForm Handler)) -- for colUserExamOccurrencesCheckDB, but this does not work at all , AsCornice h p UserTableData (DBCell (MForm Handler) (FormResult (First act', DBFormResult UserId Bool UserTableData))) cols ) => CourseId @@ -421,7 +461,12 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do dbtRowKey = queryUser >>> (E.^. UserId) dbtProj = dbtProjSimple $ \(user, participant, E.Value userNoteId, subGroup) -> do tuts'' <- selectList [ TutorialParticipantUser ==. entityKey user, TutorialParticipantTutorial <-. map entityKey tutorials ] [] - exams' <- selectList [ ExamRegistrationUser ==. entityKey user ] [] + usrExams :: [(Entity ExamRegistration, E.Value (Maybe UserId), E.Value (Maybe UserDisplayName))] <- E.select $ do + (reg :& _occ :& usr) <- X.from $ X.table @ExamRegistration + `X.leftJoin` X.table @ExamOccurrence `X.on` (\(reg :& occ) -> occ E.?. ExamOccurrenceId E.==. reg E.^. ExamRegistrationOccurrence) + `X.leftJoin` X.table @User `X.on` (\(_ :& occ :& usr) -> E.joinV (occ E.?. ExamOccurrenceExaminer) E.==. usr E.?. UserId) + E.where_ $ reg E.^. ExamRegistrationUser E.==. E.val (entityKey user) + pure (reg, usr E.?. UserId, usr E.?. UserDisplayName) subs' <- E.select . E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do E.on $ submissionUser E.?. SubmissionUserSubmission E.==. submission E.?. SubmissionId E.on $ E.just (sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet @@ -444,9 +489,14 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do 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' - exs = filter (\(Entity eId _) -> any ((== eId) . examRegistrationExam . entityVal) exams') exams - -- ocs = filter (\(Entity oId _) -> any ((== Just oId) . examRegistrationOccurrence . entityVal) exams') exOccs - ocs = catMaybes [ Map.lookup oId exOccs | Entity{entityVal=ExamRegistration{examRegistrationOccurrence = Just oId}} <- exams' ] + exs = filter (\(Entity eId _) -> any ((== eId) . examRegistrationExam . entityVal . fst3) usrExams) exams + usrDblExaminer :: Map UserId (Set ExamRegistrationId) + usrDblExaminer = Map.filter ((1 <) . Set.size) $ Map.fromListWith (<>) [(examiner, Set.singleton reg) | (Entity{entityKey=reg}, E.Value (Just examiner), _) <- usrExams] + checkUsrDbl :: Maybe UserId -> Maybe UserDisplayName -> Maybe UserDisplayName + checkUsrDbl (Just exid) exnm | isJust (usrDblExaminer !? exid) = exnm + checkUsrDbl _ _ = Nothing + ocs = [ (occ, checkUsrDbl exUsrId exUsrName) + | (Entity{entityVal=ExamRegistration{examRegistrationOccurrence = Just _oId@((exOccs !?) -> Just occ)}}, E.Value exUsrId, E.Value exUsrName) <- usrExams] subs = Map.fromList $ map (over (_2 . _2) (views _entityVal submissionRatingPoints <=< assertM (views _entityVal submissionRatingDone)) . over _1 E.unValue . over (_2 . _1) E.unValue) subs' return (user, participant, userNoteId, tuts, (exs,ocs), subGroup, subs, qualis) dbtColonnade = colChoices diff --git a/src/Handler/School/DayTasks.hs b/src/Handler/School/DayTasks.hs index 4286897e0..f7a2febd7 100644 --- a/src/Handler/School/DayTasks.hs +++ b/src/Handler/School/DayTasks.hs @@ -1,5 +1,5 @@ --- SPDX-FileCopyrightText: 2024 Steffen Jost +-- SPDX-FileCopyrightText: 2024-25 Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -595,10 +595,10 @@ postSchoolDayR ssh nd = do -- | A wrapper for several check results on tutorial participants data DayCheckResult = DayCheckResult - { dcEyeFitsPermit :: Maybe Bool - , dcAvsKnown :: Bool + { dcAvsKnown :: Bool , dcApronAccess :: Bool , dcBookingFirmOk :: Bool + , dcEyeFitsPermit :: Maybe Bool } deriving (Eq, Show, Generic, Binary) @@ -610,7 +610,7 @@ data DayCheckResults = DayCheckResults -- | True iff there is no problem at all dcrIsOk :: DayCheckResult -> Bool -dcrIsOk (DayCheckResult (Just True) True True True) = True +dcrIsOk (DayCheckResult True True True (Just True)) = True dcrIsOk _ = False -- | defines categories on DayCheckResult, implying an ordering, with most severe being least @@ -646,6 +646,15 @@ dcrSeverityGroups = Map.foldMapWithKey groupBySeverity 5 -> set _5 (Set.singleton tpid) sempty _ -> sempty +-- | Possible outcomes for DayCheckResult +dcrMessages :: [SomeMessage UniWorX] +dcrMessages = [ SomeMessage MsgAvsPersonSearchEmpty + , SomeMessage MsgAvsNoApronCard + , SomeMessage $ MsgAvsNoCompanyCard Nothing + , SomeMessage MsgCheckEyePermitMissing + , SomeMessage MsgCheckEyePermitIncompatible + ] + -- | Show most important problem as text dcr2widgetTxt :: Maybe CompanyName -> DayCheckResult -> Widget dcr2widgetTxt _ DayCheckResult{dcAvsKnown=False} = i18n MsgAvsPersonSearchEmpty @@ -746,21 +755,32 @@ getSchoolDayCheckR ssh nd = do siteLayoutMsg MsgMenuSchoolDayCheck $ do setTitleI MsgMenuSchoolDayCheck [whamlet| -

- _{MsgMenuSchoolDay ssh dday} -

- $if Map.null badTutPartMap - _{MsgNoProblem}. - $else -

- $forall (tid,badis) <- Map.toList badTutPartMap -
- #{maybe "???" fst (Map.lookup tid tuts)} -
-
    - $forall ((_udn,pid),pcd) <- Map.toList badis -
  • - ^{mkBaddieWgt pid pcd} -

    - ^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))} +

    +

    + _{MsgMenuSchoolDay ssh dday} +

    + $if Map.null badTutPartMap + _{MsgNoProblem}. + $else +

    + $forall (tid,badis) <- Map.toList badTutPartMap +
    + #{maybe "???" fst (Map.lookup tid tuts)} +
    +
      + $forall ((_udn,pid),pcd) <- Map.toList badis +
    • + ^{mkBaddieWgt pid pcd} +

      + ^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))} +

      +

      +

      + _{MsgPossibleCheckResults} +

      +

        + $forall msg <- dcrMessages +
      • _{msg} +

        + _{MsgAvsUpdateDayCheck} |] \ No newline at end of file diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 317674162..7a4dc6f0b 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -131,7 +131,7 @@ postTUsersR tid ssh csh tutn = do , pure $ colUserMatriclenr isAdmin , pure $ colUserQualifications nowaday , pure $ colUserQualificationBlocked isAdmin nowaday - , pure $ colUserExamOccurrences tid ssh csh + , pure $ colUserExamOccurrencesCheck tid ssh csh , pure $ colUserExams tid ssh csh ] psValidator = def diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 5e403fa68..13bbbcab6 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -1269,6 +1269,40 @@ fillDb = do eOccB <- insert' $ ExamOccurrence e "OccB" (Just gkleen) (Just $ RoomReferenceSimple "Room B") False Nothing (termTime tid TermDayLectureStart 28 Nothing $ toTimeOfDay 16 5 0) (jtt TermDayLectureStart 28 Nothing $ toTimeOfDay 16 35 0) Nothing insert_ $ ExamRegistration e svaupel (Just eOccA) now insert_ $ ExamRegistration e fhamann (Just eOccB) now + when (tyear == succ currentYear) $ do + e <- insert' $ Exam + { examCourse = c + , examName = mkName "Alte Prüfung" + , examGradingRule = Nothing + , examBonusRule = Nothing + , examOccurrenceRule = ExamRoomManual + , examExamOccurrenceMapping = Nothing + , examPublishOccurrenceAssignments = Nothing + , examVisibleFrom = jtt TermDayLectureStart 0 Nothing toMidnight + , examRegisterFrom = jtt TermDayLectureStart 0 Nothing toMidnight + , examRegisterTo = jtt TermDayLectureStart 15 Nothing toMidnight + , examDeregisterUntil = jtt TermDayLectureStart 22 Nothing toMidnight + , examStart = jtt TermDayLectureStart 0 Nothing $ toTimeOfDay 11 0 0 + , examEnd = jtt TermDayLectureStart 128 Nothing $ toTimeOfDay 17 30 0 + , examFinished = Nothing + , examPartsFrom = Nothing + , examClosed = Nothing + , examPublicStatistics = True + , examGradingMode = ExamGradingPass + , examDescription = Just $ htmlToStoredMarkup [shamlet|Theoretische Prüfung mit Fragebogen|] + , examExamMode = ExamMode + { examAids = Just $ ExamAidsPreset ExamClosedBook + , examOnline = Just $ ExamOnlinePreset ExamOffline + , examSynchronicity = Just $ ExamSynchronicityPreset ExamSynchronous + , examRequiredEquipment = Just $ ExamRequiredEquipmentPreset ExamRequiredEquipmentNone + } + , examStaff = Just "Jost" + , examAuthorshipStatement = Nothing + } + eOccA <- insert' $ ExamOccurrence e "OldA" (Just jost) (Just $ RoomReferenceSimple "Room A") False (Just 1) (termTime tid TermDayLectureStart 27 Nothing $ toTimeOfDay 16 0 0) (jtt TermDayLectureStart 27 Nothing $ toTimeOfDay 16 30 0) Nothing + eOccB <- insert' $ ExamOccurrence e "OldB" (Just sbarth) (Just $ RoomReferenceSimple "Room B") False Nothing (termTime tid TermDayLectureStart 28 Nothing $ toTimeOfDay 16 5 0) (jtt TermDayLectureStart 28 Nothing $ toTimeOfDay 16 35 0) Nothing + insert_ $ ExamRegistration e svaupel (Just eOccA) now + insert_ $ ExamRegistration e fhamann (Just eOccB) now insert_ $ UserDay svaupel nowaday True insert_ $ UserDay fhamann nowaday False