feat: support exam registration including room (ExamRoomFifo)

messages/uniworx/de-de-formal.msg

@@ -12,6 +12,7 @@ BtnCourseDeregister: Vom Kurs abmelden
 BtnCourseApply: Zum Kurs bewerben
 BtnCourseRetractApplication: Bewerbung zum Kurs zurückziehen
 BtnExamRegister: Anmelden zur Prüfung
+BtnExamRegisterOccurrence: Anmelden zum Prüfungstermin/-raum
 BtnExamDeregister: Von der Prüfung abmelden
 BtnHijack: Sitzung übernehmen
 BtnSave: Speichern
@@ -99,6 +100,7 @@ CourseCapacity: Kapazität
 CourseCapacityTip: Anzahl erlaubter Kursanmeldungen, leer lassen für unbeschränkte Kurskapazität
 CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
 TutorialNoCapacity: In dieser Übung sind keine Plätze mehr frei.
+ExamOccurrenceNoCapacity: Zu diesem Termin/Raum sind keine Plätze mehr frei.
 CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
 CourseRegistration: Kursanmeldung
 CourseRegisterOpen: Anmeldung möglich
@@ -409,6 +411,7 @@ UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung e
 UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.
 UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert.
 UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
+UnauthorizedExamOccurrenceRegistration: Anmeldung zur Klausur erfolgt nicht inkl. Raum/Termin.
 UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
 UnauthorizedParticipantSelf: Sie sind kein Teilnehmer dieser Veranstaltung.
 UnauthorizedApplicant: Angegebener Benutzer hat sich nicht für diese Veranstaltung beworben.
@@ -1263,6 +1266,8 @@ AuthTagAllocationRegistered: Nutzer nimmt an der Zentralanmeldung teil
 AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
 AuthTagExamRegistered: Nutzer ist Prüfungsteilnehmer
 AuthTagExamResult: Nutzer hat Prüfungsergebnisse
+AuthTagExamOccurrenceRegistered: Nutzer ist für Prüfungsraum/-termin angemeldet
+AuthTagExamOccurrenceRegistration: Anmeldung zur Klausur erfolgt inkl. Raum/Termin
 AuthTagParticipant: Nutzer ist mit Kurs assoziiert
 AuthTagApplicant: Nutzer ist mit Bewerber zum Kurs
 AuthTagRegisterGroup: Nutzer ist nicht Mitglied eines anderen Tutoriums mit der selben Registrierungs-Gruppe
@@ -1522,6 +1527,8 @@ ExamNoBonus': Kein automatischer Bonus
 ExamBonusPoints': Umrechnung von Übungspunkten
 ExamBonusManual': Manuelle Berechnung
 
+ExamRegisterForOccurrence: Anmeldung zur Klausur erfolgt durch Anmeldung zu einem Termin/Raum
+
 ExamBonusAchieved: Bonuspunkte
 
 ExamEditHeading examn@ExamName: #{examn} bearbeiten
@@ -1534,17 +1541,19 @@ ExamBonusRound: Bonus runden auf
 ExamBonusRoundNonPositive: Vielfaches, auf das gerundet werden soll, muss positiv und größer null sein
 ExamBonusRoundTip: Bonuspunkte werden kaufmännisch auf ein Vielfaches der angegeben Zahl gerundet.
 
-ExamAutomaticOccurrenceAssignment: Automatische Termin- bzw. Raumzuteilung
+ExamAutomaticOccurrenceAssignment: Automatische oder selbständige Termin- bzw. Raumzuteilung
-ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
+ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden oder sich selbstständig einen Raum bzw. Termin aussuchen dürfen? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
 ExamOccurrenceRule: Verfahren
 ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
-ExamRoomManual': Keine automatische Zuteilung
+ExamRoomManual': Keine automatische bzw. selbstständige Zuteilung
 ExamRoomSurname': Nach Nachname
 ExamRoomMatriculation': Nach Matrikelnummer
 ExamRoomRandom': Zufällig pro Teilnehmer
+ExamRoomFifo': Auswahl durch Teilnehmer bei Anmeldung
 
 ExamOccurrence: Termin/Raum
 ExamNoOccurrence: Kein Termin/Raum
+ExamNoSuchOccurrence: Termin/Raum existiert nicht (mehr)
 ExamOccurrences: Prüfungen
 ExamRooms: Räume
 ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
@@ -1557,7 +1566,8 @@ ExamRoomStart: Beginn
 ExamRoomEnd: Ende
 ExamRoomDescription: Beschreibung
 ExamTimeTip: Nur zur Information der Studierenden, die tatsächliche Zeitangabe erfolgt pro Prüfung
-ExamRoomRegistered: Zugeteilt
+ExamRoomAssigned: Zugeteilt
+ExamRoomRegistered: Anmeldung
 
 ExamOccurrenceStart: Prüfungsbeginn
 
@@ -1603,6 +1613,7 @@ ExamDeregisteredSuccess exam@ExamName: Erfolgreich von der Prüfung #{exam} abge
 ExamRegistered: Zur Prüfung angemeldet
 ExamNotRegistered: Nicht zur Prüfung angemeldet
 ExamRegistration: Prüfungsanmeldung
+ExamLoginToRegister: Um sich zum Kurs anzumelden müssen Sie zunächst in Uni2work anmelden
 
 ExamRegisterToMustBeAfterRegisterFrom: "Anmeldung ab" muss vor "Anmeldung bis" liegen
 ExamDeregisterUntilMustBeAfterRegisterFrom: "Abmeldung bis" muss nach "Anmeldung bis" liegen

messages/uniworx/en-eu.msg

@@ -12,6 +12,7 @@ BtnCourseDeregister: Leave course
 BtnCourseApply: Apply for course
 BtnCourseRetractApplication: Retract application
 BtnExamRegister: Enrol for exam
+BtnExamRegisterOccurrence: Enrol for exam occurrence/room
 BtnExamDeregister: Leave exam
 BtnHijack: Hijack session
 BtnSave: Save
@@ -99,6 +100,7 @@ CourseCapacity: Capacity
 CourseCapacityTip: Maximum permissable number of enrolments for this course; leave empty for unlimited capacity
 CourseNoCapacity: Course has reached maximum capacity
 TutorialNoCapacity: Tutorial has reached maximum capacity
+ExamOccurrenceNoCapacity: Occurrence/Room has reached maximum capacity
 CourseNotEmpty: There are currently no participants enrolled for this course.
 CourseRegistration: Enrolment
 CourseRegisterOpen: Enrolment is allowed
@@ -407,6 +409,7 @@ UnauthorizedCorrectorAny: You are no corrector for any course.
 UnauthorizedRegistered: You are no participant in this course.
 UnauthorizedAllocationRegistered: You are no participant in this central allocation.
 UnauthorizedExamResult: You have no results in this exam.
+UnauthorizedExamOccurrenceRegistration: Registration for exam is not done including occurrence/room.
 UnauthorizedParticipant: The specified user is no participant of this course.
 UnauthorizedParticipantSelf: You are no participant of this course.
 UnauthorizedApplicant: The specified user is no applicant for this course.
@@ -1262,6 +1265,8 @@ AuthTagAllocationRegistered: User participates in central allocation
 AuthTagTutorialRegistered: User is tutorial participant
 AuthTagExamRegistered: User is exam participant
 AuthTagExamResult: User has an exam result
+AuthTagExamOccurrenceRegistered: User is registered for exam occurrence/room
+AuthTagExamOccurrenceRegistration: Registration for exam is done including occurrence/room
 AuthTagParticipant: User participates in course
 AuthTagApplicant: User is applicant for course
 AuthTagRegisterGroup: User is not participant in any tutorial of the same registration group
@@ -1520,6 +1525,8 @@ ExamNoBonus': No automatic exam bonus
 ExamBonusPoints': Compute from exercise achievements
 ExamBonusManual': Manual computation
 
+ExamRegisterForOccurrence: Registration for this exam is done by registering for an occurrence/room
+
 ExamBonusAchieved: Bonus points
 
 ExamEditHeading examn: Edit #{examn}
@@ -1532,17 +1539,19 @@ ExamBonusRound: Round bonus to
 ExamBonusRoundNonPositive: Rounding multiple must be positive and greater than zero
 ExamBonusRoundTip: Bonus points are rounded commercially to a multiple of the given number
 
-ExamAutomaticOccurrenceAssignment: Automatically assign occurrence/room
+ExamAutomaticOccurrenceAssignment: Selection of occurrences/rooms for/by participants
-ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms? Manipulation of the distribution and manually assigning participants remains possible.
+ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms? Should they instead be permitted to autonomously choose an occurrence/a room? Manipulation of the distribution and manually assigning participants remains possible.
 ExamOccurrenceRule: Procedure
 ExamOccurrenceRuleParticipant: Occurrence/room assignment procedure
-ExamRoomManual': No automatic assignment
+ExamRoomManual': No automatic or autonomous assignment
 ExamRoomSurname': By surname
 ExamRoomMatriculation': By matriculation
 ExamRoomRandom': Randomly
+ExamRoomFifo': Selected by the participants when registering
 
 ExamOccurrence: Occurrence/room
 ExamNoOccurrence: No occurrence/room
+ExamNoSuchOccurrence: Occurrence/Room does not exist (anymore)
 ExamOccurrences: Exams
 ExamRooms: Rooms
 ExamRoomAlreadyExists: Occurrence already configured
@@ -1555,7 +1564,8 @@ ExamRoomStart: Start
 ExamRoomEnd: End
 ExamRoomDescription: Description
 ExamTimeTip: Only for informational purposes. The actual times are set for each occurrence/room
-ExamRoomRegistered: Assigned
+ExamRoomAssigned: Assigned
+ExamRoomRegistered: Registration
 
 ExamOccurrenceStart: Exam starts
 
@@ -1601,6 +1611,7 @@ ExamDeregisteredSuccess exam: Successufly deregistered from the exam #{exam}
 ExamRegistered: Registered for the exam
 ExamNotRegistered: Not registered for the exam
 ExamRegistration: Exam registration
+ExamLoginToRegister: Your need to login to Uni2work before you can register for this course.
 
 ExamRegisterToMustBeAfterRegisterFrom: "Register to" must be after "register from"
 ExamDeregisterUntilMustBeAfterRegisterFrom: "Deregister until" must be after "register from"

routes

@@ -173,6 +173,7 @@
     /users/new                  EAddUserR      GET POST
     /users/invite               EInviteR       GET POST
     /register                   ERegisterR         POST        !timeANDcourse-registeredAND¬exam-registered !timeANDexam-registeredAND¬exam-result
+    /register/#ExamOccurrenceName ERegisterOccR    POST        !exam-occurrence-registrationANDtimeANDcapacityANDcourse-registeredAND¬exam-occurrence-registered !exam-occurrence-registrationANDtimeANDexam-occurrence-registeredAND¬exam-result
     /grades                     EGradesR       GET POST        !exam-office
   /apps                         CApplicationsR GET POST
   !/apps/files                  CAppsFilesR    GET

src/Foundation.hs

@@ -504,9 +504,9 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
     course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
     Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
     cTime <- liftIO getCurrentTime
-    registered <- case mAuthId of
+    registration <- case mAuthId of
-      Just uid -> $cachedHereBinary (eId, uid) . lift . existsBy $ UniqueExamRegistration eId uid
+      Just uid -> $cachedHereBinary (eId, uid) . lift . getBy $ UniqueExamRegistration eId uid
-      Nothing  -> return False
+      Nothing  -> return Nothing
 
     let visible = NTop examVisibleFrom <= NTop (Just cTime)
 
@@ -515,11 +515,23 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
       EUsersR    -> guard $ NTop examStart <= NTop (Just cTime)
                          && NTop (Just cTime) <= NTop examFinished
       ERegisterR
-        | not registered -> guard $ visible
+        | is _Nothing registration
-                                 && NTop examRegisterFrom <= NTop (Just cTime)
+          -> guard $ visible
-                                 && NTop (Just cTime) <= NTop examRegisterTo
+                  && NTop examRegisterFrom <= NTop (Just cTime)
-        | otherwise      -> guard $ visible
+                  && NTop (Just cTime) <= NTop examRegisterTo
-                                 && NTop (Just cTime) <= NTop examDeregisterUntil
+        | otherwise
+          -> guard $ visible
+                  && NTop (Just cTime) <= NTop examDeregisterUntil
+      ERegisterOccR occn -> do
+        occId <- (>>= hoistMaybe) . $cachedHereBinary (eId, occn) . lift . getKeyBy $ UniqueExamOccurrence eId occn
+        if
+          | (registration >>= examRegistrationOccurrence . entityVal) == Just occId
+            -> guard $ visible
+                    && NTop (Just cTime) <= NTop examDeregisterUntil
+          | otherwise
+            -> guard $ visible
+                    && NTop examRegisterFrom <= NTop (Just cTime)
+                    && NTop (Just cTime) <= NTop examRegisterTo
       _          -> return ()
 
     return Authorized
@@ -758,6 +770,59 @@ tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case rout
     guardMExceptT isRegistered (unauthorizedI MsgUnauthorizedRegistered)
     return Authorized
   r -> $unsupportedAuthPredicate AuthTutorialRegistered r
+tagAccessPredicate AuthExamOccurrenceRegistration = APDB $ \_ route _ -> case route of
+  CExamR tid ssh csh examn _ -> exceptT return return $ do
+    isOccurrenceRegistration <- $cachedHereBinary (tid, ssh, csh, examn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam) -> do
+      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+      E.where_ $ course E.^. CourseTerm       E.==. E.val tid
+           E.&&. course E.^. CourseSchool     E.==. E.val ssh
+           E.&&. course E.^. CourseShorthand  E.==. E.val csh
+           E.&&. exam E.^. ExamName           E.==. E.val examn
+           E.&&. exam E.^. ExamOccurrenceRule E.==. E.val (Just ExamRoomFifo)
+    guardMExceptT isOccurrenceRegistration (unauthorizedI MsgUnauthorizedExamOccurrenceRegistration)
+    return Authorized
+  r -> $unsupportedAuthPredicate AuthExamOccurrenceRegistration r
+tagAccessPredicate AuthExamOccurrenceRegistered = APDB $ \mAuthId route _ -> case route of
+  CExamR tid ssh csh examn (ERegisterOccR occn) -> exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh, examn, occn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration `E.InnerJoin` examOccurrence) -> do
+      E.on $ E.just (examOccurrence E.^. ExamOccurrenceId) E.==. examRegistration E.^. ExamRegistrationOccurrence
+      E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
+      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+      E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
+           E.&&. examOccurrence E.^. ExamOccurrenceName E.==. E.val occn
+           E.&&. course E.^. CourseTerm      E.==. E.val tid
+           E.&&. course E.^. CourseSchool    E.==. E.val ssh
+           E.&&. course E.^. CourseShorthand E.==. E.val csh
+           E.&&. exam E.^. ExamName          E.==. E.val examn
+    guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
+    return Authorized
+  CExamR tid ssh csh examn _ -> exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh, examn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
+      E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
+      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+      E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
+           E.&&. course E.^. CourseTerm      E.==. E.val tid
+           E.&&. course E.^. CourseSchool    E.==. E.val ssh
+           E.&&. course E.^. CourseShorthand E.==. E.val csh
+           E.&&. exam E.^. ExamName          E.==. E.val examn
+           E.&&. E.not_ (E.isNothing $ examRegistration E.^. ExamRegistrationOccurrence)
+    guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
+    return Authorized
+  CourseR tid ssh csh _ -> exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
+      E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
+      E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+      E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
+           E.&&. course E.^. CourseTerm      E.==. E.val tid
+           E.&&. course E.^. CourseSchool    E.==. E.val ssh
+           E.&&. course E.^. CourseShorthand E.==. E.val csh
+           E.&&. E.not_ (E.isNothing $ examRegistration E.^. ExamRegistrationOccurrence)
+    guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
+    return Authorized
+  r -> $unsupportedAuthPredicate AuthExamOccurrenceRegistered r
 tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of
   CExamR tid ssh csh examn _ -> exceptT return return $ do
     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
@@ -768,7 +833,7 @@ tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of
            E.&&. course E.^. CourseTerm      E.==. E.val tid
            E.&&. course E.^. CourseSchool    E.==. E.val ssh
            E.&&. course E.^. CourseShorthand E.==. E.val csh
-           E.&&. exam E.^. ExamName  E.==. E.val examn
+           E.&&. exam E.^. ExamName          E.==. E.val examn
     guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
     return Authorized
   CourseR tid ssh csh _ -> exceptT return return $ do
@@ -933,6 +998,13 @@ tagAccessPredicate AuthApplicant = APDB $ \mAuthId route _ -> case route of
            E.&&. course E.^. CourseSchool    E.==. E.val ssh
            E.&&. course E.^. CourseShorthand E.==. E.val csh
 tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
+  CExamR tid ssh csh examn (ERegisterOccR occn) -> maybeT (unauthorizedI MsgExamOccurrenceNoCapacity) $ do
+    cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
+    eid <- $cachedHereBinary (cid, examn) . MaybeT . getKeyBy $ UniqueExam cid examn
+    Entity occId ExamOccurrence{..} <- $cachedHereBinary (eid, occn) . MaybeT . getBy $ UniqueExamOccurrence eid occn
+    registered <- $cachedHereBinary occId . lift $ fromIntegral <$> count [ ExamRegistrationOccurrence ==. Just occId, ExamRegistrationExam ==. eid ]
+    guard $ examOccurrenceCapacity > registered
+    return Authorized
   CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do
     cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
     Entity tutId Tutorial{..} <- $cachedHereBinary (cid, tutn) . MaybeT . getBy $ UniqueTutorial cid tutn
@@ -1791,6 +1863,7 @@ instance YesodBreadcrumbs UniWorX where
     ECInviteR  -> i18nCrumb MsgBreadcrumbExamCorrectorInvite . Just $ CExamR tid ssh csh examn EShowR
     EInviteR   -> i18nCrumb MsgBreadcrumbExamParticipantInvite . Just $ CExamR tid ssh csh examn EShowR
     ERegisterR -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
+    ERegisterOccR _occn -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
 
   breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
     TUsersR  -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do

src/Handler/Exam/Register.hs

@@ -1,6 +1,7 @@
 module Handler.Exam.Register
   ( ButtonExamRegister(..)
   , postERegisterR
+  , postERegisterOccR
   ) where
 
 import Import
@@ -8,45 +9,81 @@ import Import
 import Handler.Utils
 import Handler.Utils.Exam
 
+import Database.Persist.Sql (deleteWhereCount)
+
 
 -- Dedicated ExamRegistrationButton
-data ButtonExamRegister = BtnExamRegister | BtnExamDeregister
+data ButtonExamRegister = BtnExamRegisterOccurrence
-  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+                        | BtnExamRegister
+                        | BtnExamDeregister
+  deriving (Enum, Bounded, Eq, Ord, Read, Show, Generic, Typeable)
 instance Universe ButtonExamRegister
 instance Finite ButtonExamRegister
-nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 1
+nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 2
-embedRenderMessage ''UniWorX ''ButtonExamRegister id
-instance Button UniWorX ButtonExamRegister where
-  btnClasses BtnExamRegister   = [BCIsButton, BCPrimary]
-  btnClasses BtnExamDeregister = [BCIsButton, BCDanger]
   
-  btnLabel  BtnExamRegister   = [whamlet|#{iconExamRegister True} _{MsgBtnExamRegister}|]
+instance Button UniWorX ButtonExamRegister where
-  btnLabel  BtnExamDeregister = [whamlet|#{iconExamRegister False} _{MsgBtnExamDeregister}|]
+  btnClasses BtnExamRegisterOccurrence = [BCIsButton, BCPrimary]
+  btnClasses BtnExamRegister           = [BCIsButton, BCPrimary]
+  btnClasses BtnExamDeregister         = [BCIsButton, BCDanger]
+
+  btnLabel BtnExamRegisterOccurrence = [whamlet|#{iconExamRegister True } _{MsgBtnExamRegisterOccurrence}|]
+  btnLabel BtnExamRegister           = [whamlet|#{iconExamRegister True } _{MsgBtnExamRegister}|]
+  btnLabel BtnExamDeregister         = [whamlet|#{iconExamRegister False} _{MsgBtnExamDeregister}|]
 
 
 postERegisterR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
-
 postERegisterR tid ssh csh examn = do
   Entity uid User{..} <- requireAuth
 
   Entity eId Exam{..} <- runDB $ fetchExam tid ssh csh examn
 
-  ((btnResult, _), _) <- runFormPost buttonForm
+  ((btnResult, _), _) <- runFormPost $ buttonForm' [BtnExamRegister, BtnExamDeregister]
 
   formResult btnResult $ \case
+    BtnExamDeregister -> do
+      runDB $ do
+        deleted <- deleteWhereCount [ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid]
+        unless (deleted <= 0) $
+          audit $ TransactionExamDeregister eId uid
+      addMessageIconI Success IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
+      redirect $ CExamR tid ssh csh examn EShowR
     BtnExamRegister -> do
       runDB $ do
         now <- liftIO getCurrentTime
-        insert_ $ ExamRegistration eId uid Nothing now
+        void $ upsertBy (UniqueExamRegistration eId uid) (ExamRegistration eId uid Nothing now) [ExamRegistrationTime =. now]
         audit $ TransactionExamRegister eId uid
-      addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
+        addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
       redirect $ CExamR tid ssh csh examn EShowR
+    _other -> error "Unexpected due to definition of buttonForm'"
+
+  redirect $ CExamR tid ssh csh examn EShowR
+
+postERegisterOccR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> ExamOccurrenceName -> Handler Html
+postERegisterOccR tid ssh csh examn occn = do
+  Entity uid User{..} <- requireAuth
+  (Entity eId Exam{..}, Entity occId ExamOccurrence{..}) <- runDB $ do
+    eexam@(Entity eId _) <- fetchExam tid ssh csh examn
+    occ <- getBy404 $ UniqueExamOccurrence eId occn
+    return (eexam, occ)
+
+  ((btnResult, _), _) <- runFormPost buttonForm
+  
+  formResult btnResult $ \case
     BtnExamDeregister -> do
       runDB $ do
-        deleteBy $ UniqueExamRegistration eId uid
+        deleted <- deleteWhereCount [ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid]
-        audit $ TransactionExamDeregister eId uid
+        unless (deleted <= 0) $
-      addMessageIconI Info IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
+          audit $ TransactionExamDeregister eId uid
-        -- yes, it's a success message, but it should be visually different from a positive success, since most will just note the positive green color! See discussion on commit 5f4925a4
+      addMessageIconI Success IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
       redirect $ CExamR tid ssh csh examn EShowR
+    BtnExamRegisterOccurrence -> do
+      runDB $ do
+        now <- liftIO getCurrentTime
+        void $ upsertBy (UniqueExamRegistration eId uid) (ExamRegistration eId uid (Just occId) now) [ExamRegistrationOccurrence =. Just occId, ExamRegistrationTime =. now]
+        audit $ TransactionExamRegister eId uid
+        addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
+      redirect $ CExamR tid ssh csh examn EShowR
+    _other -> error "Unexpected due to definition of buttonForm'"
+
+  redirect $ CExamR tid ssh csh examn EShowR
   
-  invalidArgs ["Register/Deregister button required"]

src/Handler/Exam/Show.hs

@@ -30,7 +30,7 @@ getEShowR tid ssh csh examn = do
     let gradingVisible = NTop (Just cTime) >= NTop examFinished
     gradingShown <- or2M (return gradingVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
-    let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments
+    let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments || examOccurrenceRule == Just ExamRoomFifo
     occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
     examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
@@ -58,10 +58,16 @@ getEShowR tid ssh csh examn = do
       E.orderBy [E.desc registered, E.asc $ examOccurrence E.^. ExamOccurrenceStart, E.asc $ examOccurrence E.^. ExamOccurrenceRoom]
       return (examOccurrence, registered)
 
-    let occurrences = map (over _2 E.unValue) occurrencesRaw
+    registered <- for mUid $ getBy . UniqueExamRegistration eId
+    mayRegister <- if
+      | examOccurrenceRule == Just ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _) ->
+          hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
+      | otherwise -> hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
 
-    registered <- for mUid $ existsBy . UniqueExamRegistration eId
+    let occurrences = sortOn sortPred $ map (over _2 E.unValue) occurrencesRaw
-    mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
+          where
+            sortPred (Entity _ ExamOccurrence{..}, registered')
+              = (Down $ registered' && not mayRegister, examOccurrenceStart, examOccurrenceRoom)
 
     lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
@@ -84,11 +90,17 @@ getEShowR tid ssh csh examn = do
 
       hasRegistration = any snd occurrences
 
+  mayRegister' <- fmap ((Map.!) . Map.fromList) . for (Nothing : map Just occurrences) $ \case
+    Nothing ->
+      fmap (Nothing, ) . hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
+    Just (Entity occId ExamOccurrence{..}, _) ->
+      fmap (Just occId, ) . hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
 
   let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
-      registerWidget
+      registerWidget mOcc
-        | Just isRegistered <- registered
+        | isRegistered <- is _Just $ join registered
-        , mayRegister = Just $ do
+        , examOccurrenceRule /= Just ExamRoomFifo || (isRegistered && not (any snd occurrences))
+        , mayRegister' (entityKey <$> mOcc) = Just $ do
             (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
             [whamlet|
               <p>
@@ -102,11 +114,37 @@ getEShowR tid ssh csh examn = do
               , formEncoding = examRegisterEnctype
               , formSubmit = FormNoSubmit
             }
-        | fromMaybe False registered = Just [whamlet|_{MsgExamRegistered}|]
+        | examOccurrenceRule == Just ExamRoomFifo
+        , Just (Entity occId ExamOccurrence{..}) <- mOcc
+        , isRegistered <- (== Just occId) $ examRegistrationOccurrence . entityVal =<< join registered
+        , mayRegister' (Just occId) = Just $ do
+            (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegisterOccurrence] [BtnExamDeregister] isRegistered
+            wrapForm examRegisterForm def
+              { formAction = Just . SomeRoute . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
+              , formEncoding = examRegisterEnctype
+              , formSubmit = FormNoSubmit
+            }
+        | is _Nothing mOcc
+        , is _Nothing registered
+        = Just [whamlet|_{MsgExamLoginToRegister}|]
+        | is _Nothing mOcc
+        , isRegistered <- is _Just $ join registered
+        = Just
+            [whamlet|
+              <p>
+                $if isRegistered
+                  _{MsgExamRegistered}
+                $else
+                  _{MsgExamNotRegistered}
+                $if mayRegister
+                  ^{messageTooltip =<< messageI Info MsgExamRegisterForOccurrence}
+            |]
         | otherwise = Nothing
 
       showMaxPoints = any (has $ _entityVal . _examPartMaxPoints . _Just) examParts
       showAchievedPoints = not $ null results
+      showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == Just ExamRoomFifo)
+      markUnregisteredOccurrences mOcc = occurrenceAssignmentsShown && hasRegistration && isn't _Just (registerWidget mOcc)
 
   let heading = prependCourseTitle tid ssh csh $ CI.original examName
 

src/Handler/Utils/Form.hs

@@ -557,6 +557,7 @@ examBonusRuleForm prev = multiActionA actions (fslI MsgExamBonusRule) $ classify
 data ExamOccurrenceRule' = ExamRoomSurname'
                          | ExamRoomMatriculation'
                          | ExamRoomRandom'
+                         | ExamRoomFifo'
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Universe ExamOccurrenceRule'
 instance Finite ExamOccurrenceRule'
@@ -569,6 +570,7 @@ classifyExamOccurrenceRule = \case
   ExamRoomSurname       -> ExamRoomSurname'
   ExamRoomMatriculation -> ExamRoomMatriculation'
   ExamRoomRandom        -> ExamRoomRandom'
+  ExamRoomFifo          -> ExamRoomFifo'
 
 examOccurrenceRuleForm :: Maybe ExamOccurrenceRule -> AForm Handler ExamOccurrenceRule
 examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite) (fslI MsgExamOccurrenceRule) . fmap classifyExamOccurrenceRule
@@ -577,6 +579,7 @@ examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite)
       ExamRoomSurname'       -> ExamRoomSurname
       ExamRoomMatriculation' -> ExamRoomMatriculation
       ExamRoomRandom'        -> ExamRoomRandom
+      ExamRoomFifo'          -> ExamRoomFifo
 
 data ExamGradingRule' = ExamGradingKey'
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)

src/Model/Types/Exam.hs

@@ -139,6 +139,7 @@ derivePersistFieldJSON ''ExamBonusRule
 data ExamOccurrenceRule = ExamRoomSurname
                         | ExamRoomMatriculation
                         | ExamRoomRandom
+                        | ExamRoomFifo
   deriving (Show, Read, Eq, Ord, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1

src/Model/Types/Security.hs

@@ -54,6 +54,8 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
   | AuthCourseRegistered
   | AuthTutorialRegistered
   | AuthExamRegistered
+  | AuthExamOccurrenceRegistered
+  | AuthExamOccurrenceRegistration
   | AuthExamResult
   | AuthParticipant
   | AuthApplicant

templates/exam-show.hamlet

@@ -84,7 +84,7 @@ $maybe desc <- examDescription
             \ ^{isVisible False}
         <dd .deflist__dd>
           _{classifyExamOccurrenceRule occurrenceRule}
-    $maybe registerWdgt <- registerWidget
+    $maybe registerWdgt <- registerWidget Nothing
       <dt .deflist__dt>_{MsgExamRegistration}
       <dd .deflist__dd>^{registerWdgt}
 
@@ -103,31 +103,39 @@ $if not (null occurrences)
             <th .table__th>
               _{MsgExamRoomName}
               \ ^{isVisible False}
-          $if occurrenceAssignmentsShown
-            <th .table__th>
-              _{MsgExamRoomRegistered}
-              $if not occurrenceAssignmentsVisible
-                \ ^{isVisible False}
           <th .table__th>_{MsgExamRoom}
           $if not examTimes
             <th .table__th>_{MsgExamRoomTime}
+          $if showOccurrenceRegisterColumn
+            <th .table__th>
+              $if examOccurrenceRule == Just ExamRoomFifo
+                _{MsgExamRoomRegistered}
+              $else
+                _{MsgExamRoomAssigned}
+              $if not occurrenceAssignmentsVisible
+                \ ^{isVisible False}
           <th .table__th>_{MsgExamRoomDescription}
       <tbody>
-        $forall (Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription}, registered) <- occurrences
+        $forall (occurrence, registered) <- occurrences
-          <tr .table__row :occurrenceAssignmentsShown && (not registered && hasRegistration):.occurrence--not-registered>
+          $with Entity _occId ExamOccurrence{examOccurrenceName, examOccurrenceRoom, examOccurrenceStart, examOccurrenceEnd, examOccurrenceDescription} <- occurrence
-            $if occurrenceNamesShown
+            $with registerWdgt <- registerWidget (Just occurrence)
-              <td .table__td #exam-occurrence__#{examOccurrenceName}>#{examOccurrenceName}
+              <tr .table__row :markUnregisteredOccurrences (Just occurrence) && not registered:.occurrence--not-registered>
-            $if occurrenceAssignmentsShown
+                $if occurrenceNamesShown
-              <td .table__td>
+                  <td .table__td #exam-occurrence__#{examOccurrenceName}>#{examOccurrenceName}
-                $if registered
+                <td .table__td>#{examOccurrenceRoom}
-                  #{iconOK}
+                $if not examTimes
-            <td .table__td>#{examOccurrenceRoom}
+                  <td .table__td>
-            $if not examTimes
+                    ^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}
-              <td .table__td>
+                $if showOccurrenceRegisterColumn
-                ^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}
+                  <td .table__td>
-            <td .table__td>
+                    $maybe registerWdgt' <- registerWdgt
-              $maybe desc <- examOccurrenceDescription
+                      ^{registerWdgt'}
-                #{desc}
+                    $nothing
+                      $if registered
+                        #{iconOK}
+                <td .table__td>
+                  $maybe desc <- examOccurrenceDescription
+                    #{desc}
 
 $if gradingShown && not (null examParts)
   <section>

templates/widgets/tooltip.hamlet

@@ -1,7 +1,7 @@
 $newline never
 
-<div .tooltip :isInlineTooltip:.tooltip__inline>
+<span .tooltip :isInlineTooltip:.tooltip__inline>
-  <div .tooltip__handle .#{urgency}>
+  <span .tooltip__handle .#{urgency}>
     <i .fas .fa-^{ic}>
-  <div .tooltip__content>
+  <span .tooltip__content>
     ^{tooltip}