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

fix: tests

Browse Source
This commit is contained in:
Gregor Kleen 2020-11-17 13:00:55 +01:00
parent 4b525ea824
commit 3c322af49e
2 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
test/Model/TypesSpec.hs
View File

@ -301,6 +301,10 @@ instance Arbitrary ExamPartNumber where
arbitrary = review _ExamPartNumber . CI.mk . pack . getPrintableString <$> arbitrary arbitrary = review _ExamPartNumber . CI.mk . pack . getPrintableString <$> arbitrary
shrink = map (review _ExamPartNumber) . shrink . view _ExamPartNumber shrink = map (review _ExamPartNumber) . shrink . view _ExamPartNumber
instance Arbitrary ExamCloseMode where
arbitrary = genericArbitrary
shrink = genericShrink
spec :: Spec spec :: Spec
spec = do spec = do
@ -397,6 +401,8 @@ spec = do
[ persistFieldLaws, jsonLaws, pathPieceLaws, csvFieldLaws, eqLaws, ordLaws ] [ persistFieldLaws, jsonLaws, pathPieceLaws, csvFieldLaws, eqLaws, ordLaws ]
lawsCheckHspec (Proxy @StoredMarkup) lawsCheckHspec (Proxy @StoredMarkup)
[ persistFieldLaws, jsonLaws, eqLaws, ordLaws, showReadLaws, monoidLaws, semigroupLaws, semigroupMonoidLaws, csvFieldLaws ] [ persistFieldLaws, jsonLaws, eqLaws, ordLaws, showReadLaws, monoidLaws, semigroupLaws, semigroupMonoidLaws, csvFieldLaws ]
lawsCheckHspec (Proxy @ExamCloseMode)
[ persistFieldLaws, jsonLaws, eqLaws, ordLaws, showReadLaws, pathPieceLaws, jsonKeyLaws, finiteLaws, httpApiDataLaws, binaryLaws ]
describe "TermIdentifier" $ do describe "TermIdentifier" $ do
it "has compatible encoding/decoding to/from Text" . property $ it "has compatible encoding/decoding to/from Text" . property $
@ -469,6 +475,11 @@ spec = do
Right StoredMarkup{..} -> ((==) `on` renderHtml) markupOutput html Right StoredMarkup{..} -> ((==) `on` renderHtml) markupOutput html
&& markupInputFormat == MarkupHtml && markupInputFormat == MarkupHtml
&& renderHtml html == markupInput && renderHtml html == markupInput
describe "ExamCloseMode" $ do
it "PathPiece instance matches expectations" . example $ do
toPathPiece ExamCloseSeparate `shouldBe` "separate"
toPathPiece (ExamCloseOnFinished False) `shouldBe` "on-finished"
toPathPiece (ExamCloseOnFinished True) `shouldBe` "on-finished-hidden"
termExample :: (TermIdentifier, Text) -> Expectation termExample :: (TermIdentifier, Text) -> Expectation
termExample (term, encoded) = example $ do termExample (term, encoded) = example $ do

1
test/ModelSpec.hs
View File

@ -193,6 +193,7 @@ instance Arbitrary School where
schoolExamMinimumRegisterDuration <- arbitrary schoolExamMinimumRegisterDuration <- arbitrary
schoolExamRequireModeForRegistration <- arbitrary schoolExamRequireModeForRegistration <- arbitrary
schoolExamDiscouragedModes <- arbitrary schoolExamDiscouragedModes <- arbitrary
schoolExamCloseMode <- arbitrary
return School{..} return School{..}
instance Arbitrary Term where instance Arbitrary Term where