From a9f432d6b022c496b4525f71e705eb587bd53caa Mon Sep 17 00:00:00 2001 From: Wolfgang Witt Date: Tue, 26 Jan 2021 17:28:46 +0100 Subject: [PATCH] chore(test): finally manged to create a users map --- test/Handler/Utils/ExamSpec.hs | 93 +++++++++------------------------- 1 file changed, 25 insertions(+), 68 deletions(-) diff --git a/test/Handler/Utils/ExamSpec.hs b/test/Handler/Utils/ExamSpec.hs index 13c86db21..456984238 100644 --- a/test/Handler/Utils/ExamSpec.hs +++ b/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?