From f68ae3b356ec358cdee2a8e793b6b5a730e11490 Mon Sep 17 00:00:00 2001 From: Wolfgang Witt Date: Tue, 26 Jan 2021 16:12:19 +0100 Subject: [PATCH] chore(test): first try at property test (incomplete) --- test/Handler/Utils/ExamSpec.hs | 119 ++++++++++++++++++++++++++++++++- 1 file changed, 116 insertions(+), 3 deletions(-) diff --git a/test/Handler/Utils/ExamSpec.hs b/test/Handler/Utils/ExamSpec.hs index d694e6abe..13c86db21 100644 --- a/test/Handler/Utils/ExamSpec.hs +++ b/test/Handler/Utils/ExamSpec.hs @@ -2,6 +2,19 @@ module Handler.Utils.ExamSpec where import TestImport +import Test.Hspec.QuickCheck (prop) + +--import qualified Data.Map as Map +import qualified Data.Text as Text + +import Control.Applicative (ZipList(..)) + +--import Handler.Utils.Exam + +newtype FixedHash = FixedHash Int + +instance Hashable FixedHash where + hashWithSalt _salt (FixedHash h) = h -- function Handler.Utils.examAutoOccurrence -- examAutoOccurrence :: forall seed. @@ -12,6 +25,109 @@ import TestImport -- -> Map ExamOccurrenceId Natural -- -> Map UserId (User, Maybe ExamOccurrenceId) -- -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId)) +-- 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 + pure $ ioProperty $ do + print $ length manyUsers + shouldSatisfy manyUsers $ (> 5) . length + 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" + ] + surnames = [ "Smith", "Johnson", "Williams", "Brown" + , "Jones", "Miller", "Davis", "Garcia" + , "Rodriguez", "Wilson", "Martinez", "Anderson" + , "Taylor", "Thomas", "Hernandez", "Moore" + , "Martin", "Jackson", "Thompson", "White" + , "Lopez", "Lee", "Gonzalez", "Harris" + , "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) + 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.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 + -} + +-- TODO how do I create UserId/ExamOccurrenceId? + + +{- +seed = FixedHash -7234408896601100696 +rule = ExamRoomSurname +config = ExamAutoOccurrenceConfig {eaocMinimizeRooms = False, eaocFinenessCost = 1 % 5, eaocNudge = fromList [(SqlBackendKey {unSqlBackendKey = 4},-11)], eaocNudgeSize = 1 % 20} +occurrences = fromList [(SqlBackendKey {unSqlBackendKey = 1},5),(SqlBackendKey {unSqlBackendKey = 2},15),(SqlBackendKey {unSqlBackendKey = 3},10),(SqlBackendKey {unSqlBackendKey = 4},20),(SqlBackendKey {unSqlBackendKey = 5},10)] +-} + {- trace result of arguments with erroneous output (users split into multiple lines for better: let traceMsg = "\n\n\n-------------\nseed: " ++ show seed @@ -66,6 +182,3 @@ userNotificationSettings = [(NTSubmissionRatedGraded,True),(NTSubmissionRated,Tr userNotificationSettings = [(NTSubmissionRatedGraded,True),(NTSubmissionRated,True),(NTSubmissionEdited,True),(NTSubmissionUserCreated,True),(NTSubmissionUserDeleted,True),(NTSheetActive,True),(NTSheetHint,True),(NTSheetSolution,True),(NTSheetSoonInactive,False),(NTSheetInactive,True),(NTCorrectionsAssigned,True),(NTCorrectionsNotDistributed,True),(NTUserRightsUpdate,True),(NTUserAuthModeUpdate,True),(NTExamRegistrationActive,True),(NTExamRegistrationSoonInactive,False),(NTExamDeregistrationSoonInactive,True),(NTExamResult,True),(NTAllocationStaffRegister,True),(NTAllocationAllocation,True),(NTAllocationRegister,True),(NTAllocationNewCourse,False),(NTAllocationOutdatedRatings,True),(NTAllocationUnratedApplications,True),(NTAllocationResults,True),(NTExamOfficeExamResults,True),(NTExamOfficeExamResultsChanged,True),(NTCourseRegistered,True)], userWarningDays = 1209600s, userCsvOptions = CsvOptions {csvFormat = CsvFormatOptions {csvDelimiter = ',', csvUseCrLf = True, csvQuoting = QuoteMinimal, csvEncoding = UTF8}, csvTimestamp = False}, userSex = Nothing, userShowSex = False},Nothing)),(SqlBackendKey {unSqlBackendKey = 1934},(User {userSurname = "Davis", userDisplayName = "Susan Davis", userDisplayEmail = "Susan.Davis@example.invalid", userEmail = "Susan.Davis@example.invalid", userIdent = "Susan.Davis@example.invalid", userAuthentication = AuthLDAP, userLastAuthentication = Nothing, userCreated = 2021-01-04 13:25:03.752361 UTC, userLastLdapSynchronisation = Nothing, userLdapPrimaryKey = Nothing, userTokensIssuedAfter = Nothing, userMatrikelnummer = Just "30728879", userFirstName = "Susan", userTitle = Nothing, userMaxFavourites = 12, userMaxFavouriteTerms = 12, userTheme = ThemeDefault, userDateTimeFormat = DateTimeFormat {unDateTimeFormat = "%a %d %b %Y %R"}, userDateFormat = DateTimeFormat {unDateTimeFormat = "%a %d %b %Y"}, userTimeFormat = DateTimeFormat {unDateTimeFormat = "%R"}, userDownloadFiles = False, userLanguages = Just (Languages ["de-de-formal","de-de","de"]), userNotificationSettings = [(NTSubmissionRatedGraded,True),(NTSubmissionRated,True),(NTSubmissionEdited,True),(NTSubmissionUserCreated,True),(NTSubmissionUserDeleted,True),(NTSheetActive,True),(NTSheetHint,True),(NTSheetSolution,True),(NTSheetSoonInactive,False),(NTSheetInactive,True),(NTCorrectionsAssigned,True),(NTCorrectionsNotDistributed,True),(NTUserRightsUpdate,True),(NTUserAuthModeUpdate,True),(NTExamRegistrationActive,True),(NTExamRegistrationSoonInactive,False),(NTExamDeregistrationSoonInactive,True),(NTExamResult,True),(NTAllocationStaffRegister,True),(NTAllocationAllocation,True),(NTAllocationRegister,True),(NTAllocationNewCourse,False),(NTAllocationOutdatedRatings,True),(NTAllocationUnratedApplications,True),(NTAllocationResults,True),(NTExamOfficeExamResults,True),(NTExamOfficeExamResultsChanged,True),(NTCourseRegistered,True)], userWarningDays = 1209600s, userCsvOptions = CsvOptions {csvFormat = CsvFormatOptions {csvDelimiter = ',', csvUseCrLf = True, csvQuoting = QuoteMinimal, csvEncoding = UTF8}, csvTimestamp = False}, userSex = Nothing, userShowSex = False},Nothing))] -} - -spec :: Spec -spec = error "ToDo!!!" --TODO