chore(test): move generators to their own functions

This commit is contained in:
Wolfgang Witt 2021-02-01 12:27:26 +01:00 committed by Wolfgang Witt
parent c0fd3bc1e4
commit 5de8f0ae23

View File

@ -40,25 +40,10 @@ 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
pure (entityKey, (entityVal {userSurname}, Nothing))
let users = Map.fromList adjustedUsers
numUsers = length users
-- TODO is this realistic?
-- extra space to get nice borders
extraSpace <- elements [numUsers `div` 4 .. numUsers]
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
occurrences <- Map.fromList <$> createOccurrences []
--let occurrences = Map.empty :: Map ExamOccurrenceId Natural
let result@(_maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users let result@(_maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
pure $ ioProperty $ do pure $ ioProperty $ do
-- every user got assigned a room -- every user got assigned a room
@ -71,6 +56,26 @@ spec = do
-- TODO test with some users fixed/preselected to certain rooms -- TODO test with some users fixed/preselected to certain rooms
-- TODO test with ExamRoomManual, ExamRoomFifo, (ExamRoomSurname), ExamRoomMatriculation, ExamRoomRandom -- 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"