From 5de8f0ae23c9a2f671a4b8bf1c31def3be1896ff Mon Sep 17 00:00:00 2001
From: Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
Date: Mon, 1 Feb 2021 12:27:26 +0100
Subject: [PATCH] chore(test): move generators to their own functions

---
 test/Handler/Utils/ExamSpec.hs | 67 ++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 31 deletions(-)

diff --git a/test/Handler/Utils/ExamSpec.hs b/test/Handler/Utils/ExamSpec.hs
index 01ca48b63..b643be08b 100644
--- a/test/Handler/Utils/ExamSpec.hs
+++ b/test/Handler/Utils/ExamSpec.hs
@@ -19,7 +19,7 @@ import Handler.Utils.Exam
 -- are these capacity values realistic?
 instance Arbitrary ExamOccurrence where
     arbitrary = ExamOccurrence
-        <$> arbitrary                        -- examOccurrenceExam
+        <$> arbitrary                       -- examOccurrenceExam
         <*> arbitrary                       -- examOccurrenceName
         <*> arbitrary                       -- examOccurrenceRoom
         <*> arbitrary                       -- examOccurrenceRoomHidden
@@ -40,37 +40,42 @@ instance Arbitrary ExamOccurrence where
 -- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
 spec :: Spec
 spec = do
-    prop "examAutoOccurrence Surname, no Nudges, no preselection" $ do -- TODO
-        rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
-        -- user surnames anpassen, sodass interessante instanz
-        adjustedUsers <- forM rawUsers $ \Entity {entityKey, entityVal} -> do
-            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
-        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
+    describe "examAutoOccurrence" $ do
+        prop "Surname, no Nudges, no preselection" $ do -- TODO
+            users <- genUsers
+            occurrences <- genOccurrences $ length users
+            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
+        -- | 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
         surnames :: [Text]
         surnames =   [ "Smith", "Johnson", "Williams", "Brown"