From 362e2cf00dc961a3f69d7b4be85bc0eef9df9d78 Mon Sep 17 00:00:00 2001 From: Wolfgang Witt Date: Wed, 17 Mar 2021 23:44:06 +0100 Subject: [PATCH] chore: also return sorted-state of occurrences --- src/Handler/Exam/AutoOccurrence.hs | 19 ++++++++----------- src/Handler/Utils/Exam.hs | 26 +++++++++++++++----------- 2 files changed, 23 insertions(+), 22 deletions(-) diff --git a/src/Handler/Exam/AutoOccurrence.hs b/src/Handler/Exam/AutoOccurrence.hs index e0388dc95..c48166e7e 100644 --- a/src/Handler/Exam/AutoOccurrence.hs +++ b/src/Handler/Exam/AutoOccurrence.hs @@ -59,10 +59,10 @@ examAutoOccurrenceCalculateForm ExamAutoOccurrenceCalculateForm{ eaofConfig } <*> pure def automaticIfTrue :: Bool -> ExamAutoOccurrenceIgnoreRooms automaticIfTrue True = EAOIRAutomatic - automaticIfTrue False = EAOIRManual Set.empty + automaticIfTrue False = def ignoreRooms :: ExamAutoOccurrenceIgnoreRooms -> Bool ignoreRooms EAOIRAutomatic = True - ignoreRooms (EAOIRManual s) = not $ null s + ignoreRooms EAOIRManual {eaoirmSorted} = eaoirmSorted examAutoOccurrenceNudgeForm :: ExamOccurrenceId -> Maybe ExamAutoOccurrenceCalculateForm -> Form ExamAutoOccurrenceCalculateForm examAutoOccurrenceNudgeForm occId protoForm html = do @@ -84,21 +84,18 @@ examAutoOccurrenceNudgeForm occId protoForm html = do 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 + genForm btn = protoForm' & _eaofConfig . _eaocIgnoreRooms %~ action 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 + action EAOIRAutomatic = EAOIRManual {eaoirmIgnored=Set.empty, eaoirmSorted=True} + action ir@EAOIRManual {eaoirmIgnored, eaoirmSorted} = case btn of + BtnExamAutoOccurrenceIgnoreEnable -> EAOIRManual {eaoirmIgnored=Set.insert occId eaoirmIgnored, eaoirmSorted} + BtnExamAutoOccurrenceIgnoreDisable -> EAOIRManual {eaoirmIgnored=Set.delete occId eaoirmIgnored, eaoirmSorted} + _other -> ir res = genForm <$> btnRes oldDataView = fieldView (secretJsonField :: Field Handler _) oldDataId (toPathPiece PostExamAutoOccurrencePrevious) [] (Right . fromMaybe protoForm' $ formResult' res) False return (res, wgt <> oldDataView) diff --git a/src/Handler/Utils/Exam.hs b/src/Handler/Utils/Exam.hs index 2000aeb25..596700220 100644 --- a/src/Handler/Utils/Exam.hs +++ b/src/Handler/Utils/Exam.hs @@ -217,11 +217,13 @@ examBonusGrade exam@Exam{..} bonusInp = (mBonus, ) . examGrade exam mBonus bonusPossible = normalSummary <$> sheetSummary bonusAchieved = (<>) <$> fmap normalSummary sheetSummary <*> fmap bonusSummary sheetSummary -data ExamAutoOccurrenceIgnoreRooms = EAOIRAutomatic | EAOIRManual (Set ExamOccurrenceId) +data ExamAutoOccurrenceIgnoreRooms + = EAOIRAutomatic + | EAOIRManual {eaoirmIgnored :: Set ExamOccurrenceId, eaoirmSorted :: Bool} deriving (Eq, Ord, Read, Show, Generic, Typeable) instance Default ExamAutoOccurrenceIgnoreRooms where - def = EAOIRManual Set.empty + def = EAOIRManual Set.empty False deriveJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 @@ -267,7 +269,7 @@ examAutoOccurrence :: forall seed. -> Map ExamOccurrenceId ExamOccurrenceCapacity -> Map UserId (User, Maybe ExamOccurrenceId) -> Either ExamAutoOccurrenceException - (ExamOccurrenceMapping ExamOccurrenceId, Map UserId (Maybe ExamOccurrenceId), Set ExamOccurrenceId) + (ExamOccurrenceMapping ExamOccurrenceId, Map UserId (Maybe ExamOccurrenceId), ExamAutoOccurrenceIgnoreRooms) examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users | Map.null users' = Left ExamAutoOccurrenceExceptionNoUsers @@ -405,28 +407,30 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences predToPositive (Restricted n) = Just $ Restricted $ pred n occurrences'' :: [(ExamOccurrenceId, ExamOccurrenceCapacity)] - ignoredOccurrences :: Set ExamOccurrenceId -- ^ Minimise number of occurrences used -- -- Prefer occurrences with higher capacity -- -- If a single occurrence can accommodate all participants, pick the one with -- the least capacity + ignoredOccurrences :: ExamAutoOccurrenceIgnoreRooms + -- ^ will always be EAOIRManual with eaoirSorted noting if occurrences were downwards sorted by size (occurrences'', ignoredOccurrences) = case eaocIgnoreRooms of - (EAOIRManual manuallyIgnored) -> (Map.toList $ Map.withoutKeys occurrences' manuallyIgnored, manuallyIgnored) + EAOIRManual {..} -> ((if eaoirmSorted then sortOn (Down . view _2) else id) $ Map.toList $ Map.withoutKeys occurrences' eaoirmIgnored, eaocIgnoreRooms) EAOIRAutomatic -- effect of ticked minimizeRooms Checkbox | Just largeEnoughs <- fromNullable . filter ((>= Restricted usersCount) . view _2) $ Map.toList occurrences' -> let pickedLargeEnough = minimumBy (comparing $ view _2) largeEnoughs - in (pure pickedLargeEnough, Set.delete (view _1 pickedLargeEnough) $ Map.keysSet occurrences') + in (pure pickedLargeEnough, EAOIRManual {eaoirmIgnored=Set.delete (view _1 pickedLargeEnough) $ Map.keysSet occurrences', eaoirmSorted=True}) | otherwise - -> (\(_,b,c) -> (b,c)) . foldl' accF (Restricted 0, [], Set.empty) . sortOn (Down . view _2) $ Map.toList occurrences' + -> (\(_, used, unused) -> (used, EAOIRManual {eaoirmIgnored=Set.fromList unused, eaoirmSorted=True})) + . foldl' accF (Restricted 0, [], []) . sortOn (Down . view _2) $ Map.toList occurrences' where - accF :: (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)], Set ExamOccurrenceId) + accF :: (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)], [ExamOccurrenceId]) -> (ExamOccurrenceId, ExamOccurrenceCapacity) - -> (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)], Set ExamOccurrenceId) + -> (ExamOccurrenceCapacity, [(ExamOccurrenceId, ExamOccurrenceCapacity)], [ExamOccurrenceId]) accF (accSize, accOccs, accIgnored) occ@(occId, occSize) | accSize >= Restricted usersCount - = (accSize, accOccs, Set.insert occId accIgnored) + = (accSize, accOccs, occId:accIgnored) | otherwise = ( accSize <> occSize , occ : accOccs @@ -660,7 +664,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences postprocess :: [(ExamOccurrenceId, [[CI Char]])] -> ( Map ExamOccurrenceId (Set ExamOccurrenceMappingDescription) , Map UserId (Maybe ExamOccurrenceId) - , Set ExamOccurrenceId + , ExamAutoOccurrenceIgnoreRooms ) postprocess result = (resultAscList, resultUsers, ignoredOccurrences) where