chore(test): refine ExamOccurence-creation
This commit is contained in:
parent
52678cddf4
commit
aba5c53a0b
@ -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}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user