chore(test): inform test about changed type signature
This commit is contained in:
Wolfgang Witt
Wolfgang Witt
parent
163715afc8
commit
e13049d958
@ -9,6 +9,7 @@ module Handler.Utils.Exam
|
||||
, ExamAutoOccurrenceConfig
|
||||
, eaocMinimizeRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize
|
||||
, _eaocMinimizeRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize
|
||||
, ExamAutoOccurrenceException(..)
|
||||
, examAutoOccurrence
|
||||
, deregisterExamUsersCount, deregisterExamUsers
|
||||
, examAidsPresetWidget, examOnlinePresetWidget, examSynchronicityPresetWidget, examRequiredEquipmentPresetWidget
|
||||
|
||||
@ -90,15 +90,6 @@ instance Show UserProperties where
|
||||
++ ", userMatrikelnummer=" ++ show userMatrikelnummer ++ "}"
|
||||
|
||||
-- function Handler.Utils.examAutoOccurrence
|
||||
-- examAutoOccurrence :: forall seed.
|
||||
-- Hashable seed
|
||||
-- => seed
|
||||
-- -> ExamOccurrenceRule
|
||||
-- -> ExamAutoOccurrenceConfig
|
||||
-- -> Map ExamOccurrenceId Natural
|
||||
-- -> Map UserId (User, Maybe ExamOccurrenceId)
|
||||
-- -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
|
||||
-- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "examAutoOccurrence" $ do
|
||||
@ -125,16 +116,16 @@ spec = do
|
||||
in foldM (genNudge nudgeFrequency) Map.empty $ Map.keys occurrences
|
||||
let config :: ExamAutoOccurrenceConfig
|
||||
config = def {eaocNudge}
|
||||
(maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
|
||||
autoOccurrenceResult = examAutoOccurrence seed rule config occurrences users
|
||||
pure $ ioProperty $ do
|
||||
-- user count stays constant
|
||||
myAnnotate "number of users changed" $ shouldBe (length userMap) (length users)
|
||||
-- no room is overfull
|
||||
let userProperties :: Map UserId (UserProperties, Maybe ExamOccurrenceId)
|
||||
userProperties = Map.map (first UserProperties) users
|
||||
myAnnotate "room capacity exceeded" $ shouldSatisfy (userProperties, occurrences, userMap) $ uncurry3 fitsInRooms
|
||||
case maybeMapping of
|
||||
(Just occurrenceMapping) -> do
|
||||
case autoOccurrenceResult of
|
||||
(Right (occurrenceMapping, userMap)) -> do
|
||||
-- user count stays constant
|
||||
myAnnotate "number of users changed" $ shouldBe (length userMap) (length users)
|
||||
-- no room is overfull
|
||||
myAnnotate "room capacity exceeded" $ shouldSatisfy (userProperties, occurrences, userMap) $ uncurry3 fitsInRooms
|
||||
-- mapping is a valid description
|
||||
myAnnotate "invalid mapping description" $ shouldSatisfy (rule, occurrenceMapping) $ uncurry validRangeDescription
|
||||
-- every (relevant) user got assigned a room
|
||||
@ -151,10 +142,10 @@ spec = do
|
||||
myAnnotate "shown ranges don't match userMap"
|
||||
$ shouldSatisfy (rule, userProperties, occurrenceMapping, userMap) $ uncurry4 showsCorrectRanges
|
||||
-- is a nullResult justified?
|
||||
Nothing ->
|
||||
(Left autoOccurrenceException) ->
|
||||
-- disabled for now, probably not correct with the current implementation
|
||||
myAnnotate "unjustified nullResult"
|
||||
$ shouldSatisfy (rule, userProperties, occurrences) $ uncurry3 isNullResultJustified
|
||||
$ shouldSatisfy (autoOccurrenceException, rule, userProperties, occurrences) $ uncurry4 isNullResultJustified
|
||||
-- | generate users without any pre-assigned rooms
|
||||
genUsersWithOccurrences :: Preselection -> Gen (Map UserId (User, Maybe ExamOccurrenceId), Map ExamOccurrenceId Natural)
|
||||
genUsersWithOccurrences preselection = do
|
||||
@ -234,9 +225,11 @@ spec = do
|
||||
endAfterStart
|
||||
ExamOccurrenceMappingRange {eaomrStart=(pack . map CI.foldedCase -> start), eaomrEnd=(pack . map CI.foldedCase -> end)}
|
||||
= RFC5051.compareUnicode start end /= GT
|
||||
endAfterStart ExamOccurrenceMappingSpecial {} = True
|
||||
endAfterStart _mappingDescription = True
|
||||
-- also check for equal length with ExamRoomMatriculation
|
||||
noDirectOverlap :: ExamOccurrenceMappingDescription -> ExamOccurrenceMappingDescription -> Bool
|
||||
noDirectOverlap ExamOccurrenceMappingRandom other = other == ExamOccurrenceMappingRandom
|
||||
noDirectOverlap other ExamOccurrenceMappingRandom = other == ExamOccurrenceMappingRandom
|
||||
noDirectOverlap
|
||||
ExamOccurrenceMappingRange {eaomrStart=cs0@(pack . map CI.foldedCase -> s0), eaomrEnd=ce0@(pack . map CI.foldedCase -> e0)}
|
||||
ExamOccurrenceMappingRange {eaomrStart=cs1@(pack . map CI.foldedCase -> s1), eaomrEnd=ce1@(pack . map CI.foldedCase -> e1)}
|
||||
@ -294,6 +287,7 @@ spec = do
|
||||
_rule -> Nothing
|
||||
fitsInRange :: ExamOccurrenceMappingDescription -> Bool
|
||||
fitsInRange mappingDescription = case (ciTag, mappingDescription) of
|
||||
(_tag, ExamOccurrenceMappingRandom) -> True
|
||||
(Nothing, _mappingDescription) -> True
|
||||
(Just tag, ExamOccurrenceMappingRange {eaomrStart=(pack . map CI.foldedCase -> start), eaomrEnd=(pack . map CI.foldedCase-> end)})
|
||||
-> (RFC5051.compareUnicode start (pack $ map CI.foldedCase $ transformTag start tag) /= GT)
|
||||
@ -309,25 +303,37 @@ spec = do
|
||||
ExamRoomMatriculation -> isSuffixOf
|
||||
_rule -> isPrefixOf
|
||||
_otherwise -> (rule /= ExamRoomSurname) && (rule /= ExamRoomMatriculation)
|
||||
-- | Is mapping impossible?
|
||||
isNullResultJustified :: ExamOccurrenceRule
|
||||
-- | Is mapping impossible due to the given reason?
|
||||
isNullResultJustified :: ExamAutoOccurrenceException
|
||||
-> ExamOccurrenceRule
|
||||
-> Map UserId (UserProperties, Maybe ExamOccurrenceId)
|
||||
-> Map ExamOccurrenceId Natural -> Bool
|
||||
isNullResultJustified rule userProperties occurrences
|
||||
= noRelevantUsers rule userProperties || mappingImpossible rule userProperties occurrences || True
|
||||
isNullResultJustified ExamAutoOccurrenceExceptionRuleNoOp rule _userProperties _occurrences
|
||||
= not $ examOccurrenceRuleAutomatic rule
|
||||
isNullResultJustified ExamAutoOccurrenceExceptionNotEnoughSpace rule userProperties occurrences
|
||||
= fromIntegral (length $ relevantUsers rule userProperties) > sum occurrences
|
||||
isNullResultJustified ExamAutoOccurrenceExceptionNoUsers rule userProperties _occurrences
|
||||
= noRelevantUsers rule userProperties
|
||||
isNullResultJustified ExamAutoOccurrenceExceptionRoomTooSmall rule userProperties occurrences
|
||||
= mappingImpossible rule userProperties occurrences
|
||||
noRelevantUsers :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Bool
|
||||
noRelevantUsers rule = null . Map.filter (isRelevantUser rule)
|
||||
noRelevantUsers rule = null . relevantUsers rule
|
||||
relevantUsers :: ExamOccurrenceRule
|
||||
-> Map UserId (UserProperties, Maybe ExamOccurrenceId)
|
||||
-> Map UserId (UserProperties, Maybe ExamOccurrenceId)
|
||||
relevantUsers rule = Map.filter $ isRelevantUser rule
|
||||
isRelevantUser :: ExamOccurrenceRule -> (UserProperties, Maybe ExamOccurrenceId) -> Bool
|
||||
isRelevantUser _rule (_user, Just _assignedRoom) = False
|
||||
isRelevantUser rule (UserProperties User {userSurname, userMatrikelnummer}, Nothing) = case rule of
|
||||
ExamRoomSurname -> not $ null userSurname
|
||||
ExamRoomMatriculation -> maybe False (not . null) userMatrikelnummer
|
||||
ExamRoomRandom -> True
|
||||
_rule -> False
|
||||
mappingImpossible :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Bool
|
||||
mappingImpossible
|
||||
rule
|
||||
userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . Map.filter (isRelevantUser rule) -> relevantUsers)
|
||||
(map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 relevantUsers occurrences'
|
||||
userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . relevantUsers rule -> users')
|
||||
(map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 users' occurrences'
|
||||
where
|
||||
smallestRoom :: Natural
|
||||
smallestRoom = maybe 0 minimum $ fromNullable occurrences'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user