chore(test): rearrange to allow easier parameter adjustments

test/Handler/Utils/ExamSpec.hs

@@ -28,6 +28,11 @@ instance Arbitrary ExamOccurrence where
         <*> arbitrary                       -- examOccurrenceEnd
         <*> arbitrary                       -- examOccurrenceDescription
 
+
+data Preselection = NoPreselection | SomePreselection
+
+data Nudges = NoNudges | SomeNudges | LargeNudges
+
 -- function Handler.Utils.examAutoOccurrence
 -- examAutoOccurrence :: forall seed.
 --                       Hashable seed
@@ -44,42 +49,46 @@ spec = do
         describe "Surname" $ do
             let rule :: ExamOccurrenceRule
                 rule = ExamRoomSurname
-            prop "no Nudges, no preselection" $ do
+            describe "No Nudges" $ do
-                (users, occurrences) <- genUsersWithOccurrences False
+                let nudges = NoNudges
-                let result@(_maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
+                prop "no preselected" $ propertyTest rule nudges NoPreselection
-                pure $ ioProperty $ do
+                prop "some preselected" $ propertyTest rule nudges SomePreselection
-                    -- every user got assigned a room
-                    shouldBe (length userMap) (length users)
-                    shouldSatisfy userMap $ all isJust
-                    -- no room is overfull
-                    shouldSatisfy (occurrences, userMap) $ uncurry fitsInRooms
-                    -- all users match the shown ranges
-                    shouldSatisfy (users, result) $ uncurry showsCorrectRanges
-            prop "no Nudges, some preselected" $ do
-                (users, occurrences) <- genUsersWithOccurrences True
-                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 (occurrences, userMap) $ uncurry fitsInRooms
-                    -- all users match the shown ranges or their preselection
-                    shouldSatisfy (users, result) $ uncurry showsCorrectRanges
         -- TODO test with some users fixed/preselected to certain rooms
         -- TODO test with ExamRoomManual, ExamRoomFifo, (ExamRoomSurname), ExamRoomMatriculation, ExamRoomRandom
     where
+        seed :: ()
+        seed = ()
+        -- TODO adjust with different nudges, depended on occurrences list/map
+        -- def {eaocNudge = Map.singleton occ20Id (-11)}
+        --ExamAutoOccurrenceConfig {eaocMinimizeRooms = False, eaocFinenessCost = 1 % 5, eaocNudge = fromList [(SqlBackendKey {unSqlBackendKey = 4},-11)], eaocNudgeSize = 1 % 20}
+        propertyTest :: ExamOccurrenceRule -> Nudges -> Preselection -> Gen Property
+        propertyTest rule nudges preselection = do
+            (users, occurrences) <- genUsersWithOccurrences preselection
+            let config :: ExamAutoOccurrenceConfig
+                config = case nudges of
+                    NoNudges -> def
+                    SomeNudges -> def --TODO, (Map.fromList . concatJust) <$> mapM (\(occurrenceId, _size) -> frequency _someChances) occurrences
+                    LargeNudges -> def --TODO
+                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 (occurrences, userMap) $ uncurry fitsInRooms
+                -- all users match the shown ranges
+                shouldSatisfy (users, result) $ uncurry showsCorrectRanges
         -- | generate users without any pre-assigned rooms
-        genUsersWithOccurrences :: Bool -> Gen (Map UserId (User, Maybe ExamOccurrenceId), Map ExamOccurrenceId Natural)
+        genUsersWithOccurrences :: Preselection -> Gen (Map UserId (User, Maybe ExamOccurrenceId), Map ExamOccurrenceId Natural)
-        genUsersWithOccurrences assignSomeUsers = do
+        genUsersWithOccurrences preselection = do
             rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
             occurrences <- genOccurrences $ length rawUsers
             -- user surnames anpassen, sodass interessante instanz
             users <- fmap Map.fromList $ forM rawUsers $ \Entity {entityKey, entityVal} -> do
                 userSurname <- elements surnames
-                assignedRoom <- if assignSomeUsers
+                assignedRoom <- case preselection of
-                    then frequency [(97, pure Nothing), (3, elements $ map Just $ Map.keys occurrences)]
+                    NoPreselection -> pure Nothing
-                    else pure Nothing
+                    SomePreselection -> frequency [(97, pure Nothing), (3, elements $ map Just $ Map.keys occurrences)]
                 pure (entityKey, (entityVal {userSurname}, assignedRoom))
             pure (users, occurrences)
         genOccurrences :: Int -> Gen (Map ExamOccurrenceId Natural)
@@ -105,13 +114,6 @@ spec = do
                     , "Clark", "Lewis", "Robinson", "Walker"
                     , "Perez", "Hall", "Young", "Allen"
                     ]
-        seed :: ()
-        seed = ()
-        config :: ExamAutoOccurrenceConfig
-        config = def
-        -- TODO adjust with different nudges, depended on occurrences list/map
-        -- def {eaocNudge = Map.singleton occ20Id (-11)}
-        --ExamAutoOccurrenceConfig {eaocMinimizeRooms = False, eaocFinenessCost = 1 % 5, eaocNudge = fromList [(SqlBackendKey {unSqlBackendKey = 4},-11)], eaocNudgeSize = 1 % 20}
         occurrenceMap :: Map UserId (Maybe ExamOccurrenceId) -> Map ExamOccurrenceId [UserId]
         occurrenceMap userMap = foldl' (\acc (userId, maybeOccurrenceId) -> appendJust maybeOccurrenceId userId acc)
             Map.empty $ Map.toAscList userMap
@@ -119,6 +121,7 @@ spec = do
                 appendJust :: Maybe ExamOccurrenceId -> UserId -> Map ExamOccurrenceId [UserId] -> Map ExamOccurrenceId [UserId]
                 appendJust Nothing _userId = id
                 appendJust (Just occurrenceId) userId = Map.insertWith (++) occurrenceId [userId]
+        -- | Are all rooms large enough to hold all assigned Users?
         fitsInRooms :: Map ExamOccurrenceId Natural
                     -> Map UserId (Maybe ExamOccurrenceId)
                     -> Bool
@@ -129,6 +132,8 @@ spec = do
                 roomIsBigEnough (roomId, userIds) = case lookup roomId occurrences of
                     Nothing -> False
                     (Just capacity) -> length userIds <= fromIntegral capacity
+        -- | Does the (currently surname) User fit to the displayed ranges?
+        -- Users with a previously assigned room are checked if the assignment stays the same, regardless of the ranges.
         showsCorrectRanges :: Map UserId (User, Maybe ExamOccurrenceId)
                             -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
                             -> Bool