fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(test): provide very "arbitrary" instance for ExamOccurrence

Browse Source
This commit is contained in:
Wolfgang Witt 2021-01-26 17:45:23 +01:00 committed by Wolfgang Witt
parent a9f432d6b0
commit 52678cddf4
1 changed files with 15 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
test/Handler/Utils/ExamSpec.hs
View File

@ -15,6 +15,17 @@ import Control.Applicative (ZipList(..))
import Handler.Utils.Exam import Handler.Utils.Exam
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 newtype FixedHash = FixedHash Int
instance Hashable FixedHash where instance Hashable FixedHash where
@ -38,12 +49,13 @@ spec = do
rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary rawUsers <- listOf1 $ Entity <$> arbitrary <*> arbitrary
-- user surnames anpassen, sodass interessante instanz -- user surnames anpassen, sodass interessante instanz
let users = Map.fromList $ map (\Entity {entityKey, entityVal} -> (entityKey, (entityVal, Nothing))) rawUsers let users = Map.fromList $ map (\Entity {entityKey, entityVal} -> (entityKey, (entityVal, Nothing))) rawUsers
--occurrences <- arbitrary :: Gen (Map ExamOccurrenceId Natural) rawOccurrences <- listOf $ Entity <$> arbitrary <*> arbitrary
let occurrences = Map.empty :: Map ExamOccurrenceId Natural let occurrences = Map.fromList $ map (\Entity {entityKey, entityVal} -> (entityKey, examOccurrenceCapacity entityVal)) rawOccurrences
--let occurrences = Map.empty :: Map ExamOccurrenceId Natural
let (maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users let (maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
pure $ ioProperty $ do pure $ ioProperty $ do
print (length users, length occurrences)
shouldSatisfy rawUsers $ not . null shouldSatisfy rawUsers $ not . null
shouldSatisfy occurrences $ not . null
where where
-- name list copied from test/Database/Fill.hs -- name list copied from test/Database/Fill.hs
surnames = [ "Smith", "Johnson", "Williams", "Brown" surnames = [ "Smith", "Johnson", "Williams", "Brown"