git.iko.soy/typeable/hjsonschema
on 96ffacc help sign in
bd8cdfc
swap
0 ahead, 16 behind
.travis.yml+5−5
since splitsnapshots
unifiedsplit
@@ -26,15 +26,15 @@ before_cache:
26
26
27matrix:
27matrix:
28 include:
28 include:
29+ - compiler: "ghc-7.10.3"
30+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
31+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
29 - compiler: "ghc-8.0.2"
32 - compiler: "ghc-8.0.2"
30 # env: TEST=--disable-tests BENCH=--disable-benchmarks
33 # env: TEST=--disable-tests BENCH=--disable-benchmarks
31 addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
34 addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
32− - compiler: "ghc-8.2.2"
35+ - compiler: "ghc-8.2.1"
33− # env: TEST=--disable-tests BENCH=--disable-benchmarks
34− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
35− - compiler: "ghc-8.4.1"
36 # env: TEST=--disable-tests BENCH=--disable-benchmarks
36 # env: TEST=--disable-tests BENCH=--disable-benchmarks
37− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}
37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}
38
38
39before_install:
39before_install:
40 - HC=${CC}
40 - HC=${CC}
README.md+50−8
@@ -1,25 +1,67 @@
1−# DEPRECATION NOTICE
1+![hjsonschema logo](./logo.jpg)
2
2
3−`hjsonschema` was an attempt to build a very modular JSON Schema library. Validators have [a concrete type](src/JSONSchema/Validator/Types.hs) and can be mixed and matched into new [Specs](src/JSONSchema/Types.hs).
3+A Haskell implementation of the most commonly used [JSON Schema](http://json-schema.org/) specification ([Draft 4](https://github.com/json-schema-org/json-schema-spec/wiki/Specification-Links#draft-4)).
4
4
5−However this flexibility came at the price of complicating the code. I don't think it was the right tradeoff, especially since situations where you'd want to change what validators make up a `Spec` at runtime seem rare.
5+[Hackage](https://hackage.haskell.org/package/hjsonschema) / [GitHub](https://github.com/seagreen/hjsonschema) / [Travis CI](https://travis-ci.org/seagreen/hjsonschema)
6
6
7−Also, there are many parts of JSON Schema that `hjsonschema` doesn't implement properly (as you can see from the issue tracker). I'm hoping that a new JSON Schema library will come along that handles these correctly. In the meantime I'm happy to merge working fixes into here.
7+# Notes
8
8
9−# Links
9++ As of 2017 [json-schema-org](https://github.com/json-schema-org/json-schema-spec) has begun releasing new drafts of the standard. Once this work stabilizes `hjsonschema` will add coverage for the latest draft.
10
10
11−[Hackage](https://hackage.haskell.org/package/hjsonschema) / [GitHub](https://github.com/seagreen/hjsonschema) / [Travis CI](https://travis-ci.org/seagreen/hjsonschema)
11++ Requires [pcre](http://www.pcre.org/) (`pkgs.pcre` in Nixpkgs).
12+
13++ Schemas with circular references can cause infinite loops. hjsonschema does loop detection but it may not be solid yet -- please open an issue if you find a situation where it fails.
12
14
13# Example
15# Example
14
16
15See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Simple.hs).
17See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Simple.hs).
16
18
17−# System dependencies
19+# Tests
18
20
19−+ Requires [pcre](http://www.pcre.org/) (`pkgs.pcre` in Nixpkgs).
21+Run all tests:
22+
23+`stack test`
24+
25+Run only local tests:
26+
27+`stack test hjsonschema:local`
28+
29+Run remote tests (makes GETs to json-schema.org, also temporarily starts an HTTP server on port 1234):
30+
31+`stack test hjsonschema:remote`
32+
33+# Details
34+
35+## Goals
36+
37++ Be a correct and fast implementation of the spec.
38+
39++ Be a useful reference for implementers in other languages. Haskell's high level nature, expressive type system and referential transparency suit this purpose well.
40+
41+## Good Parts
42+
43++ Passes all the required tests in the [language agnostic test suite](https://github.com/json-schema/JSON-Schema-Test-Suite). NOTE: due to an issue with the test suite this isn't true at the moment, see [#175](https://github.com/json-schema-org/JSON-Schema-Test-Suite/issues/175).
44+
45++ Very modular, which should make it easy to support future versions of the specification.
46+
47+## Bad Parts
48+
49++ Uses the [pcre-heavy](https://hackage.haskell.org/package/pcre-heavy) regular expression library for the "pattern" validator. It should use a library based on the ECMA 262 regex dialect, which the [spec](http://json-schema.org/latest/json-schema-validation.html#anchor33) requires.
50+
51++ Currently doesn't support the optional `"format"` validators.
20
52
21## Vendoring
53## Vendoring
22
54
23+ `JSON-Schema-Test-Suite` is vendored from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema-org/JSON-Schema-Test-Suite).
55+ `JSON-Schema-Test-Suite` is vendored from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema-org/JSON-Schema-Test-Suite).
24
56
25+ `src/draft4.json` is from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema/json-schema). The [root ref in remote ref](./JSON-Schema-Test-Suite/tests/draft4/refRemote.json) test has been modified to fix [#175](https://github.com/json-schema-org/JSON-Schema-Test-Suite/issues/175).
57+ `src/draft4.json` is from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema/json-schema). The [root ref in remote ref](./JSON-Schema-Test-Suite/tests/draft4/refRemote.json) test has been modified to fix [#175](https://github.com/json-schema-org/JSON-Schema-Test-Suite/issues/175).
58+
59++ `.travis.yml` was created with `make_travis_yml_2.hs` commit # ea6c7d177a97bfbfb2fdc4deba943d60d2aff199.
60+
61+## Credits
62+
63+[TJ Weigel](http://tjweigel.com/) created the logo.
64+
65+[Tim Baumann](https://github.com/timjb) wrote [aeson-schema](https://hackage.haskell.org/package/aeson-schema), on which hjsonschema's test code and its implementation of `SchemaGraph` were based.
66+
67+[Julian Berman](https://github.com/Julian) maintains the fantastic [language agnostic test suite](https://github.com/json-schema/JSON-Schema-Test-Suite).
changelog.md−15
@@ -1,18 +1,3 @@
1−# 1.8.0
2−
3−+ Add GHC 8.4 support (thanks @4e6 !).
4−+ Drop GHC 7.10 support.
5−+ Fix JSON Pointer resolution error.
6−
7−# 1.8.0
8−
9−+ Allow HTTPS references (thanks @creichert!).
10−+ Use `safe-exceptions` to eliminate the risk of catching asynchronous exceptions.
11−
12−# 1.7.2
13−
14−+ Remove upper bounds.
15−
16# 1.7.1
1# 1.7.1
17
2
18+ Bump http-types.
3+ Bump http-types.
examples/AlternateSchema.hs+18−13
@@ -5,23 +5,28 @@
5-- to copy this module instead of the 'JSONSchema.Draft4'. While it's
5-- to copy this module instead of the 'JSONSchema.Draft4'. While it's
6-- less convenient to write schemas in Haskell without a record type, you
6-- less convenient to write schemas in Haskell without a record type, you
7-- can get the implementation finished with far fewer lines of code.
7-- can get the implementation finished with far fewer lines of code.
8+
8module AlternateSchema where
9module AlternateSchema where
9
10
10import Protolude
11import Protolude
11
12
12−import Data.Aeson (FromJSON(..), Value(..), decodeStrict)
13+import Data.Aeson (FromJSON(..), Value(..),
14+ decodeStrict)
13−import qualified Data.Aeson as AE
15+import qualified Data.Aeson as AE
14−import qualified Data.HashMap.Strict as HM
16+import qualified Data.HashMap.Strict as HM
15−import Data.Maybe (fromMaybe)
17+import Data.Maybe (fromMaybe)
16−import Data.Profunctor (Profunctor(..))
18+import Data.Profunctor (Profunctor (..))
17−
19+
18−import JSONSchema.Draft4 (ValidatorFailure(..), metaSchemaBytes)
20+import JSONSchema.Draft4 (ValidatorFailure(..),
21+ metaSchemaBytes)
19−import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))
22+import JSONSchema.Fetch (SchemaWithURI(..),
23+ URISchemaMap(..))
20−import qualified JSONSchema.Fetch as FE
24+import qualified JSONSchema.Fetch as FE
21−import JSONSchema.Types (Schema(..), Spec(..))
25+import JSONSchema.Types (Schema(..), Spec(..))
22−import qualified JSONSchema.Types as JT
26+import qualified JSONSchema.Types as JT
23−import qualified JSONSchema.Validator.Draft4 as D4
27+import qualified JSONSchema.Validator.Draft4 as D4
24−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),
28+import JSONSchema.Validator.Reference (BaseURI(..),
29+ Scope(..),
25 updateResolutionScope)
30 updateResolutionScope)
26
31
27--------------------------------------------------
32--------------------------------------------------
examples/Simple.hs+5−4
@@ -1,13 +1,14 @@
1+
1module Simple where
2module Simple where
2
3
3import Protolude
4import Protolude
4
5
5−import Data.Aeson (Value(..), decodeStrict, toJSON)
6+import Data.Aeson (Value(..), decodeStrict, toJSON)
6−import qualified Data.ByteString as BS
7+import qualified Data.ByteString as BS
7import qualified Data.List.NonEmpty as NE
8import qualified Data.List.NonEmpty as NE
8−import Data.Maybe (fromMaybe)
9+import Data.Maybe (fromMaybe)
9
10
10−import qualified JSONSchema.Draft4 as D4
11+import qualified JSONSchema.Draft4 as D4
11
12
12badData :: Value
13badData :: Value
13badData = toJSON [True, True]
14badData = toJSON [True, True]
examples/TwoStep.hs+4−3
@@ -10,14 +10,15 @@
10-- 'fetchHTTPAndValidate' which fetched references over HTTP (though it
10-- 'fetchHTTPAndValidate' which fetched references over HTTP (though it
11-- didn't matter because the last schema didn't actually have any).
11-- didn't matter because the last schema didn't actually have any).
12-- This time we need to get them from the filesystem.
12-- This time we need to get them from the filesystem.
13+
13module TwoStep where
14module TwoStep where
14
15
15import Protolude
16import Protolude
16
17
17−import Data.Aeson (Value(..), toJSON)
18+import Data.Aeson (Value (..), toJSON)
18−import qualified Data.List.NonEmpty as NE
19+import qualified Data.List.NonEmpty as NE
19
20
20−import qualified JSONSchema.Draft4 as D4
21+import qualified JSONSchema.Draft4 as D4
21import qualified JSONSchema.Validator.Draft4 as VAL
22import qualified JSONSchema.Validator.Draft4 as VAL
22
23
23schema :: D4.Schema
24schema :: D4.Schema
hjsonschema.cabal+26−24
@@ -1,5 +1,5 @@
1name: hjsonschema
1name: hjsonschema
2−version: 1.9.0
2+version: 1.7.1
3synopsis: JSON Schema library
3synopsis: JSON Schema library
4homepage: https://github.com/seagreen/hjsonschema
4homepage: https://github.com/seagreen/hjsonschema
5license: MIT
5license: MIT
@@ -10,7 +10,7 @@ category: Data
10build-type: Simple
10build-type: Simple
11cabal-version: >=1.10
11cabal-version: >=1.10
12-- Rerun multi-ghc-travis (executable make-travis-yml-2) after changing:
12-- Rerun multi-ghc-travis (executable make-travis-yml-2) after changing:
13−Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1
13+Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1
14extra-source-files:
14extra-source-files:
15 changelog.md
15 changelog.md
16 JSON-Schema-Test-Suite/remotes/*.json
16 JSON-Schema-Test-Suite/remotes/*.json
@@ -34,6 +34,7 @@ library
34 NoImplicitPrelude
34 NoImplicitPrelude
35 OverloadedStrings
35 OverloadedStrings
36 ScopedTypeVariables
36 ScopedTypeVariables
37+ TupleSections
37 if impl(ghc >= 8)
38 if impl(ghc >= 8)
38 default-extensions: StrictData
39 default-extensions: StrictData
39 ghc-options:
40 ghc-options:
@@ -58,28 +59,27 @@ library
58 JSONSchema.Validator.Draft4.Object.Properties
59 JSONSchema.Validator.Draft4.Object.Properties
59 , Import
60 , Import
60 build-depends:
61 build-depends:
61− base >= 4.7 && < 5
62+ base >= 4.7 && < 4.11
62 -- 0.11 is for `.:!`:
63 -- 0.11 is for `.:!`:
63− , aeson >= 0.11
64+ , aeson >= 0.11 && < 1.3
64− , bytestring >= 0.10
65+ , bytestring >= 0.10 && < 0.11
65− , containers >= 0.5
66+ , containers >= 0.5 && < 0.6
66− , file-embed >= 0.0.8
67+ , file-embed >= 0.0.8 && < 0.1
67− , filepath >= 1.3
68+ , filepath >= 1.3 && < 1.5
68− , hashable >= 1.2
69+ , hashable >= 1.2 && < 1.3
69− , hjsonpointer >= 1.1
70+ , hjsonpointer >= 1.1 && < 1.4
70 -- 0.4.30 is for parseUrlThrow:
71 -- 0.4.30 is for parseUrlThrow:
71− , http-client >= 0.4.30
72+ , http-client >= 0.4.30 && < 0.6
72− , http-client-tls >= 0.3
73− , http-types >= 0.8
73+ , http-types >= 0.8 && < 0.11
74− , pcre-heavy >= 1.0
74+ , pcre-heavy >= 1.0 && < 1.1
75− , profunctors >= 5.0
75+ , profunctors >= 5.0 && < 5.3
76− , protolude >= 0.1.10
76+ , protolude >= 0.1.10 && < 1.2
77− , QuickCheck >= 2.8
77+ , QuickCheck >= 2.8 && < 2.11
78− , safe-exceptions >= 0.1.6
79− , scientific >= 0.3
78+ , scientific >= 0.3 && < 0.4
79+ , semigroups >= 0.18 && < 0.19
80− , unordered-containers >= 0.2
80+ , unordered-containers >= 0.2 && < 0.3
81− , text >= 1.1
81+ , text >= 1.1 && < 1.3
82− , vector >= 0.10
82+ , vector >= 0.10 && < 1.0
83
83
84test-suite local
84test-suite local
85 hs-source-dirs:
85 hs-source-dirs:
@@ -114,14 +114,15 @@ test-suite local
114 , hjsonschema
114 , hjsonschema
115 , profunctors
115 , profunctors
116 , protolude
116 , protolude
117+ , semigroups
117 , text
118 , text
118 , QuickCheck
119 , QuickCheck
119 , unordered-containers
120 , unordered-containers
120 , vector
121 , vector
121
122
122 -- directory-1.2.5 required for `listDirectory`:
123 -- directory-1.2.5 required for `listDirectory`:
123− , directory >= 1.2.5
124+ , directory >= 1.2.5 && < 2.0
124− , hspec >= 2.2
125+ , hspec >= 2.2 && < 3.0
125
126
126test-suite remote
127test-suite remote
127 hs-source-dirs:
128 hs-source-dirs:
@@ -152,6 +153,7 @@ test-suite remote
152 , hjsonschema
153 , hjsonschema
153 , profunctors
154 , profunctors
154 , protolude
155 , protolude
156+ , semigroups
155 , text
157 , text
156 , unordered-containers
158 , unordered-containers
157 , vector
159 , vector
logo.jpgnew file

Binary file not shown.

run-stack-haddocknew file+1
@@ -0,0 +1 @@
1+../stack-haddock-upload/stack-haddock-upload hjsonschema # 1.2.0.1
shell.nix−1
@@ -8,7 +8,6 @@ haskell.lib.buildStackProject {
8 pcre
8 pcre
9
9
10 git # for `git:` references in stack.yml.
10 git # for `git:` references in stack.yml.
11− ncurses # for intero
12 pkgconfig
11 pkgconfig
13 zlib
12 zlib
14 ];
13 ];
src/Import.hs+7−7
@@ -1,16 +1,16 @@
1
1
2module Import (module Export, fromJSONEither) where
2module Import (module Export, fromJSONEither) where
3
3
4−import Protolude as Export
4+import Protolude as Export
5
5
6−import Data.Aeson as Export
6+import Data.Aeson as Export
7import Data.HashMap.Strict as Export (HashMap)
7import Data.HashMap.Strict as Export (HashMap)
8−import Data.List.NonEmpty as Export (NonEmpty)
8+import Data.List.NonEmpty as Export (NonEmpty)
9−import Data.Vector as Export (Vector)
9+import Data.Vector as Export (Vector)
10−import Test.QuickCheck as Export hiding (Failure, Result, Success,
10+import Test.QuickCheck as Export hiding ((.&.), Failure,
11− (.&.))
11+ Result, Success)
12
12
13−import qualified Data.Text as T
13+import qualified Data.Text as T
14
14
15fromJSONEither :: FromJSON a => Value -> Either Text a
15fromJSONEither :: FromJSON a => Value -> Either Text a
16fromJSONEither a =
16fromJSONEither a =
src/JSONSchema/Draft4.hs+15−12
@@ -37,19 +37,22 @@ module JSONSchema.Draft4
37
37
38import Import
38import Import
39
39
40−import qualified Data.ByteString as BS
40+import qualified Data.ByteString as BS
41−import Data.FileEmbed (embedFile, makeRelativeToProject)
41+import Data.FileEmbed (embedFile,
42+ makeRelativeToProject)
42−import qualified Data.HashMap.Strict as HM
43+import qualified Data.HashMap.Strict as HM
43−import qualified Data.List.NonEmpty as NE
44+import qualified Data.List.NonEmpty as NE
44−import Data.Maybe (fromMaybe)
45+import Data.Maybe (fromMaybe)
45−
46+
46−import JSONSchema.Draft4.Failure (Invalid(..), SchemaInvalid(..),
47+import JSONSchema.Draft4.Failure (Invalid(..),
48+ SchemaInvalid(..),
47 ValidatorFailure(..))
49 ValidatorFailure(..))
48−import JSONSchema.Draft4.Schema (Schema)
50+import JSONSchema.Draft4.Schema (Schema)
49−import qualified JSONSchema.Draft4.Schema as SC
51+import qualified JSONSchema.Draft4.Schema as SC
50−import qualified JSONSchema.Draft4.Spec as Spec
52+import qualified JSONSchema.Draft4.Spec as Spec
51−import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))
53+import JSONSchema.Fetch (SchemaWithURI(..),
54+ URISchemaMap(..))
52−import qualified JSONSchema.Fetch as FE
55+import qualified JSONSchema.Fetch as FE
53
56
54data HTTPValidationFailure
57data HTTPValidationFailure
55 = HVRequest FE.HTTPFailure
58 = HVRequest FE.HTTPFailure
src/JSONSchema/Draft4/Failure.hs+2−1
@@ -1,8 +1,9 @@
1+
1module JSONSchema.Draft4.Failure where
2module JSONSchema.Draft4.Failure where
2
3
3import Import
4import Import
4
5
5−import JSONSchema.Draft4.Schema (Schema)
6+import JSONSchema.Draft4.Schema (Schema)
6import qualified JSONSchema.Validator.Draft4 as VAL
7import qualified JSONSchema.Validator.Draft4 as VAL
7
8
8-- | Used to report an entire instance being invalidated, as opposed
9-- | Used to report an entire instance being invalidated, as opposed
src/JSONSchema/Draft4/Schema.hs+7−6
@@ -1,13 +1,14 @@
1+
1module JSONSchema.Draft4.Schema where
2module JSONSchema.Draft4.Schema where
2
3
3−import Import hiding (mapMaybe)
4+import Import hiding (mapMaybe)
4
5
5−import qualified Data.HashMap.Strict as HM
6+import qualified Data.HashMap.Strict as HM
6−import Data.List.NonEmpty (NonEmpty)
7+import Data.List.NonEmpty (NonEmpty)
7−import Data.Maybe (fromJust, isJust)
8+import Data.Maybe (fromJust, isJust)
8import Data.Scientific
9import Data.Scientific
9−import qualified Data.Set as Set
10+import qualified Data.Set as Set
10−import qualified Data.Text as T
11+import qualified Data.Text as T
11
12
12import qualified JSONSchema.Validator.Draft4 as D4
13import qualified JSONSchema.Validator.Draft4 as D4
13import JSONSchema.Validator.Utils
14import JSONSchema.Validator.Utils
src/JSONSchema/Draft4/Spec.hs+13−9
@@ -1,18 +1,22 @@
1+
1module JSONSchema.Draft4.Spec where
2module JSONSchema.Draft4.Spec where
2
3
3import Import
4import Import
4
5
5−import Data.Maybe (fromMaybe)
6+import Data.Maybe (fromMaybe)
6−import Data.Profunctor (Profunctor(..))
7+import Data.Profunctor (Profunctor(..))
7
8
8import JSONSchema.Draft4.Failure
9import JSONSchema.Draft4.Failure
9−import JSONSchema.Draft4.Schema (Schema(..), emptySchema)
10+import JSONSchema.Draft4.Schema (Schema(..),
11+ emptySchema)
10−import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))
12+import JSONSchema.Fetch (SchemaWithURI(..),
13+ URISchemaMap(..))
11−import qualified JSONSchema.Fetch as FE
14+import qualified JSONSchema.Fetch as FE
12−import JSONSchema.Types (Spec(..))
15+import JSONSchema.Types (Spec(..))
13−import qualified JSONSchema.Types as JT
16+import qualified JSONSchema.Types as JT
14import JSONSchema.Validator.Draft4
17import JSONSchema.Validator.Draft4
15−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),
18+import JSONSchema.Validator.Reference (BaseURI(..),
19+ Scope(..),
16 updateResolutionScope)
20 updateResolutionScope)
17
21
18-- | An implementation of 'JT.embedded'.
22-- | An implementation of 'JT.embedded'.
@@ -39,7 +43,7 @@ specValidate schemaMap sw =
39 (_schemaId (_swSchema sw))
43 (_schemaId (_swSchema sw))
40 }
44 }
41
45
42−validateSubschema
46+validateSubschema
43 :: URISchemaMap Schema
47 :: URISchemaMap Schema
44 -> VisitedSchemas
48 -> VisitedSchemas
45 -> Scope Schema
49 -> Scope Schema
src/JSONSchema/Fetch.hs+15−16
@@ -1,18 +1,18 @@
1+
1module JSONSchema.Fetch where
2module JSONSchema.Fetch where
2
3
3import Import
4import Import
4
5
5−import qualified Control.Exception.Safe as Safe
6+import Control.Exception (IOException, catch)
6−import Control.Monad (foldM)
7+import Control.Monad (foldM)
7−import qualified Data.ByteString as BS
8+import qualified Data.ByteString as BS
8−import qualified Data.ByteString.Lazy as LBS
9+import qualified Data.ByteString.Lazy as LBS
9−import qualified Data.HashMap.Strict as HM
10+import qualified Data.HashMap.Strict as HM
10−import qualified Data.Semigroup as S
11+import qualified Data.Text as T
11−import qualified Data.Text as T
12−import qualified Network.HTTP.Client as NC
12+import qualified Network.HTTP.Client as NC
13−import qualified Network.HTTP.Client.TLS as NCTLS
13+
14−
15−import JSONSchema.Validator.Reference (BaseURI(..), resolveReference,
14+import JSONSchema.Validator.Reference (BaseURI(..),
15+ resolveReference,
16 updateResolutionScope)
16 updateResolutionScope)
17
17
18--------------------------------------------------
18--------------------------------------------------
@@ -30,7 +30,7 @@ data FetchInfo schema = FetchInfo
30-- | Keys are URIs (without URI fragments).
30-- | Keys are URIs (without URI fragments).
31newtype URISchemaMap schema
31newtype URISchemaMap schema
32 = URISchemaMap { _unURISchemaMap :: HashMap Text schema }
32 = URISchemaMap { _unURISchemaMap :: HashMap Text schema }
33− deriving (Eq, Show, S.Semigroup, Monoid)
33+ deriving (Eq, Show, Monoid)
34
34
35-- | A top-level schema along with its location.
35-- | A top-level schema along with its location.
36data SchemaWithURI schema = SchemaWithURI
36data SchemaWithURI schema = SchemaWithURI
@@ -61,9 +61,9 @@ referencesViaHTTP'
61 -> SchemaWithURI schema
61 -> SchemaWithURI schema
62 -> IO (Either HTTPFailure (URISchemaMap schema))
62 -> IO (Either HTTPFailure (URISchemaMap schema))
63referencesViaHTTP' info sw = do
63referencesViaHTTP' info sw = do
64− manager <- NC.newManager NCTLS.tlsManagerSettings
64+ manager <- NC.newManager NC.defaultManagerSettings
65 let f = referencesMethodAgnostic (getURL manager) info sw
65 let f = referencesMethodAgnostic (getURL manager) info sw
66− Safe.catch (first HTTPParseFailure <$> f) handler
66+ catch (first HTTPParseFailure <$> f) handler
67 where
67 where
68 getURL :: NC.Manager -> Text -> IO BS.ByteString
68 getURL :: NC.Manager -> Text -> IO BS.ByteString
69 getURL man url = do
69 getURL man url = do
@@ -89,8 +89,7 @@ referencesViaFilesystem'
89 => FetchInfo schema
89 => FetchInfo schema
90 -> SchemaWithURI schema
90 -> SchemaWithURI schema
91 -> IO (Either FilesystemFailure (URISchemaMap schema))
91 -> IO (Either FilesystemFailure (URISchemaMap schema))
92−referencesViaFilesystem' info sw =
93− Safe.catch (first FSParseFailure <$> f) handler
92+referencesViaFilesystem' info sw = catch (first FSParseFailure <$> f) handler
94 where
93 where
95 f :: IO (Either Text (URISchemaMap schema))
94 f :: IO (Either Text (URISchemaMap schema))
96 f = referencesMethodAgnostic (BS.readFile . T.unpack) info sw
95 f = referencesMethodAgnostic (BS.readFile . T.unpack) info sw
src/JSONSchema/Types.hs+1
@@ -1,3 +1,4 @@
1+
1module JSONSchema.Types where
2module JSONSchema.Types where
2
3
3import Import
4import Import
src/JSONSchema/Validator/Draft4.hs+8−7
@@ -2,6 +2,7 @@
2--
2--
3-- This is frankly a lot of busywork. It can perhaps be moved into the
3-- This is frankly a lot of busywork. It can perhaps be moved into the
4-- validator modules themselves once we're sure this is the right design.
4-- validator modules themselves once we're sure this is the right design.
5+
5module JSONSchema.Validator.Draft4
6module JSONSchema.Validator.Draft4
6 ( module JSONSchema.Validator.Draft4
7 ( module JSONSchema.Validator.Draft4
7 , module Export
8 , module Export
@@ -9,16 +10,16 @@ module JSONSchema.Validator.Draft4
9
10
10import Import
11import Import
11
12
12−import qualified Data.HashMap.Strict as HM
13+import qualified Data.HashMap.Strict as HM
13−import qualified Data.List.NonEmpty as NE
14+import qualified Data.List.NonEmpty as NE
14
15
15−import JSONSchema.Validator.Draft4.Any as Export
16+import JSONSchema.Validator.Draft4.Any as Export
16−import JSONSchema.Validator.Draft4.Array as Export
17+import JSONSchema.Validator.Draft4.Array as Export
17import JSONSchema.Validator.Draft4.Number as Export
18import JSONSchema.Validator.Draft4.Number as Export
18import JSONSchema.Validator.Draft4.Object as Export
19import JSONSchema.Validator.Draft4.Object as Export
19import JSONSchema.Validator.Draft4.String as Export
20import JSONSchema.Validator.Draft4.String as Export
20−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..))
21+import JSONSchema.Validator.Reference (BaseURI(..), Scope(..))
21−import JSONSchema.Validator.Types (Validator(..))
22+import JSONSchema.Validator.Types (Validator(..))
22
23
23-- | For internal use.
24-- | For internal use.
24--
25--
@@ -147,7 +148,7 @@ propertiesRelatedValidator f =
147 <> HM.elems (fromMaybe mempty (_propPattern a))
148 <> HM.elems (fromMaybe mempty (_propPattern a))
148 <> case _propAdditional a of
149 <> case _propAdditional a of
149 Just (AdditionalPropertiesObject b) -> [b]
150 Just (AdditionalPropertiesObject b) -> [b]
150− _ -> mempty
151+ _ -> mempty
151 ))
152 ))
152 (\a b -> case fromJSONEither b of
153 (\a b -> case fromJSONEither b of
153 Left _ -> mempty
154 Left _ -> mempty
src/JSONSchema/Validator/Draft4/Any.hs+24−46
@@ -1,24 +1,25 @@
1+
1module JSONSchema.Validator.Draft4.Any where
2module JSONSchema.Validator.Draft4.Any where
2
3
3−import Import hiding ((<>))
4+import Import hiding ((<>))
4
5
5−import Data.Aeson.TH (constructorTagModifier)
6+import Data.Aeson.TH (constructorTagModifier)
6−import Data.Char (toLower)
7+import Data.Char (toLower)
7−import qualified Data.HashMap.Strict as HM
8−import Data.List.NonEmpty (NonEmpty((:|)))
8+import Data.List.NonEmpty (NonEmpty((:|)))
9−import qualified Data.List.NonEmpty as NE
9+import qualified Data.List.NonEmpty as NE
10−import qualified Data.Scientific as SCI
10+import qualified Data.Scientific as SCI
11import Data.Semigroup
11import Data.Semigroup
12−import Data.Set (Set)
12+import Data.Set (Set)
13−import qualified Data.Set as Set
13+import qualified Data.Set as Set
14−import Data.Text.Encoding.Error (UnicodeException)
14+import Data.Text.Encoding.Error (UnicodeException)
15−import qualified JSONPointer as JP
15+import qualified JSONPointer as JP
16−import Network.HTTP.Types.URI (urlDecode)
16+import Network.HTTP.Types.URI (urlDecode)
17−
17+
18+import qualified JSONSchema.Validator.Utils as UT
18−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),
19+import JSONSchema.Validator.Reference (BaseURI(..),
20+ Scope(..),
19 URIAndFragment,
21 URIAndFragment,
20 resolveReference)
22 resolveReference)
21−import qualified JSONSchema.Validator.Utils as UT
22
23
23--------------------------------------------------
24--------------------------------------------------
24-- * $ref
25-- * $ref
@@ -134,7 +135,7 @@ data JSONPointerError
134 deriving (Eq, Show)
135 deriving (Eq, Show)
135
136
136resolveFragment
137resolveFragment
137− :: (FromJSON schema, ToJSON schema)
138+ :: forall schema. (FromJSON schema, ToJSON schema)
138 => (BaseURI -> schema -> BaseURI)
139 => (BaseURI -> schema -> BaseURI)
139 -> Scope schema
140 -> Scope schema
140 -> Text
141 -> Text
@@ -159,40 +160,17 @@ resolveFragment updateScope scope fragment = do
159 -- as property keys that aren't meant to change scope?
160 -- as property keys that aren't meant to change scope?
160 -- Perhaps this should be added to the language agnostic
161 -- Perhaps this should be added to the language agnostic
161 -- test suite as well.
162 -- test suite as well.
162− --
163− -- In the meantime 'newBaseURIFromFragment' drops all keys
164− -- from JSON objects except "id", which at least prevents
165− -- SubschemaDecodingError in a situation where one of the
166− -- values we step through isn't a valid schema.
167 go :: (Value, BaseURI)
163 go :: (Value, BaseURI)
168 -> JP.Token
164 -> JP.Token
169 -> Either JSONPointerError (Value, BaseURI)
165 -> Either JSONPointerError (Value, BaseURI)
170− go (lastVal, baseURI) tok = do
166+ go (lastVal, uri) tok = do
171 v <- first ResolutionError (JP.resolveToken tok lastVal)
167 v <- first ResolutionError (JP.resolveToken tok lastVal)
172− newBase <- newBaseURIFromFragment updateScope baseURI v
168+ case v of
173− Right (v, newBase)
169+ Array _ -> pure (v, uri)
174−
170+ _ -> do
175−-- | Update the 'BaseURI' (the store of the current "id" value)
171+ -- PERFORMANCE: Avoid deserializing subschemas.
176−-- after resolving one token of a JSON Pointer and stepping into
177−-- a new 'Value'.
178−newBaseURIFromFragment
179− :: FromJSON schema
180− => (BaseURI -> schema -> BaseURI)
181− -> BaseURI
182− -> Value
183− -> Either JSONPointerError BaseURI
184−newBaseURIFromFragment updateScope baseURI v =
185− case v of
186− Object hm -> do
187− let hmWithOnlyId = case HM.lookup idKey hm of
188− Nothing -> mempty
189− Just idVal -> HM.singleton idKey idVal
190− schema <- first SubschemaDecodingError (fromJSONEither (Object hmWithOnlyId))
172+ schema <- first SubschemaDecodingError (fromJSONEither v)
191− Right (updateScope baseURI schema)
173+ pure (v, updateScope uri schema)
192− _ -> Right baseURI
193− where
194− idKey :: Text
195− idKey = "id"
196
174
197--------------------------------------------------
175--------------------------------------------------
198-- * enum
176-- * enum
src/JSONSchema/Validator/Draft4/Array.hs+6−7
@@ -1,10 +1,11 @@
1+
1module JSONSchema.Validator.Draft4.Array where
2module JSONSchema.Validator.Draft4.Array where
2
3
3import Import
4import Import
4
5
5−import qualified Data.List.NonEmpty as NE
6+import qualified Data.List.NonEmpty as NE
6−import qualified Data.Vector as V
7+import qualified Data.Vector as V
7−import qualified JSONPointer as JP
8+import qualified JSONPointer as JP
8
9
9import JSONSchema.Validator.Utils (allUniqueValues)
10import JSONSchema.Validator.Utils (allUniqueValues)
10
11
@@ -173,8 +174,7 @@ itemsVal f a xs =
173 :: schema
174 :: schema
174 -> (JP.Index, Value)
175 -> (JP.Index, Value)
175 -> Maybe (JP.Index, NonEmpty err)
176 -> Maybe (JP.Index, NonEmpty err)
176− validateElem schema (index,x) =
177+ validateElem schema (index,x) = (index,) <$> NE.nonEmpty (f schema x)
177− (\v -> (index, v)) <$> NE.nonEmpty (f schema x)
178
178
179--------------------------------------------------
179--------------------------------------------------
180-- * additionalItems
180-- * additionalItems
@@ -219,7 +219,6 @@ additionalItemsVal _ (AdditionalBool False) xs =
219 AdditionalItemsBoolInvalid <$> NE.nonEmpty xs
219 AdditionalItemsBoolInvalid <$> NE.nonEmpty xs
220additionalItemsVal f (AdditionalObject subSchema) xs =
220additionalItemsVal f (AdditionalObject subSchema) xs =
221 let res = mapMaybe
221 let res = mapMaybe
222− (\(index,x) -> (\v -> (index, v))
223− <$> NE.nonEmpty (f subSchema x))
222+ (\(index,x) -> (index,) <$> NE.nonEmpty (f subSchema x))
224 xs
223 xs
225 in AdditionalItemsObjectInvalid <$> NE.nonEmpty res
224 in AdditionalItemsObjectInvalid <$> NE.nonEmpty res
src/JSONSchema/Validator/Draft4/Number.hs+2−1
@@ -1,8 +1,9 @@
1+
1module JSONSchema.Validator.Draft4.Number where
2module JSONSchema.Validator.Draft4.Number where
2
3
3import Import
4import Import
4
5
5−import Data.Fixed (mod')
6+import Data.Fixed (mod')
6import Data.Scientific (Scientific)
7import Data.Scientific (Scientific)
7
8
8--------------------------------------------------
9--------------------------------------------------
src/JSONSchema/Validator/Draft4/Object.hs+6−5
@@ -1,3 +1,4 @@
1+
1module JSONSchema.Validator.Draft4.Object
2module JSONSchema.Validator.Draft4.Object
2 ( module JSONSchema.Validator.Draft4.Object
3 ( module JSONSchema.Validator.Draft4.Object
3 , module JSONSchema.Validator.Draft4.Object.Properties
4 , module JSONSchema.Validator.Draft4.Object.Properties
@@ -5,11 +6,11 @@ module JSONSchema.Validator.Draft4.Object
5
6
6import Import
7import Import
7
8
8−import qualified Data.HashMap.Strict as HM
9+import qualified Data.HashMap.Strict as HM
9−import qualified Data.List.NonEmpty as NE
10+import qualified Data.List.NonEmpty as NE
10−import Data.Set (Set)
11+import Data.Set (Set)
11−import qualified Data.Set as Set
12+import qualified Data.Set as Set
12−import qualified Data.Text as T
13+import qualified Data.Text as T
13
14
14import JSONSchema.Validator.Draft4.Object.Properties
15import JSONSchema.Validator.Draft4.Object.Properties
15import JSONSchema.Validator.Utils
16import JSONSchema.Validator.Utils
src/JSONSchema/Validator/Draft4/Object/Properties.hs+6−5
@@ -1,12 +1,13 @@
1+
1module JSONSchema.Validator.Draft4.Object.Properties where
2module JSONSchema.Validator.Draft4.Object.Properties where
2
3
3import Import
4import Import
4
5
5−import qualified Data.Hashable as HA
6+import qualified Data.Hashable as HA
6−import qualified Data.HashMap.Strict as HM
7+import qualified Data.HashMap.Strict as HM
7−import qualified Data.List.NonEmpty as NE
8+import qualified Data.List.NonEmpty as NE
8−import Data.Text.Encoding (encodeUtf8)
9+import Data.Text.Encoding (encodeUtf8)
9−import qualified JSONPointer as JP
10+import qualified JSONPointer as JP
10import qualified Text.Regex.PCRE.Heavy as RE
11import qualified Text.Regex.PCRE.Heavy as RE
11
12
12data PropertiesRelated schema = PropertiesRelated
13data PropertiesRelated schema = PropertiesRelated
src/JSONSchema/Validator/Draft4/String.hs+3−2
@@ -1,9 +1,10 @@
1+
1module JSONSchema.Validator.Draft4.String where
2module JSONSchema.Validator.Draft4.String where
2
3
3import Import
4import Import
4
5
5−import qualified Data.Text as T
6+import qualified Data.Text as T
6−import Data.Text.Encoding (encodeUtf8)
7+import Data.Text.Encoding (encodeUtf8)
7import qualified Text.Regex.PCRE.Heavy as RE
8import qualified Text.Regex.PCRE.Heavy as RE
8
9
9--------------------------------------------------
10--------------------------------------------------
src/JSONSchema/Validator/Reference.hs+7−7
@@ -3,14 +3,15 @@
3--
3--
4-- And is extended for JSON Schema here:
4-- And is extended for JSON Schema here:
5-- <http://json-schema.org/latest/json-schema-core.html#anchor26>
5-- <http://json-schema.org/latest/json-schema-core.html#anchor26>
6+
6module JSONSchema.Validator.Reference where
7module JSONSchema.Validator.Reference where
7
8
8import Import
9import Import
9
10
10−import qualified Data.Text as T
11+import qualified Data.Text as T
11−import System.FilePath (dropFileName, (</>))
12+import System.FilePath ((</>), dropFileName)
12
13
13−data Scope schema = Scope
14+data Scope schema = Scope
14 { _topLevelDocument :: schema
15 { _topLevelDocument :: schema
15 , _documentURI :: Maybe Text
16 , _documentURI :: Maybe Text
16 , _currentBaseURI :: BaseURI
17 , _currentBaseURI :: BaseURI
@@ -24,10 +25,9 @@ newtype BaseURI
24type URIAndFragment = (Maybe Text, Maybe Text)
25type URIAndFragment = (Maybe Text, Maybe Text)
25
26
26updateResolutionScope :: BaseURI -> Maybe Text -> BaseURI
27updateResolutionScope :: BaseURI -> Maybe Text -> BaseURI
27−updateResolutionScope base idKeyword =
28+updateResolutionScope base idKeyword
28− case idKeyword of
29− Just t -> BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t
29+ | Just t <- idKeyword = BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t
30− Nothing -> base
30+ | otherwise = base
31
31
32resolveReference :: BaseURI -> Text -> URIAndFragment
32resolveReference :: BaseURI -> Text -> URIAndFragment
33resolveReference base t = baseAndFragment (resolveScopeAgainst base t)
33resolveReference base t = baseAndFragment (resolveScopeAgainst base t)
src/JSONSchema/Validator/Types.hs+1
@@ -1,3 +1,4 @@
1+
1module JSONSchema.Validator.Types where
2module JSONSchema.Validator.Types where
2
3
3import Import
4import Import
src/JSONSchema/Validator/Utils.hs+8−7
@@ -1,15 +1,16 @@
1+
1module JSONSchema.Validator.Utils where
2module JSONSchema.Validator.Utils where
2
3
3import Import
4import Import
4
5
5−import Control.Monad (fail)
6+import Control.Monad (fail)
6import qualified Data.HashMap.Strict as HM
7import qualified Data.HashMap.Strict as HM
7−import qualified Data.List.NonEmpty as NE
8+import qualified Data.List.NonEmpty as NE
8−import Data.Scientific (Scientific, fromFloatDigits)
9+import Data.Scientific (Scientific, fromFloatDigits)
9−import Data.Set (Set)
10+import Data.Set (Set)
10−import qualified Data.Set as S
11+import qualified Data.Set as S
11−import qualified Data.Text as T
12+import qualified Data.Text as T
12−import qualified Data.Vector as V
13+import qualified Data.Vector as V
13
14
14--------------------------------------------------
15--------------------------------------------------
15-- * QuickCheck
16-- * QuickCheck
stack.yaml+7−2
@@ -1,2 +1,7 @@
1−resolver: lts-10.8
1+resolver: nightly-2017-09-18
2−pvp-bounds: upper-revision
2+# packages:
3+# - './'
4+# - location: '../hjsonpointer'
5+# extra-dep: true
6+extra-deps:
7+ - hjsonpointer-1.3.0
test/Local.hs+10−7
@@ -1,18 +1,19 @@
1+
1module Main where
2module Main where
2
3
3import Protolude
4import Protolude
4
5
5import Data.Aeson
6import Data.Aeson
6import qualified Data.List.NonEmpty as NE
7import qualified Data.List.NonEmpty as NE
7−import qualified System.Timeout as TO
8+import qualified System.Timeout as TO
8import Test.Hspec
9import Test.Hspec
9−import Test.QuickCheck (property)
10+import Test.QuickCheck (property)
10
11
11−import qualified JSONSchema.Draft4 as D4
12+import qualified JSONSchema.Draft4 as D4
12−import qualified JSONSchema.Types as JT
13+import qualified JSONSchema.Types as JT
13import qualified Local.Failure
14import qualified Local.Failure
14−import qualified Local.Reference
15import qualified Local.Validation
15import qualified Local.Validation
16+import qualified Local.Reference
16import Shared
17import Shared
17
18
18-- Examples
19-- Examples
@@ -32,10 +33,12 @@ main = do
32 -- Language agnostic tests
33 -- Language agnostic tests
33 ts <- readSchemaTests
34 ts <- readSchemaTests
34 dir
35 dir
35− (\a -> not (isHTTPTest a || skipTest a))
36+ (\a -> not (isHTTPTest a || skipOptional a))
36
37
37 -- Custom supplements to the language agnostic tests
38 -- Custom supplements to the language agnostic tests
38− supplementTs <- readSchemaTests supplementDir (not . isHTTPTest)
39+ supplementTs <- readSchemaTests
40+ supplementDir
41+ (\a -> not (isHTTPTest a || skipOptional a))
39
42
40 hspec $ do
43 hspec $ do
41 describe "Examples" exampleTests
44 describe "Examples" exampleTests
test/Local/Failure.hs+4−3
@@ -1,14 +1,15 @@
1+
1module Local.Failure where
2module Local.Failure where
2
3
3import Protolude
4import Protolude
4
5
5import Data.Aeson
6import Data.Aeson
6−import qualified Data.Vector as V
7−import qualified JSONPointer as JP
8import Test.Hspec
7import Test.Hspec
8+import qualified Data.Vector as V
9+import qualified JSONPointer as JP
9
10
10import JSONSchema.Draft4
11import JSONSchema.Draft4
11−import qualified JSONSchema.Draft4.Spec as Spec
12+import qualified JSONSchema.Draft4.Spec as Spec
12import qualified JSONSchema.Validator.Draft4 as VAL
13import qualified JSONSchema.Validator.Draft4 as VAL
13
14
14spec :: Spec
15spec :: Spec
test/Local/Reference.hs+1
@@ -1,3 +1,4 @@
1+
1module Local.Reference where
2module Local.Reference where
2
3
3import Protolude
4import Protolude
test/Local/Validation.hs+5−4
@@ -1,16 +1,17 @@
1+
1module Local.Validation where
2module Local.Validation where
2
3
3import Protolude
4import Protolude
4
5
5import Data.Aeson
6import Data.Aeson
6−import qualified Data.Aeson as AE
7+import qualified Data.Aeson as AE
7import qualified Data.HashMap.Strict as HM
8import qualified Data.HashMap.Strict as HM
8−import Data.String (String)
9+import Data.String (String)
9import Test.Hspec
10import Test.Hspec
10
11
11−import qualified AlternateSchema as AS
12import JSONSchema.Draft4
12import JSONSchema.Draft4
13−import qualified JSONSchema.Types as JT
13+import qualified JSONSchema.Types as JT
14+import qualified AlternateSchema as AS
14
15
15spec :: Spec
16spec :: Spec
16spec = do
17spec = do
test/Remote.hs+7−6
@@ -1,16 +1,17 @@
1+
1module Main where
2module Main where
2
3
3import Protolude
4import Protolude
4
5
5−import Control.Concurrent.Async (withAsync)
6+import Control.Concurrent.Async (withAsync)
6−import qualified Data.List.NonEmpty as NE
7+import qualified Data.List.NonEmpty as NE
7import Network.Wai.Application.Static (defaultFileServerSettings,
8import Network.Wai.Application.Static (defaultFileServerSettings,
8 staticApp)
9 staticApp)
9−import qualified Network.Wai.Handler.Warp as Warp
10+import Network.Wai.Handler.Warp (run)
10import Test.Hspec
11import Test.Hspec
11
12
12−import qualified JSONSchema.Draft4 as D4
13+import qualified JSONSchema.Draft4 as D4
13−import qualified JSONSchema.Types as JT
14+import qualified JSONSchema.Types as JT
14import Shared
15import Shared
15
16
16-- Examples
17-- Examples
@@ -51,7 +52,7 @@ main = withAsync serve $ \_ -> do
51 assertResult sc failures
52 assertResult sc failures
52
53
53serve :: IO ()
54serve :: IO ()
54−serve = Warp.run 1234
55+serve = run 1234
55 . staticApp
56 . staticApp
56 . defaultFileServerSettings
57 . defaultFileServerSettings
57 $ "JSON-Schema-Test-Suite/remotes"
58 $ "JSON-Schema-Test-Suite/remotes"
test/Shared.hs+20−18
@@ -1,29 +1,19 @@
1+
1module Shared where
2module Shared where
2
3
3import Protolude
4import Protolude
4
5
5−import Control.Monad (fail)
6+import Control.Monad (fail)
6import Data.Aeson
7import Data.Aeson
7−import Data.Aeson.TH (fieldLabelModifier)
8+import Data.Aeson.TH (fieldLabelModifier)
8−import qualified Data.ByteString as BS
9+import qualified Data.ByteString as BS
9−import Data.Char (toLower)
10+import Data.Char (toLower)
10−import Data.List (stripPrefix, unlines)
11+import Data.List (stripPrefix, unlines)
11−import qualified Data.Text as T
12+import qualified Data.Text as T
12import qualified System.Directory as SD
13import qualified System.Directory as SD
13−import System.FilePath ((</>))
14+import System.FilePath ((</>))
14import Test.Hspec
15import Test.Hspec
15
16
16−skipTest :: FilePath -> Bool
17−skipTest file = (file == "optional/format.json") -- Optional
18− || (file == "optional/zeroTerminatedFloats.json")
19− || (file == "optional/ecmascript-regex.json")
20−
21−
22−isHTTPTest :: FilePath -> Bool
23−isHTTPTest file = (file == "definitions.json")
24− || (file == "ref.json")
25− || (file == "refRemote.json")
26−
27-- Recursively return the contents of a directory
17-- Recursively return the contents of a directory
28-- (or return itself if given a file as an argument).
18-- (or return itself if given a file as an argument).
29--
19--
@@ -47,6 +37,18 @@ listFilesFullPath path = do
47 fs <- fmap (path </>) <$> SD.listDirectory path
37 fs <- fmap (path </>) <$> SD.listDirectory path
48 concat <$> traverse listFilesFullPath fs
38 concat <$> traverse listFilesFullPath fs
49
39
40+isHTTPTest :: FilePath -> Bool
41+isHTTPTest file = (file == "definitions.json")
42+ || (file == "ref.json")
43+ || (file == "refRemote.json")
44+
45+-- | We may never support the @"format"@ keywords
46+-- and are currently failing the others listed here.
47+skipOptional :: FilePath -> Bool
48+skipOptional file = (file == "optional/format.json")
49+ || (file == "optional/zeroTerminatedFloats.json")
50+ || (file == "optional/ecmascript-regex.json")
51+
50data SchemaTest = SchemaTest
52data SchemaTest = SchemaTest
51 { _stDescription :: Text
53 { _stDescription :: Text
52 , _stSchema :: Value
54 , _stSchema :: Value