chore(test): finally manged to create a users map

test/Handler/Utils/ExamSpec.hs

@@ -1,15 +1,19 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
 module Handler.Utils.ExamSpec where
 
 import TestImport
 
+import ModelSpec ()     -- instance Arbitrary User
+
 import Test.Hspec.QuickCheck (prop)
 
---import qualified Data.Map as Map
+import qualified Data.Map as Map
 import qualified Data.Text as Text
 
 import Control.Applicative (ZipList(..))
 
---import Handler.Utils.Exam
+import Handler.Utils.Exam
 
 newtype FixedHash = FixedHash Int
 
@@ -28,62 +32,20 @@ instance Hashable FixedHash where
 -- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
 spec :: Spec
 spec = do
-    now <- runIO getCurrentTime
     --it "examAutoOccurrence error case" $ flip shouldSatisfy fitsInRooms
     --    $ examAutoOccurrence seed rule config occurrences users
     prop "property test" $ do -- TODO
-        matrikel <- toMatrikel <$> listOf1 (growingElements [1 .. 9]) :: Gen [Text]
-        let manyUser (firstName, middleName, userSurname) (Just -> userMatrikelnummer) = User
-                { userIdent
-                , userAuthentication = AuthLDAP
-                , userLastAuthentication = Nothing
-                , userTokensIssuedAfter = Nothing
-                , userMatrikelnummer
-                , userEmail = userIdent
-                , userDisplayEmail = userIdent
-                , userDisplayName = case middleName of
-                    Just middleName' -> firstName <> " " <> middleName' <> " " <> userSurname
-                    Nothing          -> firstName <> " " <> userSurname
-                , userSurname
-                , userFirstName = maybe id (\m f -> f <> " " <> m) middleName firstName
-                , userTitle = Nothing
-                , userMaxFavourites = 5
-                , userMaxFavouriteTerms = 5
-                , userTheme = ThemeDefault
-                , userDateTimeFormat = discard
-                , userDateFormat = discard
-                , userTimeFormat = discard
-                , userDownloadFiles = False
-                , userWarningDays = discard
-                , userLanguages = Nothing
-                , userNotificationSettings = def
-                , userCreated = now
-                , userLastLdapSynchronisation = Nothing
-                , userLdapPrimaryKey = Nothing
-                , userCsvOptions = def
-                , userSex = Nothing
-                , userShowSex = False
-                }
-                where
-                    userIdent :: IsString t => t
-                    userIdent = fromString $ Text.unpack $ case middleName of
-                        Just middleName' -> firstName <> "." <> middleName' <> "." <> userSurname <> "@example.invalid"
-                        Nothing          -> firstName <> "." <> userSurname <> "@example.invalid"
-            manyUsers = getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
+        rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
+        -- user surnames anpassen, sodass interessante instanz
+        let users = Map.fromList $ map (\Entity {entityKey, entityVal} -> (entityKey, (entityVal, Nothing))) rawUsers
+        --occurrences <- arbitrary :: Gen (Map ExamOccurrenceId Natural)
+        let occurrences = Map.empty :: Map ExamOccurrenceId Natural
+        let (maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
         pure $ ioProperty $ do
-            print $ length manyUsers
-            shouldSatisfy manyUsers $ (> 5) . length
+            print (length users, length occurrences)
+            shouldSatisfy rawUsers $ not . null
     where
-        -- utility functions copied from test/Database/Fill.hs
-        firstNames = [ "James", "John", "Robert", "Michael"
-                    , "William", "David", "Mary", "Richard"
-                    , "Joseph", "Thomas", "Charles", "Daniel"
-                    , "Matthew", "Patricia", "Jennifer", "Linda"
-                    , "Elizabeth", "Barbara", "Anthony", "Donald"
-                    , "Mark", "Paul", "Steven", "Andrew"
-                    , "Kenneth", "Joshua", "George", "Kevin"
-                    , "Brian", "Edward", "Susan", "Ronald"
-                    ]
+        -- name list copied from test/Database/Fill.hs
         surnames =   [ "Smith", "Johnson", "Williams", "Brown"
                     , "Jones", "Miller", "Davis", "Garcia"
                     , "Rodriguez", "Wilson", "Martinez", "Anderson"
@@ -93,30 +55,25 @@ spec = do
                     , "Clark", "Lewis", "Robinson", "Walker"
                     , "Perez", "Hall", "Young", "Allen"
                     ]
-        middlenames = [ Nothing, Just "Jamesson" ]
-        toMatrikel :: [Int] -> [Text]
-        toMatrikel ns
-            | (cs, rest) <- splitAt 8 ns
-            , length cs == 8
-            = foldMap tshow cs : toMatrikel rest
-            | otherwise
-            = []
-        {-
-        seed = FixedHash (-7234408896601100696)
+        seed = ()
+        --seed = FixedHash (-7234408896601100696)
         rule = ExamRoomSurname
         config :: ExamAutoOccurrenceConfig
         config = def --{eaocNudge = Map.singleton occ20Id (-11)}
             --ExamAutoOccurrenceConfig {eaocMinimizeRooms = False, eaocFinenessCost = 1 % 5, eaocNudge = fromList [(SqlBackendKey {unSqlBackendKey = 4},-11)], eaocNudgeSize = 1 % 20}
-        occurrence :: Map ExamOccurrenceId Natural
+        {-
+        occurrences :: Map ExamOccurrenceId Natural
         occurrences = Map.empty --TODO
             --fromList [(SqlBackendKey {unSqlBackendKey = 1},5),(SqlBackendKey {unSqlBackendKey = 2},15),(SqlBackendKey {unSqlBackendKey = 3},10),(SqlBackendKey {unSqlBackendKey = 4},20),(SqlBackendKey {unSqlBackendKey = 5},10)]
         users :: Map UserId User
         users = Map.empty   --TODO
-        --fitsInRooms :: (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId)) -> Bool
-        fitsInRooms (Nothing, _userMap) = False
-        fitsInRooms (Just (examOccurrenceMappingMapping -> m), _userMap)
-            = all (\(roomId, mappingSet) -> maybe False (< length mappingSet) $ lookup roomId occurrences) $ Map.toAscList m
         -}
+        fitsInRooms :: Map ExamOccurrenceId Natural
+                    -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
+                    -> Bool
+        fitsInRooms _occurrences (Nothing, _userMap) = False
+        fitsInRooms occurrences (Just (examOccurrenceMappingMapping -> m), _userMap)
+            = all (\(roomId, mappingSet) -> maybe False ((< length mappingSet) . fromIntegral) $ lookup roomId occurrences) $ Map.toAscList m
 
 -- TODO how do I create UserId/ExamOccurrenceId?