git.iko.soy/typeable/hjsonschema
on db269be help sign in
33 files changed+364−352
since splitsnapshots
unifiedsplit
.travis.yml+56−67 README.md+48−8 changelog.md−36 examples/AlternateSchema.hs+18−13 examples/Simple.hs+5−4 examples/TwoStep.hs+4−3 hjsonschema.cabal+29−25 logo.jpg shell.nix+5−5 src/Import.hs+8−7 src/JSONSchema/Draft4.hs+15−12 src/JSONSchema/Draft4/Failure.hs+2−1 src/JSONSchema/Draft4/Schema.hs+7−6 src/JSONSchema/Draft4/Spec.hs+13−9 src/JSONSchema/Fetch.hs+15−16 src/JSONSchema/Types.hs+1 src/JSONSchema/Validator/Draft4.hs+8−7 src/JSONSchema/Validator/Draft4/Any.hs+31−54 src/JSONSchema/Validator/Draft4/Array.hs+6−7 src/JSONSchema/Validator/Draft4/Number.hs+2−1 src/JSONSchema/Validator/Draft4/Object.hs+9−5 src/JSONSchema/Validator/Draft4/Object/Properties.hs+6−5 src/JSONSchema/Validator/Draft4/String.hs+3−2 src/JSONSchema/Validator/Reference.hs+7−7 src/JSONSchema/Validator/Types.hs+1 src/JSONSchema/Validator/Utils.hs+17−11 stack.yaml−2 test/Local.hs+10−7 test/Local/Failure.hs+4−3 test/Local/Reference.hs+1 test/Local/Validation.hs+6−5 test/Remote.hs+7−6 test/Shared.hs+20−18
.travis.yml+56−67
@@ -1,95 +1,84 @@
1−# This Travis job script has been generated by a script via
2−#
3−# make_travis_yml_2.hs 'hjsonschema.cabal'
4−#
5−# For more information, see https://github.com/hvr/multi-ghc-travis
1+# Generated by: https://github.com/hvr/multi-ghc-travis
62#
3+# Removed `cabal check` because I don't want a description field.
4+
75language: c
86sudo: false
97
10−git:
11− submodules: false # whether to recursively clone submodules
12−
138cache:
149 directories:
10+ - $HOME/.cabsnap
1511 - $HOME/.cabal/packages
16− - $HOME/.cabal/store
1712
1813before_cache:
1914 - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
20− # remove files that are regenerated by 'cabal update'
21− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
22− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
23− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
24− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
15+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
2616
2717matrix:
2818 include:
29− - compiler: "ghc-8.0.2"
30− # env: TEST=--disable-tests BENCH=--disable-benchmarks
31− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
32− - compiler: "ghc-8.2.2"
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
37− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}
19+ - env: CABALVER=1.18 GHCVER=7.8.4
20+ compiler: ": #GHC 7.8.4"
21+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
22+ - env: CABALVER=1.22 GHCVER=7.10.2
23+ compiler: ": #GHC 7.10.2"
24+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
25+ - env: CABALVER=1.24 GHCVER=8.0.1
26+ compiler: ": #GHC 8.0.1"
27+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
3828
3929before_install:
40− - HC=${CC}
41− - HCPKG=${HC/ghc/ghc-pkg}
4230 - unset CC
43− - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
44− - PKGNAME='hjsonschema'
31+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
4532
4633install:
4734 - cabal --version
48− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
49− - BENCH=${BENCH---enable-benchmarks}
50− - TEST=${TEST---enable-tests}
51− - HADDOCK=${HADDOCK-true}
52− - INSTALLED=${INSTALLED-true}
35+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
36+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
37+ then
38+ zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
39+ $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
40+ fi
5341 - travis_retry cabal update -v
54− - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
55− - rm -fv cabal.project.local
56− - "echo 'packages: .' > cabal.project"
57− - rm -f cabal.project.freeze
58− - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all
59− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all
42+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
43+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
44+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
45+
46+# check whether current requested install-plan matches cached package-db snapshot
47+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
48+ then
49+ echo "cabal build-cache HIT";
50+ rm -rfv .ghc;
51+ cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
52+ cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
53+ else
54+ echo "cabal build-cache MISS";
55+ rm -rf $HOME/.cabsnap;
56+ mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
57+ cabal install --only-dependencies --enable-tests --enable-benchmarks;
58+ fi
59+
60+# snapshot package-db on cache miss
61+ - if [ ! -d $HOME/.cabsnap ];
62+ then
63+ echo "snapshotting package-db to build-cache";
64+ mkdir $HOME/.cabsnap;
65+ cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
66+ cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
67+ fi
6068
6169# Here starts the actual work to be performed for the package under test;
6270# any command which exits with a non-zero exit code causes the build to fail.
6371script:
6472 - if [ -f configure.ac ]; then autoreconf -i; fi
65− - rm -rf .ghc.environment.* dist/
66− - cabal sdist # test that a source-distribution can be generated
67− - cd dist/
68− - SRCTAR=(${PKGNAME}-*.tar.gz)
69− - SRC_BASENAME="${SRCTAR/%.tar.gz}"
70− - tar -xvf "./$SRC_BASENAME.tar.gz"
71− - cd "$SRC_BASENAME/"
72−## from here on, CWD is inside the extracted source-tarball
73− - rm -fv cabal.project.local
74− - "echo 'packages: .' > cabal.project"
75− # this builds all libraries and executables (without tests/benchmarks)
76− - rm -f cabal.project.freeze
77− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
78− # this builds all libraries and executables (including tests/benchmarks)
79− # - rm -rf ./dist-newstyle
80−
81− # Build with installed constraints for packages in global-db
82− - if $INSTALLED; then
83− echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh;
84− else echo "Not building with installed constraints"; fi
85−
86− # build & run tests, build benchmarks
87− - cabal new-build -w ${HC} ${TEST} ${BENCH} all
88− - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
73+ - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
74+ - cabal build # this builds all libraries and executables (including tests/benchmarks)
75+ - cabal test
76+ - cabal sdist # tests that a source-distribution can be generated
8977
90− # haddock
91− - rm -rf ./dist-newstyle
92− - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
78+# Check that the resulting source distribution can be built & installed.
79+# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
80+# `cabal install --force-reinstalls dist/*-*.tar.gz`
81+ - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
82+ (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
9383
94−# REGENDATA ["hjsonschema.cabal"]
9584# EOF
README.md+48−8
@@ -1,25 +1,65 @@
1−# DEPRECATION NOTICE
1+![hjsonschema logo](./logo.jpg)
22
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)).
44
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)
66
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
88
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.
1010
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.
1214
1315# Example
1416
1517See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Simple.hs).
1618
17−# System dependencies
19+# Tests
1820
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.
2052
2153## Vendoring
2254
2355+ `JSON-Schema-Test-Suite` is vendored from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema-org/JSON-Schema-Test-Suite).
2456
2557+ `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+## Credits
60+
61+[TJ Weigel](http://tjweigel.com/) created the logo.
62+
63+[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.
64+
65+[Julian Berman](https://github.com/Julian) maintains the fantastic [language agnostic test suite](https://github.com/json-schema/JSON-Schema-Test-Suite).
changelog.md−36
@@ -1,39 +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
17−
18−+ Bump http-types.
19−
20−# 1.7.0
21−
22−+ Test with GHC 8.2. Drop GHC 7.8.
23−+ Rework `allUniqueValues` related utility functions.
24−
25−# 1.6.3
26−
27−+ Bump hjsonpointer and QuickCheck.
28−
29−# 1.6.2
30−
31−+ Bump aeson.
32−
33−# 1.6.1
34−
35−+ Fix Haddocks.
36−
371# 1.6.0
382
393+ Fix defect where validators alongside "$ref" weren't ignored.
examples/AlternateSchema.hs+18−13
@@ -5,23 +5,28 @@
55-- to copy this module instead of the 'JSONSchema.Draft4'. While it's
66-- less convenient to write schemas in Haskell without a record type, you
77-- can get the implementation finished with far fewer lines of code.
8+
89module AlternateSchema where
910
1011import Protolude
1112
12−import Data.Aeson (FromJSON(..), Value(..), decodeStrict)
13−import qualified Data.Aeson as AE
14−import qualified Data.HashMap.Strict as HM
15−import Data.Maybe (fromMaybe)
16−import Data.Profunctor (Profunctor(..))
17−
18−import JSONSchema.Draft4 (ValidatorFailure(..), metaSchemaBytes)
19−import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))
20−import qualified JSONSchema.Fetch as FE
21−import JSONSchema.Types (Schema(..), Spec(..))
22−import qualified JSONSchema.Types as JT
23−import qualified JSONSchema.Validator.Draft4 as D4
24−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),
13+import Data.Aeson (FromJSON(..), Value(..),
14+ decodeStrict)
15+import qualified Data.Aeson as AE
16+import qualified Data.HashMap.Strict as HM
17+import Data.Maybe (fromMaybe)
18+import Data.Profunctor (Profunctor (..))
19+
20+import JSONSchema.Draft4 (ValidatorFailure(..),
21+ metaSchemaBytes)
22+import JSONSchema.Fetch (SchemaWithURI(..),
23+ URISchemaMap(..))
24+import qualified JSONSchema.Fetch as FE
25+import JSONSchema.Types (Schema(..), Spec(..))
26+import qualified JSONSchema.Types as JT
27+import qualified JSONSchema.Validator.Draft4 as D4
28+import JSONSchema.Validator.Reference (BaseURI(..),
29+ Scope(..),
2530 updateResolutionScope)
2631
2732--------------------------------------------------
examples/Simple.hs+5−4
@@ -1,13 +1,14 @@
1+
12module Simple where
23
34import Protolude
45
5−import Data.Aeson (Value(..), decodeStrict, toJSON)
6−import qualified Data.ByteString as BS
6+import Data.Aeson (Value(..), decodeStrict, toJSON)
7+import qualified Data.ByteString as BS
78import qualified Data.List.NonEmpty as NE
8−import Data.Maybe (fromMaybe)
9+import Data.Maybe (fromMaybe)
910
10−import qualified JSONSchema.Draft4 as D4
11+import qualified JSONSchema.Draft4 as D4
1112
1213badData :: Value
1314badData = toJSON [True, True]
examples/TwoStep.hs+4−3
@@ -10,14 +10,15 @@
1010-- 'fetchHTTPAndValidate' which fetched references over HTTP (though it
1111-- didn't matter because the last schema didn't actually have any).
1212-- This time we need to get them from the filesystem.
13+
1314module TwoStep where
1415
1516import Protolude
1617
17−import Data.Aeson (Value(..), toJSON)
18−import qualified Data.List.NonEmpty as NE
18+import Data.Aeson (Value (..), toJSON)
19+import qualified Data.List.NonEmpty as NE
1920
20−import qualified JSONSchema.Draft4 as D4
21+import qualified JSONSchema.Draft4 as D4
2122import qualified JSONSchema.Validator.Draft4 as VAL
2223
2324schema :: D4.Schema
hjsonschema.cabal+29−25
@@ -1,5 +1,5 @@
11name: hjsonschema
2−version: 1.9.0
2+version: 1.6.0
33synopsis: JSON Schema library
44homepage: https://github.com/seagreen/hjsonschema
55license: MIT
@@ -9,8 +9,6 @@ maintainer: ian@housejeffries.com
99category: Data
1010build-type: Simple
1111cabal-version: >=1.10
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
1412extra-source-files:
1513 changelog.md
1614 JSON-Schema-Test-Suite/remotes/*.json
@@ -34,6 +32,7 @@ library
3432 NoImplicitPrelude
3533 OverloadedStrings
3634 ScopedTypeVariables
35+ TupleSections
3736 if impl(ghc >= 8)
3837 default-extensions: StrictData
3938 ghc-options:
@@ -58,28 +57,27 @@ library
5857 JSONSchema.Validator.Draft4.Object.Properties
5958 , Import
6059 build-depends:
61− base >= 4.7 && < 5
60+ base >= 4.7 && < 4.10
6261 -- 0.11 is for `.:!`:
63− , aeson >= 0.11
64− , bytestring >= 0.10
65− , containers >= 0.5
66− , file-embed >= 0.0.8
67− , filepath >= 1.3
68− , hashable >= 1.2
69− , hjsonpointer >= 1.1
62+ , aeson >= 0.11 && < 1.2
63+ , bytestring >= 0.10 && < 0.11
64+ , containers >= 0.5 && < 0.6
65+ , file-embed >= 0.0.8 && < 0.1
66+ , filepath >= 1.3 && < 1.5
67+ , hashable >= 1.2 && < 1.3
68+ , hjsonpointer >= 1.1 && < 1.2
7069 -- 0.4.30 is for parseUrlThrow:
71− , http-client >= 0.4.30
72− , http-client-tls >= 0.3
73− , http-types >= 0.8
74− , pcre-heavy >= 1.0
75− , profunctors >= 5.0
76− , protolude >= 0.1.10
77− , QuickCheck >= 2.8
78− , safe-exceptions >= 0.1.6
79− , scientific >= 0.3
80− , unordered-containers >= 0.2
81− , text >= 1.1
82− , vector >= 0.10
70+ , http-client >= 0.4.30 && < 0.6
71+ , http-types >= 0.8 && < 0.10
72+ , pcre-heavy >= 1.0 && < 1.1
73+ , profunctors >= 5.0 && < 5.3
74+ , protolude >= 0.1.10 && < 1.2
75+ , QuickCheck >= 2.8 && < 2.10
76+ , scientific >= 0.3 && < 0.4
77+ , semigroups >= 0.18 && < 0.19
78+ , unordered-containers >= 0.2 && < 0.3
79+ , text >= 1.1 && < 1.3
80+ , vector >= 0.10 && < 1.0
8381
8482test-suite local
8583 hs-source-dirs:
@@ -114,14 +112,15 @@ test-suite local
114112 , hjsonschema
115113 , profunctors
116114 , protolude
115+ , semigroups
117116 , text
118117 , QuickCheck
119118 , unordered-containers
120119 , vector
121120
122121 -- directory-1.2.5 required for `listDirectory`:
123− , directory >= 1.2.5
124− , hspec >= 2.2
122+ , directory >= 1.2.5 && < 2.0
123+ , hspec >= 2.2 && < 3.0
125124
126125test-suite remote
127126 hs-source-dirs:
@@ -152,6 +151,7 @@ test-suite remote
152151 , hjsonschema
153152 , profunctors
154153 , protolude
154+ , semigroups
155155 , text
156156 , unordered-containers
157157 , vector
@@ -160,3 +160,7 @@ test-suite remote
160160 , hspec
161161 , wai-app-static
162162 , warp
163+
164+source-repository head
165+ type: git
166+ location: git://github.com/seagreen/hjsonschema.git
logo.jpgnew file

Binary file not shown.

shell.nix+5−5
@@ -1,15 +1,15 @@
1−{ghc}:
21with (import <nixpkgs> {});
32
43haskell.lib.buildStackProject {
54 name = "none";
65 inherit ghc;
76 buildInputs = [
8− pcre
9−
10− git # for `git:` references in stack.yml.
11− ncurses # for intero
127 pkgconfig
138 zlib
9+
10+ pcre
11+
12+ # for `git:` references in stack.yml:
13+ git
1414 ];
1515}
src/Import.hs+8−7
@@ -1,16 +1,17 @@
11
22module Import (module Export, fromJSONEither) where
33
4−import Protolude as Export
4+import Protolude as Export
55
6−import Data.Aeson as Export
6+import Data.Aeson as Export
77import Data.HashMap.Strict as Export (HashMap)
8−import Data.List.NonEmpty as Export (NonEmpty)
9−import Data.Vector as Export (Vector)
10−import Test.QuickCheck as Export hiding (Failure, Result, Success,
11− (.&.))
8+import Data.List as Export (length, null) -- for older GHCs
9+import Data.List.NonEmpty as Export (NonEmpty)
10+import Data.Vector as Export (Vector)
11+import Test.QuickCheck as Export hiding ((.&.), Failure,
12+ Result, Success)
1213
13−import qualified Data.Text as T
14+import qualified Data.Text as T
1415
1516fromJSONEither :: FromJSON a => Value -> Either Text a
1617fromJSONEither a =
src/JSONSchema/Draft4.hs+15−12
@@ -37,19 +37,22 @@ module JSONSchema.Draft4
3737
3838import Import
3939
40−import qualified Data.ByteString as BS
41−import Data.FileEmbed (embedFile, makeRelativeToProject)
42−import qualified Data.HashMap.Strict as HM
43−import qualified Data.List.NonEmpty as NE
44−import Data.Maybe (fromMaybe)
45−
46−import JSONSchema.Draft4.Failure (Invalid(..), SchemaInvalid(..),
40+import qualified Data.ByteString as BS
41+import Data.FileEmbed (embedFile,
42+ makeRelativeToProject)
43+import qualified Data.HashMap.Strict as HM
44+import qualified Data.List.NonEmpty as NE
45+import Data.Maybe (fromMaybe)
46+
47+import JSONSchema.Draft4.Failure (Invalid(..),
48+ SchemaInvalid(..),
4749 ValidatorFailure(..))
48−import JSONSchema.Draft4.Schema (Schema)
49−import qualified JSONSchema.Draft4.Schema as SC
50−import qualified JSONSchema.Draft4.Spec as Spec
51−import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))
52−import qualified JSONSchema.Fetch as FE
50+import JSONSchema.Draft4.Schema (Schema)
51+import qualified JSONSchema.Draft4.Schema as SC
52+import qualified JSONSchema.Draft4.Spec as Spec
53+import JSONSchema.Fetch (SchemaWithURI(..),
54+ URISchemaMap(..))
55+import qualified JSONSchema.Fetch as FE
5356
5457data HTTPValidationFailure
5558 = HVRequest FE.HTTPFailure
src/JSONSchema/Draft4/Failure.hs+2−1
@@ -1,8 +1,9 @@
1+
12module JSONSchema.Draft4.Failure where
23
34import Import
45
5−import JSONSchema.Draft4.Schema (Schema)
6+import JSONSchema.Draft4.Schema (Schema)
67import qualified JSONSchema.Validator.Draft4 as VAL
78
89-- | Used to report an entire instance being invalidated, as opposed
src/JSONSchema/Draft4/Schema.hs+7−6
@@ -1,13 +1,14 @@
1+
12module JSONSchema.Draft4.Schema where
23
3−import Import hiding (mapMaybe)
4+import Import hiding (mapMaybe)
45
5−import qualified Data.HashMap.Strict as HM
6−import Data.List.NonEmpty (NonEmpty)
7−import Data.Maybe (fromJust, isJust)
6+import qualified Data.HashMap.Strict as HM
7+import Data.List.NonEmpty (NonEmpty)
8+import Data.Maybe (fromJust, isJust)
89import Data.Scientific
9−import qualified Data.Set as Set
10−import qualified Data.Text as T
10+import qualified Data.Set as Set
11+import qualified Data.Text as T
1112
1213import qualified JSONSchema.Validator.Draft4 as D4
1314import JSONSchema.Validator.Utils
src/JSONSchema/Draft4/Spec.hs+13−9
@@ -1,18 +1,22 @@
1+
12module JSONSchema.Draft4.Spec where
23
34import Import
45
5−import Data.Maybe (fromMaybe)
6−import Data.Profunctor (Profunctor(..))
6+import Data.Maybe (fromMaybe)
7+import Data.Profunctor (Profunctor(..))
78
89import JSONSchema.Draft4.Failure
9−import JSONSchema.Draft4.Schema (Schema(..), emptySchema)
10−import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))
11−import qualified JSONSchema.Fetch as FE
12−import JSONSchema.Types (Spec(..))
13−import qualified JSONSchema.Types as JT
10+import JSONSchema.Draft4.Schema (Schema(..),
11+ emptySchema)
12+import JSONSchema.Fetch (SchemaWithURI(..),
13+ URISchemaMap(..))
14+import qualified JSONSchema.Fetch as FE
15+import JSONSchema.Types (Spec(..))
16+import qualified JSONSchema.Types as JT
1417import JSONSchema.Validator.Draft4
15−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),
18+import JSONSchema.Validator.Reference (BaseURI(..),
19+ Scope(..),
1620 updateResolutionScope)
1721
1822-- | An implementation of 'JT.embedded'.
@@ -39,7 +43,7 @@ specValidate schemaMap sw =
3943 (_schemaId (_swSchema sw))
4044 }
4145
42−validateSubschema
46+validateSubschema
4347 :: URISchemaMap Schema
4448 -> VisitedSchemas
4549 -> Scope Schema
src/JSONSchema/Fetch.hs+15−16
@@ -1,18 +1,18 @@
1+
12module JSONSchema.Fetch where
23
34import Import
45
5−import qualified Control.Exception.Safe as Safe
6−import Control.Monad (foldM)
7−import qualified Data.ByteString as BS
8−import qualified Data.ByteString.Lazy as LBS
9−import qualified Data.HashMap.Strict as HM
10−import qualified Data.Semigroup as S
11−import qualified Data.Text as T
12−import qualified Network.HTTP.Client as NC
13−import qualified Network.HTTP.Client.TLS as NCTLS
14−
15−import JSONSchema.Validator.Reference (BaseURI(..), resolveReference,
6+import Control.Exception (IOException, catch)
7+import Control.Monad (foldM)
8+import qualified Data.ByteString as BS
9+import qualified Data.ByteString.Lazy as LBS
10+import qualified Data.HashMap.Strict as HM
11+import qualified Data.Text as T
12+import qualified Network.HTTP.Client as NC
13+
14+import JSONSchema.Validator.Reference (BaseURI(..),
15+ resolveReference,
1616 updateResolutionScope)
1717
1818--------------------------------------------------
@@ -30,7 +30,7 @@ data FetchInfo schema = FetchInfo
3030-- | Keys are URIs (without URI fragments).
3131newtype URISchemaMap schema
3232 = URISchemaMap { _unURISchemaMap :: HashMap Text schema }
33− deriving (Eq, Show, S.Semigroup, Monoid)
33+ deriving (Eq, Show, Monoid)
3434
3535-- | A top-level schema along with its location.
3636data SchemaWithURI schema = SchemaWithURI
@@ -61,9 +61,9 @@ referencesViaHTTP'
6161 -> SchemaWithURI schema
6262 -> IO (Either HTTPFailure (URISchemaMap schema))
6363referencesViaHTTP' info sw = do
64− manager <- NC.newManager NCTLS.tlsManagerSettings
64+ manager <- NC.newManager NC.defaultManagerSettings
6565 let f = referencesMethodAgnostic (getURL manager) info sw
66− Safe.catch (first HTTPParseFailure <$> f) handler
66+ catch (first HTTPParseFailure <$> f) handler
6767 where
6868 getURL :: NC.Manager -> Text -> IO BS.ByteString
6969 getURL man url = do
@@ -89,8 +89,7 @@ referencesViaFilesystem'
8989 => FetchInfo schema
9090 -> SchemaWithURI schema
9191 -> 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
9493 where
9594 f :: IO (Either Text (URISchemaMap schema))
9695 f = referencesMethodAgnostic (BS.readFile . T.unpack) info sw
src/JSONSchema/Types.hs+1
@@ -1,3 +1,4 @@
1+
12module JSONSchema.Types where
23
34import Import
src/JSONSchema/Validator/Draft4.hs+8−7
@@ -2,6 +2,7 @@
22--
33-- This is frankly a lot of busywork. It can perhaps be moved into the
44-- validator modules themselves once we're sure this is the right design.
5+
56module JSONSchema.Validator.Draft4
67 ( module JSONSchema.Validator.Draft4
78 , module Export
@@ -9,16 +10,16 @@ module JSONSchema.Validator.Draft4
910
1011import Import
1112
12−import qualified Data.HashMap.Strict as HM
13−import qualified Data.List.NonEmpty as NE
13+import qualified Data.HashMap.Strict as HM
14+import qualified Data.List.NonEmpty as NE
1415
15−import JSONSchema.Validator.Draft4.Any as Export
16−import JSONSchema.Validator.Draft4.Array as Export
16+import JSONSchema.Validator.Draft4.Any as Export
17+import JSONSchema.Validator.Draft4.Array as Export
1718import JSONSchema.Validator.Draft4.Number as Export
1819import JSONSchema.Validator.Draft4.Object as Export
1920import JSONSchema.Validator.Draft4.String as Export
20−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..))
21−import JSONSchema.Validator.Types (Validator(..))
21+import JSONSchema.Validator.Reference (BaseURI(..), Scope(..))
22+import JSONSchema.Validator.Types (Validator(..))
2223
2324-- | For internal use.
2425--
@@ -147,7 +148,7 @@ propertiesRelatedValidator f =
147148 <> HM.elems (fromMaybe mempty (_propPattern a))
148149 <> case _propAdditional a of
149150 Just (AdditionalPropertiesObject b) -> [b]
150− _ -> mempty
151+ _ -> mempty
151152 ))
152153 (\a b -> case fromJSONEither b of
153154 Left _ -> mempty
src/JSONSchema/Validator/Draft4/Any.hs+31−54
@@ -1,24 +1,25 @@
1+
12module JSONSchema.Validator.Draft4.Any where
23
3−import Import hiding ((<>))
4+import Import hiding ((<>))
45
5−import Data.Aeson.TH (constructorTagModifier)
6−import Data.Char (toLower)
7−import qualified Data.HashMap.Strict as HM
8−import Data.List.NonEmpty (NonEmpty((:|)))
9−import qualified Data.List.NonEmpty as NE
10−import qualified Data.Scientific as SCI
6+import Data.Aeson.TH (constructorTagModifier)
7+import Data.Char (toLower)
8+import Data.List.NonEmpty (NonEmpty((:|)))
9+import qualified Data.List.NonEmpty as NE
10+import qualified Data.Scientific as SCI
1111import Data.Semigroup
12−import Data.Set (Set)
13−import qualified Data.Set as Set
14−import Data.Text.Encoding.Error (UnicodeException)
15−import qualified JSONPointer as JP
16−import Network.HTTP.Types.URI (urlDecode)
17−
18−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),
12+import Data.Set (Set)
13+import qualified Data.Set as Set
14+import Data.Text.Encoding.Error (UnicodeException)
15+import qualified JSONPointer as JP
16+import Network.HTTP.Types.URI (urlDecode)
17+
18+import qualified JSONSchema.Validator.Utils as UT
19+import JSONSchema.Validator.Reference (BaseURI(..),
20+ Scope(..),
1921 URIAndFragment,
2022 resolveReference)
21−import qualified JSONSchema.Validator.Utils as UT
2223
2324--------------------------------------------------
2425-- * $ref
@@ -125,16 +126,14 @@ getDocument getRef updateScope scope mURI reference =
125126 )
126127
127128data JSONPointerError
128− = URLDecodingError UnicodeException
129− -- ^ Aspirationally internal.
129+ = URLDecodingError UnicodeException -- | Aspirationally internal.
130130 | FormatError JP.FormatError
131131 | ResolutionError JP.ResolutionError
132− | SubschemaDecodingError Text
133− -- ^ Aspirationally internal.
132+ | SubschemaDecodingError Text -- | Aspirationally internal.
134133 deriving (Eq, Show)
135134
136135resolveFragment
137− :: (FromJSON schema, ToJSON schema)
136+ :: forall schema. (FromJSON schema, ToJSON schema)
138137 => (BaseURI -> schema -> BaseURI)
139138 -> Scope schema
140139 -> Text
@@ -159,40 +158,17 @@ resolveFragment updateScope scope fragment = do
159158 -- as property keys that aren't meant to change scope?
160159 -- Perhaps this should be added to the language agnostic
161160 -- 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.
167161 go :: (Value, BaseURI)
168162 -> JP.Token
169163 -> Either JSONPointerError (Value, BaseURI)
170− go (lastVal, baseURI) tok = do
164+ go (lastVal, uri) tok = do
171165 v <- first ResolutionError (JP.resolveToken tok lastVal)
172− newBase <- newBaseURIFromFragment updateScope baseURI v
173− Right (v, newBase)
174−
175−-- | Update the 'BaseURI' (the store of the current "id" value)
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))
191− Right (updateScope baseURI schema)
192− _ -> Right baseURI
193− where
194− idKey :: Text
195− idKey = "id"
166+ case v of
167+ Array _ -> pure (v, uri)
168+ _ -> do
169+ -- PERFORMANCE: Avoid deserializing subschemas.
170+ schema <- first SubschemaDecodingError (fromJSONEither v)
171+ pure (v, updateScope uri schema)
196172
197173--------------------------------------------------
198174-- * enum
@@ -238,9 +214,9 @@ data EnumInvalid
238214
239215enumVal :: EnumValidator -> Value -> Maybe EnumInvalid
240216enumVal a@(EnumValidator vs) x
241− | not (UT.allUniqueValues vs) = Nothing
242− | x `elem` vs = Nothing
243− | otherwise = Just $ EnumInvalid a x
217+ | not (UT.allUniqueValues' vs) = Nothing
218+ | x `elem` vs = Nothing
219+ | otherwise = Just $ EnumInvalid a x
244220
245221--------------------------------------------------
246222-- * type
@@ -399,7 +375,8 @@ anyOfVal
399375 -> Value
400376 -> Maybe (AnyOfInvalid err)
401377anyOfVal f (AnyOf subSchemas) x
402− | any (null . snd) perhapsFailures = Nothing
378+ -- Replace with @null@ once we drop GHC 7.8:
379+ | any (((==) 0 . length) . snd) perhapsFailures = Nothing
403380 | otherwise = AnyOfInvalid <$> NE.nonEmpty failures
404381 where
405382 perhapsFailures :: [(JP.Index, [err])]
src/JSONSchema/Validator/Draft4/Array.hs+6−7
@@ -1,10 +1,11 @@
1+
12module JSONSchema.Validator.Draft4.Array where
23
34import Import
45
5−import qualified Data.List.NonEmpty as NE
6−import qualified Data.Vector as V
7−import qualified JSONPointer as JP
6+import qualified Data.List.NonEmpty as NE
7+import qualified Data.Vector as V
8+import qualified JSONPointer as JP
89
910import JSONSchema.Validator.Utils (allUniqueValues)
1011
@@ -173,8 +174,7 @@ itemsVal f a xs =
173174 :: schema
174175 -> (JP.Index, Value)
175176 -> Maybe (JP.Index, NonEmpty err)
176− validateElem schema (index,x) =
177− (\v -> (index, v)) <$> NE.nonEmpty (f schema x)
177+ validateElem schema (index,x) = (index,) <$> NE.nonEmpty (f schema x)
178178
179179--------------------------------------------------
180180-- * additionalItems
@@ -219,7 +219,6 @@ additionalItemsVal _ (AdditionalBool False) xs =
219219 AdditionalItemsBoolInvalid <$> NE.nonEmpty xs
220220additionalItemsVal f (AdditionalObject subSchema) xs =
221221 let res = mapMaybe
222− (\(index,x) -> (\v -> (index, v))
223− <$> NE.nonEmpty (f subSchema x))
222+ (\(index,x) -> (index,) <$> NE.nonEmpty (f subSchema x))
224223 xs
225224 in AdditionalItemsObjectInvalid <$> NE.nonEmpty res
src/JSONSchema/Validator/Draft4/Number.hs+2−1
@@ -1,8 +1,9 @@
1+
12module JSONSchema.Validator.Draft4.Number where
23
34import Import
45
5−import Data.Fixed (mod')
6+import Data.Fixed (mod')
67import Data.Scientific (Scientific)
78
89--------------------------------------------------
src/JSONSchema/Validator/Draft4/Object.hs+9−5
@@ -1,3 +1,4 @@
1+
12module JSONSchema.Validator.Draft4.Object
23 ( module JSONSchema.Validator.Draft4.Object
34 , module JSONSchema.Validator.Draft4.Object.Properties
@@ -5,11 +6,11 @@ module JSONSchema.Validator.Draft4.Object
56
67import Import
78
8−import qualified Data.HashMap.Strict as HM
9−import qualified Data.List.NonEmpty as NE
10−import Data.Set (Set)
11−import qualified Data.Set as Set
12−import qualified Data.Text as T
9+import qualified Data.HashMap.Strict as HM
10+import qualified Data.List.NonEmpty as NE
11+import Data.Set (Set)
12+import qualified Data.Set as Set
13+import qualified Data.Text as T
1314
1415import JSONSchema.Validator.Draft4.Object.Properties
1516import JSONSchema.Validator.Utils
@@ -95,6 +96,9 @@ data RequiredInvalid
9596
9697requiredVal :: Required -> HashMap Text Value -> Maybe RequiredInvalid
9798requiredVal r@(Required ts) x
99+ -- NOTE: When we no longer need to support GHCs before 7.10
100+ -- we can use null from Prelude throughout the library
101+ -- instead of specialized versions.
98102 | Set.null ts = Nothing
99103 | Set.null leftovers = Nothing
100104 | otherwise = Just (RequiredInvalid r leftovers x)
src/JSONSchema/Validator/Draft4/Object/Properties.hs+6−5
@@ -1,12 +1,13 @@
1+
12module JSONSchema.Validator.Draft4.Object.Properties where
23
34import Import
45
5−import qualified Data.Hashable as HA
6−import qualified Data.HashMap.Strict as HM
7−import qualified Data.List.NonEmpty as NE
8−import Data.Text.Encoding (encodeUtf8)
9−import qualified JSONPointer as JP
6+import qualified Data.Hashable as HA
7+import qualified Data.HashMap.Strict as HM
8+import qualified Data.List.NonEmpty as NE
9+import Data.Text.Encoding (encodeUtf8)
10+import qualified JSONPointer as JP
1011import qualified Text.Regex.PCRE.Heavy as RE
1112
1213data PropertiesRelated schema = PropertiesRelated
src/JSONSchema/Validator/Draft4/String.hs+3−2
@@ -1,9 +1,10 @@
1+
12module JSONSchema.Validator.Draft4.String where
23
34import Import
45
5−import qualified Data.Text as T
6−import Data.Text.Encoding (encodeUtf8)
6+import qualified Data.Text as T
7+import Data.Text.Encoding (encodeUtf8)
78import qualified Text.Regex.PCRE.Heavy as RE
89
910--------------------------------------------------
src/JSONSchema/Validator/Reference.hs+7−7
@@ -3,14 +3,15 @@
33--
44-- And is extended for JSON Schema here:
55-- <http://json-schema.org/latest/json-schema-core.html#anchor26>
6+
67module JSONSchema.Validator.Reference where
78
89import Import
910
10−import qualified Data.Text as T
11−import System.FilePath (dropFileName, (</>))
11+import qualified Data.Text as T
12+import System.FilePath ((</>), dropFileName)
1213
13−data Scope schema = Scope
14+data Scope schema = Scope
1415 { _topLevelDocument :: schema
1516 , _documentURI :: Maybe Text
1617 , _currentBaseURI :: BaseURI
@@ -24,10 +25,9 @@ newtype BaseURI
2425type URIAndFragment = (Maybe Text, Maybe Text)
2526
2627updateResolutionScope :: BaseURI -> Maybe Text -> BaseURI
27−updateResolutionScope base idKeyword =
28− case idKeyword of
29− Just t -> BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t
30− Nothing -> base
28+updateResolutionScope base idKeyword
29+ | Just t <- idKeyword = BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t
30+ | otherwise = base
3131
3232resolveReference :: BaseURI -> Text -> URIAndFragment
3333resolveReference base t = baseAndFragment (resolveScopeAgainst base t)
src/JSONSchema/Validator/Types.hs+1
@@ -1,3 +1,4 @@
1+
12module JSONSchema.Validator.Types where
23
34import Import
src/JSONSchema/Validator/Utils.hs+17−11
@@ -1,15 +1,16 @@
1+
12module JSONSchema.Validator.Utils where
23
34import Import
45
5−import Control.Monad (fail)
6+import Control.Monad (fail)
67import qualified Data.HashMap.Strict as HM
7−import qualified Data.List.NonEmpty as NE
8−import Data.Scientific (Scientific, fromFloatDigits)
9−import Data.Set (Set)
10−import qualified Data.Set as S
11−import qualified Data.Text as T
12−import qualified Data.Vector as V
8+import qualified Data.List.NonEmpty as NE
9+import Data.Scientific (Scientific, fromFloatDigits)
10+import Data.Set (Set)
11+import qualified Data.Set as S
12+import qualified Data.Text as T
13+import qualified Data.Vector as V
1314
1415--------------------------------------------------
1516-- * QuickCheck
@@ -82,11 +83,16 @@ instance Arbitrary a => Arbitrary (NonEmpty' a) where
8283-- * allUniqueValues
8384--------------------------------------------------
8485
85−allUniqueValues :: (Foldable f, Functor f) => f Value -> Bool
86−allUniqueValues = allUnique . fmap OrdValue
86+allUniqueValues :: Vector Value -> Bool
87+allUniqueValues = allUnique . fmap OrdValue . V.toList
88+
89+-- NOTE: When we no longer support GHC 7.8 we can generalize
90+-- allUnique to work on any Foldable and remove this function.
91+allUniqueValues' :: NonEmpty Value -> Bool
92+allUniqueValues' = allUnique . fmap OrdValue . NE.toList
8793
88−allUnique :: (Foldable f, Ord a) => f a -> Bool
89−allUnique xs = S.size (S.fromList (toList xs)) == length xs
94+allUnique :: (Ord a) => [a] -> Bool
95+allUnique xs = S.size (S.fromList xs) == length xs
9096
9197-- | OrdValue's Ord instance needs benchmarking, but it allows us to
9298-- use our 'allUnique' function instead of O(n^2) nub, so it's probably
stack.yamldeleted−2
@@ -1,2 +0,0 @@
1−resolver: lts-10.8
2−pvp-bounds: upper-revision
test/Local.hs+10−7
@@ -1,18 +1,19 @@
1+
12module Main where
23
34import Protolude
45
56import Data.Aeson
67import qualified Data.List.NonEmpty as NE
7−import qualified System.Timeout as TO
8+import qualified System.Timeout as TO
89import Test.Hspec
9−import Test.QuickCheck (property)
10+import Test.QuickCheck (property)
1011
11−import qualified JSONSchema.Draft4 as D4
12−import qualified JSONSchema.Types as JT
12+import qualified JSONSchema.Draft4 as D4
13+import qualified JSONSchema.Types as JT
1314import qualified Local.Failure
14−import qualified Local.Reference
1515import qualified Local.Validation
16+import qualified Local.Reference
1617import Shared
1718
1819-- Examples
@@ -32,10 +33,12 @@ main = do
3233 -- Language agnostic tests
3334 ts <- readSchemaTests
3435 dir
35− (\a -> not (isHTTPTest a || skipTest a))
36+ (\a -> not (isHTTPTest a || skipOptional a))
3637
3738 -- 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))
3942
4043 hspec $ do
4144 describe "Examples" exampleTests
test/Local/Failure.hs+4−3
@@ -1,14 +1,15 @@
1+
12module Local.Failure where
23
34import Protolude
45
56import Data.Aeson
6−import qualified Data.Vector as V
7−import qualified JSONPointer as JP
87import Test.Hspec
8+import qualified Data.Vector as V
9+import qualified JSONPointer as JP
910
1011import JSONSchema.Draft4
11−import qualified JSONSchema.Draft4.Spec as Spec
12+import qualified JSONSchema.Draft4.Spec as Spec
1213import qualified JSONSchema.Validator.Draft4 as VAL
1314
1415spec :: Spec
test/Local/Reference.hs+1
@@ -1,3 +1,4 @@
1+
12module Local.Reference where
23
34import Protolude
test/Local/Validation.hs+6−5
@@ -1,16 +1,17 @@
1+
12module Local.Validation where
23
3−import Protolude
4+import Protolude hiding (msg)
45
56import Data.Aeson
6−import qualified Data.Aeson as AE
7+import qualified Data.Aeson as AE
78import qualified Data.HashMap.Strict as HM
8−import Data.String (String)
9+import Data.String (String)
910import Test.Hspec
1011
11−import qualified AlternateSchema as AS
1212import JSONSchema.Draft4
13−import qualified JSONSchema.Types as JT
13+import qualified JSONSchema.Types as JT
14+import qualified AlternateSchema as AS
1415
1516spec :: Spec
1617spec = do
test/Remote.hs+7−6
@@ -1,16 +1,17 @@
1+
12module Main where
23
34import Protolude
45
5−import Control.Concurrent.Async (withAsync)
6−import qualified Data.List.NonEmpty as NE
6+import Control.Concurrent.Async (withAsync)
7+import qualified Data.List.NonEmpty as NE
78import Network.Wai.Application.Static (defaultFileServerSettings,
89 staticApp)
9−import qualified Network.Wai.Handler.Warp as Warp
10+import Network.Wai.Handler.Warp (run)
1011import Test.Hspec
1112
12−import qualified JSONSchema.Draft4 as D4
13−import qualified JSONSchema.Types as JT
13+import qualified JSONSchema.Draft4 as D4
14+import qualified JSONSchema.Types as JT
1415import Shared
1516
1617-- Examples
@@ -51,7 +52,7 @@ main = withAsync serve $ \_ -> do
5152 assertResult sc failures
5253
5354serve :: IO ()
54−serve = Warp.run 1234
55+serve = run 1234
5556 . staticApp
5657 . defaultFileServerSettings
5758 $ "JSON-Schema-Test-Suite/remotes"
test/Shared.hs+20−18
@@ -1,29 +1,19 @@
1+
12module Shared where
23
34import Protolude
45
5−import Control.Monad (fail)
6+import Control.Monad (fail)
67import Data.Aeson
7−import Data.Aeson.TH (fieldLabelModifier)
8−import qualified Data.ByteString as BS
9−import Data.Char (toLower)
10−import Data.List (stripPrefix, unlines)
11−import qualified Data.Text as T
8+import Data.Aeson.TH (fieldLabelModifier)
9+import qualified Data.ByteString as BS
10+import Data.Char (toLower)
11+import Data.List (stripPrefix, unlines)
12+import qualified Data.Text as T
1213import qualified System.Directory as SD
13−import System.FilePath ((</>))
14+import System.FilePath ((</>))
1415import Test.Hspec
1516
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−
2717-- Recursively return the contents of a directory
2818-- (or return itself if given a file as an argument).
2919--
@@ -47,6 +37,18 @@ listFilesFullPath path = do
4737 fs <- fmap (path </>) <$> SD.listDirectory path
4838 concat <$> traverse listFilesFullPath fs
4939
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+
5052data SchemaTest = SchemaTest
5153 { _stDescription :: Text
5254 , _stSchema :: Value