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

chore(test): move generators to their own functions

Browse Source
This commit is contained in:
Wolfgang Witt 2021-02-01 12:27:26 +01:00 committed by Wolfgang Witt
parent c0fd3bc1e4
commit 5de8f0ae23
1 changed files with 36 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19,7 +19,7 @@ import Handler.Utils.Exam
-- are these capacity values realistic? -- are these capacity values realistic?
instance Arbitrary ExamOccurrence where instance Arbitrary ExamOccurrence where
arbitrary = ExamOccurrence arbitrary = ExamOccurrence
<$> arbitrary -- examOccurrenceExam <$> arbitrary -- examOccurrenceExam
<*> arbitrary -- examOccurrenceName <*> arbitrary -- examOccurrenceName
<*> arbitrary -- examOccurrenceRoom <*> arbitrary -- examOccurrenceRoom
<*> arbitrary -- examOccurrenceRoomHidden <*> arbitrary -- examOccurrenceRoomHidden
@ -40,37 +40,42 @@ instance Arbitrary ExamOccurrence where
-- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users -- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
spec :: Spec spec :: Spec
spec = do spec = do
prop "examAutoOccurrence Surname, no Nudges, no preselection" $ do -- TODO describe "examAutoOccurrence" $ do
rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary prop "Surname, no Nudges, no preselection" $ do -- TODO
-- user surnames anpassen, sodass interessante instanz users <- genUsers
adjustedUsers <- forM rawUsers $ \Entity {entityKey, entityVal} -> do occurrences <- genOccurrences $ length users
userSurname <- elements surnames let result@(_maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
pure (entityKey, (entityVal {userSurname}, Nothing)) pure $ ioProperty $ do
let users = Map.fromList adjustedUsers -- every user got assigned a room
numUsers = length users shouldBe (length userMap) (length users)
-- TODO is this realistic? shouldSatisfy userMap $ all isJust
-- extra space to get nice borders -- no room is overfull
extraSpace <- elements [numUsers `div` 4 .. numUsers] shouldSatisfy userMap $ fitsInRooms occurrences
let totalSpaceRequirement = fromIntegral $ numUsers + extraSpace -- all users match the shown ranges
createOccurrences acc shouldSatisfy result $ showsCorrectRanges users
| sum (map snd acc) < totalSpaceRequirement = do -- TODO test with some users fixed/preselected to certain rooms
Entity {entityKey, entityVal} <- Entity <$> arbitrary <*> arbitrary -- TODO test with ExamRoomManual, ExamRoomFifo, (ExamRoomSurname), ExamRoomMatriculation, ExamRoomRandom
createOccurrences $ (entityKey, examOccurrenceCapacity entityVal) : acc
| otherwise = pure acc
occurrences <- Map.fromList <$> createOccurrences []
--let occurrences = Map.empty :: Map ExamOccurrenceId Natural
let result@(_maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
pure $ ioProperty $ do
-- every user got assigned a room
shouldBe (length userMap) (length users)
shouldSatisfy userMap $ all isJust
-- no room is overfull
shouldSatisfy userMap $ fitsInRooms occurrences
-- all users match the shown ranges
shouldSatisfy result $ showsCorrectRanges users
-- TODO test with some users fixed/preselected to certain rooms
-- TODO test with ExamRoomManual, ExamRoomFifo, (ExamRoomSurname), ExamRoomMatriculation, ExamRoomRandom
where where
-- | generate users without any pre-assigned rooms
genUsers :: Gen (Map UserId (User, Maybe ExamOccurrenceId))
genUsers = do
rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
-- user surnames anpassen, sodass interessante instanz
fmap Map.fromList $ forM rawUsers $ \Entity {entityKey, entityVal} -> do
userSurname <- elements surnames
pure (entityKey, (entityVal {userSurname}, Nothing))
genOccurrences :: Int -> Gen (Map ExamOccurrenceId Natural)
genOccurrences numUsers = do
-- TODO is this realistic?
-- extra space to get nice borders
extraSpace <- elements [numUsers `div` 4 .. numUsers `div` 2]
let totalSpaceRequirement = fromIntegral $ numUsers + extraSpace
createOccurrences acc
| sum (map snd acc) < totalSpaceRequirement = do
Entity {entityKey, entityVal} <- Entity <$> arbitrary <*> arbitrary
createOccurrences $ (entityKey, examOccurrenceCapacity entityVal) : acc
| otherwise = pure acc
Map.fromList <$> createOccurrences []
-- name list copied from test/Database/Fill.hs -- name list copied from test/Database/Fill.hs
surnames :: [Text] surnames :: [Text]
surnames = [ "Smith", "Johnson", "Williams", "Brown" surnames = [ "Smith", "Johnson", "Williams", "Brown"