git.iko.soy/typeable/hjsonschema
on doctest help sign in
typeable/hjsonschema/test/Local.hs
101 lines 3.6 kB history raw
2module Main where
4import Protolude
6import Data.Aeson
7import qualified Data.List.NonEmpty as NE
8import qualified System.Timeout as TO
9import Test.Hspec
10import Test.QuickCheck (property)
12import qualified JSONSchema.Draft4 as D4
13import qualified JSONSchema.Types as JT
14import qualified Local.Failure
15import qualified Local.Validation
16import qualified Local.Reference
17import Shared
19-- Examples
20import qualified AlternateSchema
21import qualified Simple
22import qualified TwoStep
24dir :: FilePath
25dir = "JSON-Schema-Test-Suite/tests/draft4"
27supplementDir :: FilePath
28supplementDir = "test/supplement"
30main :: IO ()
31main = do
33 -- Language agnostic tests
34 ts <- readSchemaTests
35 dir
36 (\a -> not (isHTTPTest a || skipOptional a))
38 -- Custom supplements to the language agnostic tests
39 supplementTs <- readSchemaTests
40 supplementDir
41 (\a -> not (isHTTPTest a || skipOptional a))
43 hspec $ do
44 describe "Examples" exampleTests
45 describe "QuickCheck" quickCheckTests
46 describe "Failure" Local.Failure.spec
47 describe "JSONSchema.Validator.Reference" Local.Reference.spec
48 describe "Supplementary validation tests written in Haskell"
49 Local.Validation.spec
51 describe "Supplementary tests written in JSON (using the record based schema)"
52 (traverse_ (toTest (fmap timeout . validate)) supplementTs)
53 describe "Supplementary tests written in JSON (using the 'Value' based schema)"
54 (traverse_ (toTest (fmap timeout . validateExample)) supplementTs)
56 describe "Language agnostic tests (using the record based schema)"
57 (traverse_ (toTest validate) ts)
58 describe "Language agnostic tests (using the 'Value' based schema)"
59 (traverse_ (toTest validateExample) ts)
60 where
61 timeout :: Expectation -> Expectation
62 timeout f = do
63 res <- TO.timeout 3000000 f
64 case res of
65 Nothing -> expectationFailure "timeout expired"
66 Just a -> pure a
68 validate :: D4.Schema -> SchemaTestCase -> Expectation
69 validate s sc = do
70 res <- D4.fetchHTTPAndValidate (D4.SchemaWithURI s Nothing) (_scData sc)
71 let failures = case res of
72 Right () -> mempty
73 Left (D4.HVData a) -> NE.toList (D4._invalidFailures a)
74 other -> panic ("Local.validate error: "
75 <> show other)
76 assertResult sc failures
78 validateExample :: JT.Schema -> SchemaTestCase -> Expectation
79 validateExample s sc = do
80 res <- AlternateSchema.referencesViaHTTP (D4.SchemaWithURI s Nothing)
81 case res of
82 Left e -> panic ("Local.validateExample error: " <> show e)
83 Right schemaMap -> do
84 let failures = AlternateSchema.validate
85 schemaMap
86 (D4.SchemaWithURI s Nothing)
87 (_scData sc)
88 assertResult sc failures
90quickCheckTests :: Spec
91quickCheckTests =
92 it "schemas invert through JSON without change" $ do
93 property invertSchema
94 where
95 invertSchema :: D4.Schema -> Bool
96 invertSchema a = Just a == decode (encode a)
98exampleTests :: Spec
99exampleTests = do
100 it "Simple.example compiles successfully" Simple.example
101 it "TwoStep.example compiles successfully" TwoStep.example