chore: also return sorted-state of occurrences

This commit is contained in:
Wolfgang Witt 2021-03-17 23:44:06 +01:00 committed by Gregor Kleen
parent f6cbf99245
commit 362e2cf00d
2 changed files with 23 additions and 22 deletions

View File

@ -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)

View File

@ -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