chore(test): refine ExamOccurence-creation

This commit is contained in:
Wolfgang Witt 2021-01-30 15:59:57 +01:00 committed by Wolfgang Witt
parent 52678cddf4
commit aba5c53a0b

View File

@ -15,21 +15,19 @@ import Control.Applicative (ZipList(..))
import Handler.Utils.Exam
-- TODO
-- use frequency instead of elements?
-- are these capacity values realistic?
instance Arbitrary ExamOccurrence where
arbitrary = ExamOccurrence <$> arbitrary -- examOccurrenceExam
<*> arbitrary -- examOccurrenceName
<*> arbitrary -- examOccurrenceRoom
<*> arbitrary -- examOccurrenceRoomHidden
<*> arbitrary -- examOccurrenceCapacity
<*> arbitrary -- examOccurrenceStart
<*> arbitrary -- examOccurrenceEnd
<*> arbitrary -- examOccurrenceDescription
newtype FixedHash = FixedHash Int
instance Hashable FixedHash where
hashWithSalt _salt (FixedHash h) = h
arbitrary = ExamOccurrence
<$> arbitrary -- examOccurrenceExam
<*> arbitrary -- examOccurrenceName
<*> arbitrary -- examOccurrenceRoom
<*> arbitrary -- examOccurrenceRoomHidden
<*> elements [10, 20, 50, 100, 200] -- examOccurrenceCapacity
<*> arbitrary -- examOccurrenceStart
<*> arbitrary -- examOccurrenceEnd
<*> arbitrary -- examOccurrenceDescription
-- function Handler.Utils.examAutoOccurrence
-- examAutoOccurrence :: forall seed.
@ -43,19 +41,31 @@ instance Hashable FixedHash where
-- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
spec :: Spec
spec = do
--it "examAutoOccurrence error case" $ flip shouldSatisfy fitsInRooms
-- $ examAutoOccurrence seed rule config occurrences users
prop "property test" $ do -- TODO
rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
-- user surnames anpassen, sodass interessante instanz
let users = Map.fromList $ map (\Entity {entityKey, entityVal} -> (entityKey, (entityVal, Nothing))) rawUsers
rawOccurrences <- listOf $ Entity <$> arbitrary <*> arbitrary
let occurrences = Map.fromList $ map (\Entity {entityKey, entityVal} -> (entityKey, examOccurrenceCapacity entityVal)) rawOccurrences
adjustedUsers <- forM rawUsers $ \Entity {entityKey, entityVal} -> do
userSurname <- elements surnames
pure (entityKey, (entityVal {userSurname}, Nothing))
let users = Map.fromList adjustedUsers
numUsers = length users
-- TODO is this realistic?
-- extra space to get nice borders
extraSpace <- elements [numUsers `div` 4 .. numUsers]
let totalSpaceRequirement = fromIntegral $ numUsers + extraSpace
createOccurrences acc
| sum (map snd acc) < totalSpaceRequirement = do
Entity {entityKey, entityVal} <- Entity <$> arbitrary <*> arbitrary
createOccurrences $ (entityKey, examOccurrenceCapacity entityVal) : acc
| otherwise = pure acc
occurrences <- Map.fromList <$> createOccurrences []
--let occurrences = Map.empty :: Map ExamOccurrenceId Natural
let (maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
pure $ ioProperty $ do
shouldSatisfy rawUsers $ not . null
print $ Map.map (userSurname . fst) users
shouldSatisfy users $ not . null
shouldSatisfy occurrences $ not . null
-- TODO test with some users fixed to certain rooms
where
-- name list copied from test/Database/Fill.hs
surnames = [ "Smith", "Johnson", "Williams", "Brown"
@ -87,10 +97,12 @@ spec = do
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?
{-
newtype FixedHash = FixedHash Int
instance Hashable FixedHash where
hashWithSalt _salt (FixedHash h) = h
seed = FixedHash -7234408896601100696
rule = ExamRoomSurname
config = ExamAutoOccurrenceConfig {eaocMinimizeRooms = False, eaocFinenessCost = 1 % 5, eaocNudge = fromList [(SqlBackendKey {unSqlBackendKey = 4},-11)], eaocNudgeSize = 1 % 20}