fix(test): isNullResultJustified reported false positives
matriculation numbers are limited to suffixes of equal length now the relevant test respects this (may result in bigger buckets)
This commit is contained in:
parent
e14c4091e6
commit
292f5cf91b
@ -14,6 +14,7 @@ import qualified Data.Map as Map
|
|||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
import qualified Data.Foldable as Foldable
|
||||||
|
|
||||||
import qualified Data.RFC5051 as RFC5051
|
import qualified Data.RFC5051 as RFC5051
|
||||||
|
|
||||||
@ -332,14 +333,14 @@ spec = do
|
|||||||
mappingImpossiblePlausible :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Bool
|
mappingImpossiblePlausible :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Bool
|
||||||
mappingImpossiblePlausible
|
mappingImpossiblePlausible
|
||||||
rule
|
rule
|
||||||
userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . relevantUsers rule -> users')
|
userProperties@(sortBy RFC5051.compareUnicode . mapRuleProperty rule . Map.elems . relevantUsers rule -> users')
|
||||||
(map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 users' occurrences'
|
(map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 users' occurrences'
|
||||||
where
|
where
|
||||||
smallestRoom :: Natural
|
smallestRoom :: Natural
|
||||||
smallestRoom = maybe 0 minimum $ fromNullable occurrences'
|
smallestRoom = maybe 0 minimum $ fromNullable occurrences'
|
||||||
-- If there exists a bucket with the same tag bigger than the smallest room a nullResult might be returned
|
-- If there exists a bucket with the same tag bigger than the smallest room a nullResult might be returned
|
||||||
-- It may still work, but is not guaranteed (e.g. both the first bucket)
|
-- It may still work, but is not guaranteed (e.g. both the first bucket)
|
||||||
go :: Natural -> [Maybe Text] -> [Natural] -> Bool
|
go :: forall a. Eq a => Natural -> [a] -> [Natural] -> Bool
|
||||||
go biggestUserBucket [] _occurrences = biggestUserBucket > smallestRoom
|
go biggestUserBucket [] _occurrences = biggestUserBucket > smallestRoom
|
||||||
go _biggestUserBucket _remainingUsers [] = True
|
go _biggestUserBucket _remainingUsers [] = True
|
||||||
go biggestUserBucket remainingUsers (0:t) = go biggestUserBucket remainingUsers t
|
go biggestUserBucket remainingUsers (0:t) = go biggestUserBucket remainingUsers t
|
||||||
@ -350,13 +351,18 @@ spec = do
|
|||||||
= go biggestUserBucket remainingUsers laterOccurrences
|
= go biggestUserBucket remainingUsers laterOccurrences
|
||||||
where
|
where
|
||||||
nextUsers :: Natural
|
nextUsers :: Natural
|
||||||
remainingUsers' :: [Maybe Text]
|
remainingUsers' :: [a]
|
||||||
(fromIntegral . length -> nextUsers, remainingUsers') = span (== h) remainingUsers
|
(fromIntegral . length -> nextUsers, remainingUsers') = span (== h) remainingUsers
|
||||||
ruleProperty :: ExamOccurrenceRule -> UserProperties -> Maybe Text
|
mapRuleProperty :: ExamOccurrenceRule -> [(UserProperties, b)] -> [Text]
|
||||||
ruleProperty rule = case rule of
|
mapRuleProperty rule (map fst -> users') = map (ruleProperty rule minMatrLength) users'
|
||||||
ExamRoomSurname -> Just . userSurname . user
|
where
|
||||||
ExamRoomMatriculation -> userMatrikelnummer . user
|
minMatrLength :: Int
|
||||||
_rule -> const Nothing
|
minMatrLength = Foldable.minimum $ map (maybe 0 Text.length . userMatrikelnummer . user) users'
|
||||||
|
ruleProperty :: ExamOccurrenceRule -> Int -> UserProperties -> Text
|
||||||
|
ruleProperty rule n = case rule of
|
||||||
|
ExamRoomSurname -> userSurname . user
|
||||||
|
ExamRoomMatriculation -> maybe Text.empty (Text.takeEnd n) . userMatrikelnummer . user
|
||||||
|
_rule -> const $ pack $ show rule
|
||||||
-- copied and adjusted from Hander.Utils.Exam
|
-- copied and adjusted from Hander.Utils.Exam
|
||||||
adjustOccurrences :: Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Map ExamOccurrenceId Natural
|
adjustOccurrences :: Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Map ExamOccurrenceId Natural
|
||||||
-- ^ reduce room capacity for every pre-assigned user by 1
|
-- ^ reduce room capacity for every pre-assigned user by 1
|
||||||
|
|||||||
Reference in New Issue
Block a user