From 46e6ca92178c6e008f65c297393bce2045c65c5d Mon Sep 17 00:00:00 2001
From: Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
Date: Mon, 1 Feb 2021 14:51:53 +0100
Subject: [PATCH] chore(test): add tests with nudges

---
 test/Handler/Utils/ExamSpec.hs | 29 ++++++++++++++++++++++++-----
 1 file changed, 24 insertions(+), 5 deletions(-)

diff --git a/test/Handler/Utils/ExamSpec.hs b/test/Handler/Utils/ExamSpec.hs
index d7a3fc517..53b140654 100644
--- a/test/Handler/Utils/ExamSpec.hs
+++ b/test/Handler/Utils/ExamSpec.hs
@@ -31,7 +31,7 @@ instance Arbitrary ExamOccurrence where
 
 data Preselection = NoPreselection | SomePreselection
 
-data Nudges = NoNudges | SomeNudges | LargeNudges
+data Nudges = NoNudges | SmallNudges | LargeNudges
 
 -- function Handler.Utils.examAutoOccurrence
 -- examAutoOccurrence :: forall seed.
@@ -53,6 +53,14 @@ spec = do
                 let nudges = NoNudges
                 prop "no preselected" $ propertyTest rule nudges NoPreselection
                 prop "some preselected" $ propertyTest rule nudges SomePreselection
+            describe "Small Nudges" $ do
+                let nudges = SmallNudges
+                prop "no preselected" $ propertyTest rule nudges NoPreselection
+                prop "some preselected" $ propertyTest rule nudges SomePreselection
+            describe "Large Nudges" $ do
+                let nudges = LargeNudges
+                prop "no preselected" $ propertyTest rule nudges NoPreselection
+                prop "some preselected" $ propertyTest rule nudges SomePreselection
         -- TODO test with some users fixed/preselected to certain rooms
         -- TODO test with ExamRoomManual, ExamRoomFifo, (ExamRoomSurname), ExamRoomMatriculation, ExamRoomRandom
     where
@@ -64,11 +72,15 @@ spec = do
         propertyTest :: ExamOccurrenceRule -> Nudges -> Preselection -> Gen Property
         propertyTest rule nudges preselection = do
             (users, occurrences) <- genUsersWithOccurrences preselection
+            eaocNudge <- case nudges of
+                NoNudges -> pure Map.empty
+                SmallNudges -> let nudgeFrequency = [(10, 0), (5, 1), (5, -1), (3, 2), (3, -2), (1, 3), (1, -3)]
+                                in foldM (genNudge nudgeFrequency) Map.empty $ Map.keys occurrences
+                LargeNudges -> let nudgeFrequency = [(7, 0), (5, 3), (5, -3), (3, 6), (3, -6), (2, 9), (2, -9),
+                                                    (2, 11), (2, -11), (1, 15), (1,-15), (1, 17), (1, -17)]
+                                in foldM (genNudge nudgeFrequency) Map.empty $ Map.keys occurrences
             let config :: ExamAutoOccurrenceConfig
-                config = case nudges of
-                    NoNudges -> def
-                    SomeNudges -> def --TODO, (Map.fromList . concatJust) <$> mapM (\(occurrenceId, _size) -> frequency _someChances) occurrences
-                    LargeNudges -> def --TODO
+                config = def {eaocNudge}
                 result@(_maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
             pure $ ioProperty $ do
                 -- every user got assigned a room
@@ -103,6 +115,13 @@ spec = do
                         createOccurrences $ (entityKey, examOccurrenceCapacity entityVal) : acc
                     | otherwise = pure acc
             Map.fromList <$> createOccurrences []
+        genNudge :: [(Int, Integer)] -> Map ExamOccurrenceId Integer -> ExamOccurrenceId -> Gen (Map ExamOccurrenceId Integer)
+        genNudge nudgesList acc occurrenceId
+            = fmap appendNonZero $ frequency $ map (second pure) nudgesList
+            where
+                appendNonZero :: Integer -> Map ExamOccurrenceId Integer
+                appendNonZero 0 = acc
+                appendNonZero nudge = Map.insert occurrenceId nudge acc
         -- name list copied from test/Database/Fill.hs
         surnames :: [Text]
         surnames =   [ "Smith", "Johnson", "Williams", "Brown"