diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs index 1934aa03a..5c2113656 100644 --- a/test/Model/TypesSpec.hs +++ b/test/Model/TypesSpec.hs @@ -301,6 +301,10 @@ instance Arbitrary ExamPartNumber where arbitrary = review _ExamPartNumber . CI.mk . pack . getPrintableString <$> arbitrary shrink = map (review _ExamPartNumber) . shrink . view _ExamPartNumber +instance Arbitrary ExamCloseMode where + arbitrary = genericArbitrary + shrink = genericShrink + spec :: Spec spec = do @@ -397,6 +401,8 @@ spec = do [ persistFieldLaws, jsonLaws, pathPieceLaws, csvFieldLaws, eqLaws, ordLaws ] lawsCheckHspec (Proxy @StoredMarkup) [ 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 it "has compatible encoding/decoding to/from Text" . property $ @@ -469,6 +475,11 @@ spec = do Right StoredMarkup{..} -> ((==) `on` renderHtml) markupOutput html && markupInputFormat == MarkupHtml && 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 (term, encoded) = example $ do diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs index fcb380fa3..b4e9c911b 100644 --- a/test/ModelSpec.hs +++ b/test/ModelSpec.hs @@ -193,6 +193,7 @@ instance Arbitrary School where schoolExamMinimumRegisterDuration <- arbitrary schoolExamRequireModeForRegistration <- arbitrary schoolExamDiscouragedModes <- arbitrary + schoolExamCloseMode <- arbitrary return School{..} instance Arbitrary Term where