fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(test): relax requirements for justified nullResult

Browse Source 
Instances with bigger user buckets than the smallest room might correctly fail
Thus, don't report an error for them.
This commit is contained in:
Wolfgang Witt 2021-02-24 16:33:01 +01:00 committed by Wolfgang Witt
parent 7e1b75c2e1
commit daceac95fc
2 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Utils/Exam.hs
View File

@ -636,7 +636,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
withAlphabetChars :: [CI Char] -> [CI Char] withAlphabetChars :: [CI Char] -> [CI Char]
withAlphabetChars [] = [] withAlphabetChars [] = []
withAlphabetChars (c:cs) withAlphabetChars (c:cs)
| elem c alphabet = c : withAlphabetChars cs | c `elem` alphabet = c : withAlphabetChars cs
| otherwise= case previousAlphabetChar c of | otherwise= case previousAlphabetChar c of
Nothing -> [] Nothing -> []
(Just c') -> c' : replicate (length cs) (last alphabet) (Just c') -> c' : replicate (length cs) (last alphabet)

24
test/Handler/Utils/ExamSpec.hs
View File

@ -316,16 +316,24 @@ spec = do
mappingImpossible mappingImpossible
rule rule
userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . Map.filter (isRelevantUser rule) -> relevantUsers) userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . Map.filter (isRelevantUser rule) -> relevantUsers)
(map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go relevantUsers occurrences' (map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 True relevantUsers occurrences'
where where
go :: [Maybe Text] -> [Natural] -> Bool smallestRoom :: Natural
go [] _occurrences = False smallestRoom = maybe 0 minimum $ fromNullable occurrences'
go _remainingUsers [] = True -- If there exists a bucket with the same tag bigger than the smallest room a nullResult might be returned
go remainingUsers (0:t) = go remainingUsers t -- It may still work, but is not guaranteed (e.g. both the first bucket)
go remainingUsers@(h:_t) (firstOccurrence:laterOccurrences) go :: Natural -> [Maybe Text] -> [Natural] -> Bool
| nextUsers <= firstOccurrence = go remainingUsers' $ firstOccurrence - nextUsers : laterOccurrences go biggestUserBucket [] _occurrences = biggestUserBucket > small
| otherwise = go remainingUsers laterOccurrences go _biggestUserBucket _remainingUsers [] = True
go biggestUserBucket remainingUsers (0:t) = go biggestUserBucket remainingUsers t
go biggestUserBucket remainingUsers@(h:_t) (firstOccurrence:laterOccurrences)
| nextUsers <= firstOccurrence
= go (max biggestUserBucket nextUsers) remainingUsers' $ firstOccurrence - nextUsers : laterOccurrences
| otherwise
= go biggestUserBucket remainingUsers laterOccurrences
where where
nextUsers :: Natural
remainingUsers' :: [Maybe Text]
(fromIntegral . length -> nextUsers, remainingUsers') = span (== h) remainingUsers (fromIntegral . length -> nextUsers, remainingUsers') = span (== h) remainingUsers
ruleProperty :: ExamOccurrenceRule -> UserProperties -> Maybe Text ruleProperty :: ExamOccurrenceRule -> UserProperties -> Maybe Text
ruleProperty rule = case rule of ruleProperty rule = case rule of