From 4d9ef2a64d675333f47f3299fd7a4823cea48857 Mon Sep 17 00:00:00 2001
From: Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
Date: Mon, 1 Feb 2021 13:10:44 +0100
Subject: [PATCH] chore(test): property test with preselected users

---
 test/Handler/Utils/ExamSpec.hs | 60 ++++++++++++++++++++++------------
 1 file changed, 39 insertions(+), 21 deletions(-)

diff --git a/test/Handler/Utils/ExamSpec.hs b/test/Handler/Utils/ExamSpec.hs
index b643be08b..ae6783595 100644
--- a/test/Handler/Utils/ExamSpec.hs
+++ b/test/Handler/Utils/ExamSpec.hs
@@ -41,29 +41,47 @@ instance Arbitrary ExamOccurrence where
 spec :: Spec
 spec = do
     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
+        describe "Surname" $ do
+            let rule :: ExamOccurrenceRule
+                rule = ExamRoomSurname
+            prop "no Nudges, no preselection" $ do
+                (users, occurrences) <- genUsersWithOccurrences False
+                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
+                    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
         -- | generate users without any pre-assigned rooms
-        genUsers :: Gen (Map UserId (User, Maybe ExamOccurrenceId))
-        genUsers = do
+        genUsersWithOccurrences :: Bool -> Gen (Map UserId (User, Maybe ExamOccurrenceId), Map ExamOccurrenceId Natural)
+        genUsersWithOccurrences assignSomeUsers = do
             rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
+            occurrences <- genOccurrences $ length rawUsers
             -- user surnames anpassen, sodass interessante instanz
-            fmap Map.fromList $ forM rawUsers $ \Entity {entityKey, entityVal} -> do
+            users <- fmap Map.fromList $ forM rawUsers $ \Entity {entityKey, entityVal} -> do
                 userSurname <- elements surnames
-                pure (entityKey, (entityVal {userSurname}, Nothing))
+                assignedRoom <- if assignSomeUsers
+                    then frequency [(97, pure Nothing), (3, elements $ map Just $ Map.keys occurrences)]
+                    else pure Nothing
+                pure (entityKey, (entityVal {userSurname}, assignedRoom))
+            pure (users, occurrences)
         genOccurrences :: Int -> Gen (Map ExamOccurrenceId Natural)
         genOccurrences numUsers = do
             -- TODO is this realistic?
@@ -89,8 +107,6 @@ spec = do
                     ]
         seed :: ()
         seed = ()
-        rule :: ExamOccurrenceRule
-        rule = ExamRoomSurname
         config :: ExamAutoOccurrenceConfig
         config = def
         -- TODO adjust with different nudges, depended on occurrences list/map
@@ -117,13 +133,15 @@ spec = do
                             -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
                             -> Bool
         showsCorrectRanges _users (Nothing, _userMap) = False
-        showsCorrectRanges users (Just (examOccurrenceMappingMapping -> m), userMap)
+        showsCorrectRanges users (Just (examOccurrenceMappingMapping -> mappingRanges), userMap)
             = all userFitsInRange $ Map.toAscList $ occurrenceMap userMap
             where
                 userFitsInRange :: (ExamOccurrenceId, [UserId]) -> Bool
                 userFitsInRange (roomId, userIds) = flip all userIds $ \userId ->
-                    case (Map.lookup roomId m, Map.lookup userId users) of
-                        (Just ranges, Just (User {userSurname}, _fixedRoom))
+                    case (Map.lookup roomId mappingRanges, Map.lookup userId users) of
+                        (_maybeRanges, Just (User {}, Just fixedRoomId))
+                            -> roomId == fixedRoomId
+                        (Just ranges, Just (User {userSurname}, Nothing))
                             -> any fitsInRange ranges
                             where
                                 ciSurname :: [CI Char]