chore: also return sorted-state of occurrences
This commit is contained in:
parent
f6cbf99245
commit
362e2cf00d
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user