chore(test): first try at property test (incomplete)
This commit is contained in:
Wolfgang Witt
Wolfgang Witt
parent
e487ceff58
commit
f68ae3b356
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user