diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index fb215fdd6..ba9234bc4 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/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 -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. +ExamAutomaticOccurrenceAssignment: Termin- bzw. Raumzuteilung +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 diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index a39d5fd77..de38ca936 100644 --- a/messages/uniworx/en-eu.msg +++ b/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 diff --git a/models/exams.model b/models/exams.model index c23917bc7..5baa6e711 100644 --- a/models/exams.model +++ b/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 diff --git a/src/Foundation.hs b/src/Foundation.hs index dd390b7b8..07cd31a94 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 1604a4207..5b8cc8723 100644 --- a/src/Handler/Exam/Form.hs +++ b/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 diff --git a/src/Handler/Exam/Show.hs b/src/Handler/Exam/Show.hs index 138a50391..cc31d91f1 100644 --- a/src/Handler/Exam/Show.hs +++ b/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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 197e3156b..4bcf7e775 100644 --- a/src/Handler/Utils/Form.hs +++ b/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) diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index 0a18babde..9859c9115 100644 --- a/src/Model/Migration.hs +++ b/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; + |] + ) ] diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs index 40e6852d5..7e7ce52bc 100644 --- a/src/Model/Types/Exam.hs +++ b/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 diff --git a/templates/exam-show.hamlet b/templates/exam-show.hamlet index 9d385d87b..3652474ef 100644 --- a/templates/exam-show.hamlet +++ b/templates/exam-show.hamlet @@ -76,14 +76,14 @@ $maybe desc <- examDescription \ ^{isVisible False}
^{examBonusW bonusRule} - $maybe occurrenceRule <- examOccurrenceRule + $if examOccurrenceRule /= ExamRoomManual $if occurrenceAssignmentsShown
_{MsgExamOccurrenceRuleParticipant} $if not occurrenceAssignmentsVisible \ ^{isVisible False}
- _{classifyExamOccurrenceRule occurrenceRule} + _{classifyExamOccurrenceRule examOccurrenceRule} $maybe registerWdgt <- registerWidget Nothing
_{MsgExamRegistration}
^{registerWdgt} @@ -108,7 +108,7 @@ $if not (null occurrences) _{MsgExamRoomTime} $if showOccurrenceRegisterColumn - $if examOccurrenceRule == Just ExamRoomFifo + $if examOccurrenceRule == ExamRoomFifo _{MsgExamRoomRegistered} $else _{MsgExamRoomAssigned} diff --git a/test/Database.hs b/test/Database.hs index e037be9a6..8335ef6ac 100755 --- a/test/Database.hs +++ b/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