fix: improve exam occurrence ui

messages/uniworx/de-de-formal.msg

@@ -1541,8 +1541,8 @@ 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 oder selbständige Termin- bzw. Raumzuteilung
+ExamAutomaticOccurrenceAssignment: Termin- bzw. Raumzuteilung
-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.
+ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden, sich selbstständig einen Raum bzw. Termin aussuchen dürfen oder manuell durch Kursverwalter zugeteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
 ExamOccurrenceRule: Verfahren
 ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
 ExamRoomManual': Keine automatische bzw. selbstständige Zuteilung

messages/uniworx/en-eu.msg

@@ -1540,7 +1540,7 @@ ExamBonusRoundNonPositive: Rounding multiple must be positive and greater than z
 ExamBonusRoundTip: Bonus points are rounded commercially to a multiple of the given number
 
 ExamAutomaticOccurrenceAssignment: Selection of occurrences/rooms for/by participants
-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.
+ExamAutomaticOccurrenceAssignmentTip: Should exam participants be distributed automatically among the configured occurrences/rooms, should they instead be permitted to autonomously choose an occurrence/a room, or should they be assigned to occurrences/rooms manually by course administrators? Manipulation of the distribution and manually assigning participants remains possible.
 ExamOccurrenceRule: Procedure
 ExamOccurrenceRuleParticipant: Occurrence/room assignment procedure
 ExamRoomManual': No automatic or autonomous assignment

models/exams.model

@@ -3,7 +3,7 @@ Exam
   name ExamName
   gradingRule ExamGradingRule Maybe
   bonusRule ExamBonusRule Maybe
-  occurrenceRule ExamOccurrenceRule Maybe
+  occurrenceRule ExamOccurrenceRule
   visibleFrom UTCTime Maybe
   registerFrom UTCTime Maybe
   registerTo UTCTime Maybe

src/Foundation.hs

@@ -778,7 +778,7 @@ tagAccessPredicate AuthExamOccurrenceRegistration = APDB $ \_ route _ -> case ro
            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)
+           E.&&. exam E.^. ExamOccurrenceRule E.==. E.val ExamRoomFifo
     guardMExceptT isOccurrenceRegistration (unauthorizedI MsgUnauthorizedExamOccurrenceRegistration)
     return Authorized
   r -> $unsupportedAuthPredicate AuthExamOccurrenceRegistration r

src/Handler/Exam/Form.hs

@@ -39,7 +39,7 @@ data ExamForm = ExamForm
   , efPublicStatistics :: Bool
   , efGradingRule :: Maybe ExamGradingRule
   , efBonusRule :: Maybe ExamBonusRule
-  , efOccurrenceRule :: Maybe ExamOccurrenceRule
+  , efOccurrenceRule :: ExamOccurrenceRule
   , efCorrectors :: Set (Either UserEmail UserId)
   , efExamParts :: Set ExamPartForm
   }
@@ -96,7 +96,7 @@ examForm template html = do
     <*> apopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (efPublicStatistics <$> template <|> Just True)
     <*> optionalActionA (examGradingRuleForm $ efGradingRule =<< template) (fslI MsgExamAutomaticGrading & setTooltip MsgExamAutomaticGradingTip) (is _Just . efGradingRule <$> template)
     <*> optionalActionA (examBonusRuleForm $ efBonusRule =<< template) (fslI MsgExamBonus) (is _Just . efBonusRule <$> template)
-    <*> optionalActionA (examOccurrenceRuleForm $ efOccurrenceRule =<< template) (fslI MsgExamAutomaticOccurrenceAssignment & setTooltip MsgExamAutomaticOccurrenceAssignmentTip) (is _Just . efOccurrenceRule <$> template)
+    <*> (examOccurrenceRuleForm $ efOccurrenceRule <$> template)
     <*  aformSection MsgExamFormCorrection
     <*> examCorrectorsForm (efCorrectors <$> template)
     <*  aformSection MsgExamFormParts

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 || examOccurrenceRule == Just ExamRoomFifo
+    let occurrenceAssignmentsVisible = NTop (Just cTime) >= NTop examPublishOccurrenceAssignments || examOccurrenceRule == ExamRoomFifo
     occurrenceAssignmentsShown <- or2M (return occurrenceAssignmentsVisible) . hasReadAccessTo $ CExamR tid ssh csh examn EEditR
 
     examParts <- sortOn (view $ _entityVal . _examPartNumber) <$> selectList [ ExamPartExam ==. eId ] [ Asc ExamPartName ]
@@ -60,7 +60,7 @@ getEShowR tid ssh csh examn = do
 
     registered <- for mUid $ getBy . UniqueExamRegistration eId
     mayRegister <- if
-      | examOccurrenceRule == Just ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _) ->
+      | examOccurrenceRule == ExamRoomFifo -> anyM occurrencesRaw $ \(Entity _ ExamOccurrence{..}, _) ->
           hasWriteAccessTo . CExamR tid ssh csh examName $ ERegisterOccR examOccurrenceName
       | otherwise -> hasWriteAccessTo $ CExamR tid ssh csh examName ERegisterR
 
@@ -99,7 +99,7 @@ getEShowR tid ssh csh examn = do
   let examTimes = all (\(Entity _ ExamOccurrence{..}, _) -> Just examOccurrenceStart == examStart && examOccurrenceEnd == examEnd) occurrences
       registerWidget mOcc
         | isRegistered <- is _Just $ join registered
-        , examOccurrenceRule /= Just ExamRoomFifo || (isRegistered && not (any snd occurrences))
+        , examOccurrenceRule /= ExamRoomFifo || (isRegistered && not (any snd occurrences))
         , mayRegister' (entityKey <$> mOcc) = Just $ do
             (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
             [whamlet|
@@ -114,7 +114,7 @@ getEShowR tid ssh csh examn = do
               , formEncoding = examRegisterEnctype
               , formSubmit = FormNoSubmit
             }
-        | examOccurrenceRule == Just ExamRoomFifo
+        | examOccurrenceRule == ExamRoomFifo
         , Just (Entity occId ExamOccurrence{..}) <- mOcc
         , isRegistered <- (== Just occId) $ examRegistrationOccurrence . entityVal =<< join registered
         , mayRegister' (Just occId) = Just $ do
@@ -143,7 +143,7 @@ getEShowR tid ssh csh examn = do
 
       showMaxPoints = any (has $ _entityVal . _examPartMaxPoints . _Just) examParts
       showAchievedPoints = not $ null results
-      showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == Just ExamRoomFifo)
+      showOccurrenceRegisterColumn = occurrenceAssignmentsShown || (mayRegister && examOccurrenceRule == ExamRoomFifo)
       markUnregisteredOccurrences mOcc = occurrenceAssignmentsShown && hasRegistration && isn't _Just (registerWidget mOcc)
 
   let heading = prependCourseTitle tid ssh csh $ CI.original examName

src/Handler/Utils/Form.hs

@@ -554,10 +554,11 @@ examBonusRuleForm prev = multiActionA actions (fslI MsgExamBonusRule) $ classify
         )
       ]
 
-data ExamOccurrenceRule' = ExamRoomSurname'
+data ExamOccurrenceRule' = ExamRoomManual'
+                         | ExamRoomFifo'
+                         | ExamRoomSurname'
                          | ExamRoomMatriculation'
                          | ExamRoomRandom'
-                         | ExamRoomFifo'
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
 instance Universe ExamOccurrenceRule'
 instance Finite ExamOccurrenceRule'
@@ -567,19 +568,21 @@ embedRenderMessage ''UniWorX ''ExamOccurrenceRule' id
 
 classifyExamOccurrenceRule :: ExamOccurrenceRule -> ExamOccurrenceRule'
 classifyExamOccurrenceRule = \case
+  ExamRoomManual        -> ExamRoomManual'
   ExamRoomSurname       -> ExamRoomSurname'
   ExamRoomMatriculation -> ExamRoomMatriculation'
   ExamRoomRandom        -> ExamRoomRandom'
   ExamRoomFifo          -> ExamRoomFifo'
 
 examOccurrenceRuleForm :: Maybe ExamOccurrenceRule -> AForm Handler ExamOccurrenceRule
-examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite) (fslI MsgExamOccurrenceRule) . fmap classifyExamOccurrenceRule
+examOccurrenceRuleForm = fmap reverseClassify . areq (selectField optionsFinite) (fslI MsgExamAutomaticOccurrenceAssignment & setTooltip MsgExamAutomaticOccurrenceAssignmentTip) . fmap classifyExamOccurrenceRule
   where
     reverseClassify = \case
+      ExamRoomManual'        -> ExamRoomManual
+      ExamRoomFifo'          -> ExamRoomFifo
       ExamRoomSurname'       -> ExamRoomSurname
       ExamRoomMatriculation' -> ExamRoomMatriculation
       ExamRoomRandom'        -> ExamRoomRandom
-      ExamRoomFifo'          -> ExamRoomFifo
 
 data ExamGradingRule' = ExamGradingKey'
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)

src/Model/Migration.hs

@@ -599,6 +599,13 @@ customMigrations = Map.fromListWith (>>)
           ALTER TABLE "study_features" DROP COLUMN "sub_field";
         |]
     )
+  , ( AppliedMigrationKey [migrationVersion|29.0.0|] [version|30.0.0|]
+    , whenM (tableExists "exam") $
+        [executeQQ|
+          UPDATE "exam" SET "occurrence_rule" = #{ExamRoomManual} WHERE "occurrence_rule" IS NULL;
+          ALTER TABLE "exam" ALTER COLUMN "occurrence_rule" SET NOT NULL;
+        |]
+    )
   ]
 
 

src/Model/Types/Exam.hs

@@ -136,10 +136,11 @@ deriveJSON defaultOptions
   } ''ExamBonusRule
 derivePersistFieldJSON ''ExamBonusRule
 
-data ExamOccurrenceRule = ExamRoomSurname
+data ExamOccurrenceRule = ExamRoomManual
+                        | ExamRoomFifo
+                        | ExamRoomSurname
                         | ExamRoomMatriculation
                         | ExamRoomRandom
-                        | ExamRoomFifo
   deriving (Show, Read, Eq, Ord, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1

templates/exam-show.hamlet

@@ -76,14 +76,14 @@ $maybe desc <- examDescription
             \ ^{isVisible False}
         <dd .deflist__dd>
           ^{examBonusW bonusRule}
-    $maybe occurrenceRule <- examOccurrenceRule
+    $if examOccurrenceRule /= ExamRoomManual
       $if occurrenceAssignmentsShown
         <dt .deflist__dt>
           _{MsgExamOccurrenceRuleParticipant}
           $if not occurrenceAssignmentsVisible
             \ ^{isVisible False}
         <dd .deflist__dd>
-          _{classifyExamOccurrenceRule occurrenceRule}
+          _{classifyExamOccurrenceRule examOccurrenceRule}
     $maybe registerWdgt <- registerWidget Nothing
       <dt .deflist__dt>_{MsgExamRegistration}
       <dd .deflist__dd>^{registerWdgt}
@@ -108,7 +108,7 @@ $if not (null occurrences)
             <th .table__th>_{MsgExamRoomTime}
           $if showOccurrenceRegisterColumn
             <th .table__th>
-              $if examOccurrenceRule == Just ExamRoomFifo
+              $if examOccurrenceRule == ExamRoomFifo
                 _{MsgExamRoomRegistered}
               $else
                 _{MsgExamRoomAssigned}

test/Database.hs

@@ -504,7 +504,7 @@ fillDb = do
     , examName = "Klausur"
     , examGradingRule = Nothing
     , examBonusRule = Nothing
-    , examOccurrenceRule = Nothing
+    , examOccurrenceRule = ExamRoomManual
     , examVisibleFrom = Just now
     , examRegisterFrom = Just now
     , examRegisterTo = Just $ addUTCTime (14 * nominalDay) now