diff --git a/messages/uniworx/misc/de-de-formal.msg b/messages/uniworx/misc/de-de-formal.msg index a0b474015..1aae9ada9 100644 --- a/messages/uniworx/misc/de-de-formal.msg +++ b/messages/uniworx/misc/de-de-formal.msg @@ -2824,6 +2824,8 @@ BtnExamAutoOccurrenceCalculate: Verteilungstabelle berechnen BtnExamAutoOccurrenceAccept: Verteilung akzeptieren BtnExamAutoOccurrenceNudgeUp: + BtnExamAutoOccurrenceNudgeDown: - +BtnExamAutoOccurrenceIgnoreEnable: Ignorieren +BtnExamAutoOccurrenceIgnoreDisable: Berücksichtigen ExamRoomMappingSurname: Nachnamen beginnend mit ExamRoomMappingMatriculation: Matrikelnummern endend in ExamRoomMappingRandom: Verteilung diff --git a/messages/uniworx/misc/en-eu.msg b/messages/uniworx/misc/en-eu.msg index 0242ab0ea..d6c8c5734 100644 --- a/messages/uniworx/misc/en-eu.msg +++ b/messages/uniworx/misc/en-eu.msg @@ -2824,6 +2824,8 @@ BtnExamAutoOccurrenceCalculate: Calculate assignment rules BtnExamAutoOccurrenceAccept: Accept assignments BtnExamAutoOccurrenceNudgeUp: + BtnExamAutoOccurrenceNudgeDown: - +BtnExamAutoOccurrenceIgnoreEnable: Ignore +BtnExamAutoOccurrenceIgnoreDisable: Reconsider ExamRoomMappingSurname: Surnames starting with ExamRoomMappingMatriculation: Matriculation numbers ending in ExamRoomMappingRandom: Distribution diff --git a/src/Handler/Exam/AutoOccurrence.hs b/src/Handler/Exam/AutoOccurrence.hs index 714701ff5..b4ee68dd5 100644 --- a/src/Handler/Exam/AutoOccurrence.hs +++ b/src/Handler/Exam/AutoOccurrence.hs @@ -10,6 +10,7 @@ import Handler.Utils import Handler.Utils.Exam import qualified Data.Map as Map +import qualified Data.Set as Set import qualified Database.Esqueleto as E import Database.Persist.Sql (updateWhereCount) @@ -35,6 +36,7 @@ data ExamAutoOccurrenceButton = BtnExamAutoOccurrenceCalculate | BtnExamAutoOccurrenceAccept | BtnExamAutoOccurrenceNudgeUp | BtnExamAutoOccurrenceNudgeDown + | BtnExamAutoOccurrenceIgnoreEnable | BtnExamAutoOccurrenceIgnoreDisable deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) instance Universe ExamAutoOccurrenceButton instance Finite ExamAutoOccurrenceButton @@ -53,8 +55,14 @@ examAutoOccurrenceCalculateForm ExamAutoOccurrenceCalculateForm{ eaofConfig } = identifyForm FIDExamAutoOccurrenceCalculate . renderAForm FormStandard $ ExamAutoOccurrenceCalculateForm <$> eaocForm where eaocForm = - (set _eaocMinimizeRooms <$> apopt checkBoxField (fslI MsgExamAutoOccurrenceMinimizeRooms & setTooltip MsgExamAutoOccurrenceMinimizeRoomsTip) (Just $ eaofConfig ^. _eaocMinimizeRooms)) + (set _eaocIgnoreRooms . automaticIfTrue <$> apopt checkBoxField (fslI MsgExamAutoOccurrenceMinimizeRooms & setTooltip MsgExamAutoOccurrenceMinimizeRoomsTip) (Just . ignoreRooms $ eaofConfig ^. _eaocIgnoreRooms)) <*> pure def + automaticIfTrue :: Bool -> ExamAutoOccurrenceIgnoreRooms + automaticIfTrue True = EAOIRAutomatic + automaticIfTrue False = EAOIRManual Set.empty + ignoreRooms :: ExamAutoOccurrenceIgnoreRooms -> Bool + ignoreRooms EAOIRAutomatic = True + ignoreRooms (EAOIRManual s) = null s examAutoOccurrenceNudgeForm :: ExamOccurrenceId -> Maybe ExamAutoOccurrenceCalculateForm -> Form ExamAutoOccurrenceCalculateForm examAutoOccurrenceNudgeForm occId protoForm html = do @@ -73,6 +81,28 @@ examAutoOccurrenceNudgeForm occId protoForm html = do oldDataView = fieldView (secretJsonField :: Field Handler _) oldDataId (toPathPiece PostExamAutoOccurrencePrevious) [] (Right . fromMaybe protoForm' $ formResult' res) False return (res, wgt <> oldDataView) +examAutoOccurrenceIgnoreRoomsForm :: ExamOccurrenceId -> Maybe ExamAutoOccurrenceCalculateForm -> Form ExamAutoOccurrenceCalculateForm +examAutoOccurrenceIgnoreRoomsForm occId protoForm html = do + cID <- encrypt occId + -- TODO new constructor instead of FIDExamAutoOccurrenceNudge + -- type FormIdentifier, lives in Utils.Form + (btnRes, wgt) <- identifyForm (FIDExamAutoOccurrenceIgnoreRooms $ ciphertext cID) (buttonForm' [BtnExamAutoOccurrenceIgnoreEnable, BtnExamAutoOccurrenceIgnoreDisable]) html + oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField + oldDataId <- newIdent + + let protoForm' = fromMaybe def $ oldDataRes <|> protoForm + genForm btn = protoForm' & _eaofConfig . _eaocIgnoreRooms %~ EAOIRManual . action occId . toManualSet + where + toManualSet EAOIRAutomatic = Set.empty + toManualSet (EAOIRManual s) = s + action = case btn of + BtnExamAutoOccurrenceIgnoreEnable -> Set.insert + BtnExamAutoOccurrenceIgnoreDisable -> Set.delete + _other -> flip const -- i.e. ignore argument + res = genForm <$> btnRes + oldDataView = fieldView (secretJsonField :: Field Handler _) oldDataId (toPathPiece PostExamAutoOccurrencePrevious) [] (Right . fromMaybe protoForm' $ formResult' res) False + return (res, wgt <> oldDataView) + examAutoOccurrenceAcceptForm :: Maybe ExamAutoOccurrenceAcceptForm -> Form ExamAutoOccurrenceAcceptForm examAutoOccurrenceAcceptForm confirmData = identifyForm FIDExamAutoOccurrenceConfirm $ \html -> do (confirmDataRes, confirmDataView) <- mreq secretJsonField "" confirmData @@ -102,8 +132,11 @@ postEAutoOccurrenceR tid ssh csh examn = do nudgeRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId -> runFormPost $ examAutoOccurrenceNudgeForm occId (formResult' calculateRes) + + ignoreRoomsRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId -> + runFormPost $ examAutoOccurrenceIgnoreRoomsForm occId (formResult' calculateRes) - let calculateRes' = asum $ calculateRes : nudgeRes ^.. folded . _1 . _1 + let calculateRes' = asum $ calculateRes : nudgeRes ^.. folded . _1 . _1 ++ ignoreRoomsRes ^.. folded . _1 . _1 calcResult <- formResultMaybe calculateRes' $ \ExamAutoOccurrenceCalculateForm{..} -> runDB $ do participants <- E.select . E.from $ \(registration `E.InnerJoin` user) -> do @@ -115,11 +148,12 @@ postEAutoOccurrenceR tid ssh csh examn = do return (uid, (userRec, examRegistrationOccurrence)) occurrences' = Map.fromList $ map (\(Entity eoId ExamOccurrence{..}) -> (eoId, _examOccurrenceCapacityIso # (fromIntegral <$> examOccurrenceCapacity))) occurrences autoOccurrenceResult = examAutoOccurrence eId examOccurrenceRule eaofConfig occurrences' participants' - (eaofMapping, eaofAssignment) <- case autoOccurrenceResult of + (eaofMapping, eaofAssignment, _ignoredOccurrences) <- case autoOccurrenceResult of (Left e) -> do addMessageI Error e redirect $ CExamR tid ssh csh examn EUsersR (Right r) -> pure r + -- TODO use returned ignoredOccurrences return $ Just ExamAutoOccurrenceAcceptForm{..} ((confirmRes, confirmView), confirmEncoding) <- runFormPost $ examAutoOccurrenceAcceptForm calcResult @@ -153,6 +187,14 @@ postEAutoOccurrenceR tid ssh csh examn = do , formAttrs = [("class", "buttongroup")] } + let ignoreRoomWgt = ignoreRoomsRes <&> \((_, ignoreRoomsView), ignoreRoomsEncoding) -> + wrapForm ignoreRoomsView def + { formAction = Just . SomeRoute $ CExamR tid ssh csh examn EAutoOccurrenceR + , formEncoding = ignoreRoomsEncoding + , formSubmit = FormNoSubmit + , formAttrs = [("class", "buttongroup")] + } + ExamAutoOccurrenceAcceptForm{..} <- maybe (redirect $ CExamR tid ssh csh examn EUsersR) return calcResult let heading = MsgTitleExamAutoOccurrence tid ssh csh examn diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index 9d4da6a67..e8f8c6b1c 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -6,7 +6,7 @@ module Handler.Utils.Exam , examRelevantSheets, examBonusPossible, examBonusAchieved , examResultBonus, examGrade , examBonusGrade - , ExamAutoOccurrenceConfig + , ExamAutoOccurrenceConfig, ExamAutoOccurrenceIgnoreRooms(..) , eaocIgnoreRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize , _eaocIgnoreRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize , ExamAutoOccurrenceException(..) diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 3913263cd..a2145e5e3 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -229,7 +229,7 @@ data FormIdentifier | FIDUserAuthMode | FIDUserAssimilate | FIDUserRights | FIDUserAuthentication | FIDAllUsersAction | FIDLanguage - | FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm | FIDExamAutoOccurrenceNudge UUID + | FIDExamAutoOccurrenceCalculate | FIDExamAutoOccurrenceConfirm | FIDExamAutoOccurrenceNudge UUID | FIDExamAutoOccurrenceIgnoreRooms UUID | FIDAllocationAccept | FIDTestDownload | FIDAllocationRegister diff --git a/templates/widgets/exam-occurrence-mapping.hamlet b/templates/widgets/exam-occurrence-mapping.hamlet index 4383169af..2b63fcb91 100644 --- a/templates/widgets/exam-occurrence-mapping.hamlet +++ b/templates/widgets/exam-occurrence-mapping.hamlet @@ -34,6 +34,8 @@ $newline never $maybe nudgeWgt' <- Map.lookup occId nudgeWgt ^{nudgeWgt'} + $maybe ignoreRoomWgt' <- Map.lookup occId ignoreRoomWgt + ^{ignoreRoomWgt'} $maybe mappingWgt <- occMapping occId ^{mappingWgt}