diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,50 +1,32 @@ -![hjsonschema logo](./logo.jpg) +# Summary -A Haskell implementation of [JSON Schema](http://json-schema.org/) ([Draft 4](https://github.com/json-schema-org/json-schema-spec/wiki/Specification-Links#draft-4)). +A Haskell implementation of [JSON Schema](http://json-schema.org/) ([Draft 4](http://json-schema.org/specification-links.html)). [Hackage](https://hackage.haskell.org/package/hjsonschema) / [GitHub](https://github.com/seagreen/hjsonschema) / [Travis CI](https://travis-ci.org/seagreen/hjsonschema) -# Notes - -+ 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. - -+ Requires [pcre](http://www.pcre.org/) (`pkgs.pcre` in Nixpkgs). - -+ 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. - # Example See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Simple.hs). -# Tests - -Run all tests: - -`stack test` - -Run only local tests: - -`stack test hjsonschema:local` - -Run remote tests (makes GETs to json-schema.org, also temporarily starts an HTTP server on port 1234): +# Design -`stack test hjsonschema:remote` +`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). -# Details +However this flexibility comes at the price of complicating the code. I'm no longer sure it was the right tradeoff, especially since situations where you'd want to change what validators make up a `Spec` at runtime seem rare. -## Goals +Also, there are edge cases of JSON Schema that `hjsonschema` doesn't implement properly (as you can see from the issue tracker). My motivation to fix them myself has ended. However, I'll still maintain the library, give feedback on issues, and merge PRs. I'd also be happy to advise any Haskellers who are interested in writing their own JSON Schema libraries. -+ Be a correct and fast implementation of the spec. +# System dependencies -+ Be a useful reference for implementers in other languages. Haskell's high level nature, expressive type system and referential transparency suit this purpose well. ++ Requires [pcre](http://www.pcre.org/) (`pkgs.pcre` in Nixpkgs). -## Issues +# Tests -+ Doesn't pass all of the tests in the [language agnostic test suite](https://github.com/json-schema/JSON-Schema-Test-Suite). See the issue list for details. +Run all: `stack test` -+ 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. +Run only local tests: `stack test hjsonschema:local` -+ Currently doesn't support the optional `"format"` validators. +Run only remote tests (temporarily starts an HTTP server on port 1234 and makes GETs to json-schema.org): `stack test hjsonschema:remote` ## Vendoring @@ -53,11 +35,3 @@ + `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). + `.travis.yml` was created with `make_travis_yml_2.hs` commit # ea6c7d177a97bfbfb2fdc4deba943d60d2aff199. - -## Credits - -[TJ Weigel](http://tjweigel.com/) created the logo. - -[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. - -[Julian Berman](https://github.com/Julian) maintains the fantastic [language agnostic test suite](https://github.com/json-schema/JSON-Schema-Test-Suite). diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +# 1.8.0 + ++ Allow HTTPS references (thanks @creichert!). ++ Use `safe-exceptions` to eliminate the risk of catching asynchronous exceptions. + # 1.7.2 + Remove upper bounds. diff --git a/examples/AlternateSchema.hs b/examples/AlternateSchema.hs --- a/examples/AlternateSchema.hs +++ b/examples/AlternateSchema.hs @@ -5,28 +5,23 @@ -- to copy this module instead of the 'JSONSchema.Draft4'. While it's -- less convenient to write schemas in Haskell without a record type, you -- can get the implementation finished with far fewer lines of code. - module AlternateSchema where import Protolude -import Data.Aeson (FromJSON(..), Value(..), - decodeStrict) -import qualified Data.Aeson as AE -import qualified Data.HashMap.Strict as HM -import Data.Maybe (fromMaybe) -import Data.Profunctor (Profunctor (..)) +import Data.Aeson (FromJSON(..), Value(..), decodeStrict) +import qualified Data.Aeson as AE +import qualified Data.HashMap.Strict as HM +import Data.Maybe (fromMaybe) +import Data.Profunctor (Profunctor(..)) -import JSONSchema.Draft4 (ValidatorFailure(..), - metaSchemaBytes) -import JSONSchema.Fetch (SchemaWithURI(..), - URISchemaMap(..)) -import qualified JSONSchema.Fetch as FE -import JSONSchema.Types (Schema(..), Spec(..)) -import qualified JSONSchema.Types as JT -import qualified JSONSchema.Validator.Draft4 as D4 -import JSONSchema.Validator.Reference (BaseURI(..), - Scope(..), +import JSONSchema.Draft4 (ValidatorFailure(..), metaSchemaBytes) +import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..)) +import qualified JSONSchema.Fetch as FE +import JSONSchema.Types (Schema(..), Spec(..)) +import qualified JSONSchema.Types as JT +import qualified JSONSchema.Validator.Draft4 as D4 +import JSONSchema.Validator.Reference (BaseURI(..), Scope(..), updateResolutionScope) -------------------------------------------------- diff --git a/examples/Simple.hs b/examples/Simple.hs --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -1,14 +1,13 @@ - module Simple where import Protolude -import Data.Aeson (Value(..), decodeStrict, toJSON) -import qualified Data.ByteString as BS +import Data.Aeson (Value(..), decodeStrict, toJSON) +import qualified Data.ByteString as BS import qualified Data.List.NonEmpty as NE -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe) -import qualified JSONSchema.Draft4 as D4 +import qualified JSONSchema.Draft4 as D4 badData :: Value badData = toJSON [True, True] diff --git a/examples/TwoStep.hs b/examples/TwoStep.hs --- a/examples/TwoStep.hs +++ b/examples/TwoStep.hs @@ -10,15 +10,14 @@ -- 'fetchHTTPAndValidate' which fetched references over HTTP (though it -- didn't matter because the last schema didn't actually have any). -- This time we need to get them from the filesystem. - module TwoStep where import Protolude -import Data.Aeson (Value (..), toJSON) -import qualified Data.List.NonEmpty as NE +import Data.Aeson (Value(..), toJSON) +import qualified Data.List.NonEmpty as NE -import qualified JSONSchema.Draft4 as D4 +import qualified JSONSchema.Draft4 as D4 import qualified JSONSchema.Validator.Draft4 as VAL schema :: D4.Schema diff --git a/hjsonschema.cabal b/hjsonschema.cabal --- a/hjsonschema.cabal +++ b/hjsonschema.cabal @@ -1,5 +1,5 @@ name: hjsonschema -version: 1.7.2 +version: 1.8.0 synopsis: JSON Schema library homepage: https://github.com/seagreen/hjsonschema license: MIT @@ -34,7 +34,6 @@ NoImplicitPrelude OverloadedStrings ScopedTypeVariables - TupleSections if impl(ghc >= 8) default-extensions: StrictData ghc-options: @@ -70,11 +69,13 @@ , hjsonpointer >= 1.1 -- 0.4.30 is for parseUrlThrow: , http-client >= 0.4.30 + , http-client-tls >= 0.3 , http-types >= 0.8 , pcre-heavy >= 1.0 , profunctors >= 5.0 , protolude >= 0.1.10 , QuickCheck >= 2.8 + , safe-exceptions >= 0.1.6 , scientific >= 0.3 , semigroups >= 0.18 , unordered-containers >= 0.2 diff --git a/src/Import.hs b/src/Import.hs --- a/src/Import.hs +++ b/src/Import.hs @@ -1,16 +1,16 @@ module Import (module Export, fromJSONEither) where -import Protolude as Export +import Protolude as Export -import Data.Aeson as Export +import Data.Aeson as Export import Data.HashMap.Strict as Export (HashMap) -import Data.List.NonEmpty as Export (NonEmpty) -import Data.Vector as Export (Vector) -import Test.QuickCheck as Export hiding ((.&.), Failure, - Result, Success) +import Data.List.NonEmpty as Export (NonEmpty) +import Data.Vector as Export (Vector) +import Test.QuickCheck as Export hiding (Failure, Result, Success, + (.&.)) -import qualified Data.Text as T +import qualified Data.Text as T fromJSONEither :: FromJSON a => Value -> Either Text a fromJSONEither a = diff --git a/src/JSONSchema/Draft4.hs b/src/JSONSchema/Draft4.hs --- a/src/JSONSchema/Draft4.hs +++ b/src/JSONSchema/Draft4.hs @@ -37,22 +37,19 @@ import Import -import qualified Data.ByteString as BS -import Data.FileEmbed (embedFile, - makeRelativeToProject) -import qualified Data.HashMap.Strict as HM -import qualified Data.List.NonEmpty as NE -import Data.Maybe (fromMaybe) +import qualified Data.ByteString as BS +import Data.FileEmbed (embedFile, makeRelativeToProject) +import qualified Data.HashMap.Strict as HM +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromMaybe) -import JSONSchema.Draft4.Failure (Invalid(..), - SchemaInvalid(..), +import JSONSchema.Draft4.Failure (Invalid(..), SchemaInvalid(..), ValidatorFailure(..)) -import JSONSchema.Draft4.Schema (Schema) -import qualified JSONSchema.Draft4.Schema as SC -import qualified JSONSchema.Draft4.Spec as Spec -import JSONSchema.Fetch (SchemaWithURI(..), - URISchemaMap(..)) -import qualified JSONSchema.Fetch as FE +import JSONSchema.Draft4.Schema (Schema) +import qualified JSONSchema.Draft4.Schema as SC +import qualified JSONSchema.Draft4.Spec as Spec +import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..)) +import qualified JSONSchema.Fetch as FE data HTTPValidationFailure = HVRequest FE.HTTPFailure diff --git a/src/JSONSchema/Draft4/Failure.hs b/src/JSONSchema/Draft4/Failure.hs --- a/src/JSONSchema/Draft4/Failure.hs +++ b/src/JSONSchema/Draft4/Failure.hs @@ -1,9 +1,8 @@ - module JSONSchema.Draft4.Failure where import Import -import JSONSchema.Draft4.Schema (Schema) +import JSONSchema.Draft4.Schema (Schema) import qualified JSONSchema.Validator.Draft4 as VAL -- | Used to report an entire instance being invalidated, as opposed diff --git a/src/JSONSchema/Draft4/Schema.hs b/src/JSONSchema/Draft4/Schema.hs --- a/src/JSONSchema/Draft4/Schema.hs +++ b/src/JSONSchema/Draft4/Schema.hs @@ -1,14 +1,13 @@ - module JSONSchema.Draft4.Schema where -import Import hiding (mapMaybe) +import Import hiding (mapMaybe) -import qualified Data.HashMap.Strict as HM -import Data.List.NonEmpty (NonEmpty) -import Data.Maybe (fromJust, isJust) +import qualified Data.HashMap.Strict as HM +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe (fromJust, isJust) import Data.Scientific -import qualified Data.Set as Set -import qualified Data.Text as T +import qualified Data.Set as Set +import qualified Data.Text as T import qualified JSONSchema.Validator.Draft4 as D4 import JSONSchema.Validator.Utils diff --git a/src/JSONSchema/Draft4/Spec.hs b/src/JSONSchema/Draft4/Spec.hs --- a/src/JSONSchema/Draft4/Spec.hs +++ b/src/JSONSchema/Draft4/Spec.hs @@ -1,22 +1,18 @@ - module JSONSchema.Draft4.Spec where import Import -import Data.Maybe (fromMaybe) -import Data.Profunctor (Profunctor(..)) +import Data.Maybe (fromMaybe) +import Data.Profunctor (Profunctor(..)) import JSONSchema.Draft4.Failure -import JSONSchema.Draft4.Schema (Schema(..), - emptySchema) -import JSONSchema.Fetch (SchemaWithURI(..), - URISchemaMap(..)) -import qualified JSONSchema.Fetch as FE -import JSONSchema.Types (Spec(..)) -import qualified JSONSchema.Types as JT +import JSONSchema.Draft4.Schema (Schema(..), emptySchema) +import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..)) +import qualified JSONSchema.Fetch as FE +import JSONSchema.Types (Spec(..)) +import qualified JSONSchema.Types as JT import JSONSchema.Validator.Draft4 -import JSONSchema.Validator.Reference (BaseURI(..), - Scope(..), +import JSONSchema.Validator.Reference (BaseURI(..), Scope(..), updateResolutionScope) -- | An implementation of 'JT.embedded'. @@ -43,7 +39,7 @@ (_schemaId (_swSchema sw)) } -validateSubschema +validateSubschema :: URISchemaMap Schema -> VisitedSchemas -> Scope Schema diff --git a/src/JSONSchema/Fetch.hs b/src/JSONSchema/Fetch.hs --- a/src/JSONSchema/Fetch.hs +++ b/src/JSONSchema/Fetch.hs @@ -1,18 +1,17 @@ - module JSONSchema.Fetch where import Import -import Control.Exception (IOException, catch) -import Control.Monad (foldM) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import qualified Data.HashMap.Strict as HM -import qualified Data.Text as T -import qualified Network.HTTP.Client as NC +import qualified Control.Exception.Safe as Safe +import Control.Monad (foldM) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T +import qualified Network.HTTP.Client as NC +import qualified Network.HTTP.Client.TLS as NCTLS -import JSONSchema.Validator.Reference (BaseURI(..), - resolveReference, +import JSONSchema.Validator.Reference (BaseURI(..), resolveReference, updateResolutionScope) -------------------------------------------------- @@ -61,9 +60,9 @@ -> SchemaWithURI schema -> IO (Either HTTPFailure (URISchemaMap schema)) referencesViaHTTP' info sw = do - manager <- NC.newManager NC.defaultManagerSettings + manager <- NC.newManager NCTLS.tlsManagerSettings let f = referencesMethodAgnostic (getURL manager) info sw - catch (first HTTPParseFailure <$> f) handler + Safe.catch (first HTTPParseFailure <$> f) handler where getURL :: NC.Manager -> Text -> IO BS.ByteString getURL man url = do @@ -89,7 +88,8 @@ => FetchInfo schema -> SchemaWithURI schema -> IO (Either FilesystemFailure (URISchemaMap schema)) -referencesViaFilesystem' info sw = catch (first FSParseFailure <$> f) handler +referencesViaFilesystem' info sw = + Safe.catch (first FSParseFailure <$> f) handler where f :: IO (Either Text (URISchemaMap schema)) f = referencesMethodAgnostic (BS.readFile . T.unpack) info sw diff --git a/src/JSONSchema/Types.hs b/src/JSONSchema/Types.hs --- a/src/JSONSchema/Types.hs +++ b/src/JSONSchema/Types.hs @@ -1,4 +1,3 @@ - module JSONSchema.Types where import Import diff --git a/src/JSONSchema/Validator/Draft4.hs b/src/JSONSchema/Validator/Draft4.hs --- a/src/JSONSchema/Validator/Draft4.hs +++ b/src/JSONSchema/Validator/Draft4.hs @@ -2,7 +2,6 @@ -- -- This is frankly a lot of busywork. It can perhaps be moved into the -- validator modules themselves once we're sure this is the right design. - module JSONSchema.Validator.Draft4 ( module JSONSchema.Validator.Draft4 , module Export @@ -10,16 +9,16 @@ import Import -import qualified Data.HashMap.Strict as HM -import qualified Data.List.NonEmpty as NE +import qualified Data.HashMap.Strict as HM +import qualified Data.List.NonEmpty as NE -import JSONSchema.Validator.Draft4.Any as Export -import JSONSchema.Validator.Draft4.Array as Export +import JSONSchema.Validator.Draft4.Any as Export +import JSONSchema.Validator.Draft4.Array as Export import JSONSchema.Validator.Draft4.Number as Export import JSONSchema.Validator.Draft4.Object as Export import JSONSchema.Validator.Draft4.String as Export -import JSONSchema.Validator.Reference (BaseURI(..), Scope(..)) -import JSONSchema.Validator.Types (Validator(..)) +import JSONSchema.Validator.Reference (BaseURI(..), Scope(..)) +import JSONSchema.Validator.Types (Validator(..)) -- | For internal use. -- @@ -148,7 +147,7 @@ <> HM.elems (fromMaybe mempty (_propPattern a)) <> case _propAdditional a of Just (AdditionalPropertiesObject b) -> [b] - _ -> mempty + _ -> mempty )) (\a b -> case fromJSONEither b of Left _ -> mempty diff --git a/src/JSONSchema/Validator/Draft4/Any.hs b/src/JSONSchema/Validator/Draft4/Any.hs --- a/src/JSONSchema/Validator/Draft4/Any.hs +++ b/src/JSONSchema/Validator/Draft4/Any.hs @@ -1,25 +1,23 @@ - module JSONSchema.Validator.Draft4.Any where -import Import hiding ((<>)) +import Import hiding ((<>)) -import Data.Aeson.TH (constructorTagModifier) -import Data.Char (toLower) -import Data.List.NonEmpty (NonEmpty((:|))) -import qualified Data.List.NonEmpty as NE -import qualified Data.Scientific as SCI +import Data.Aeson.TH (constructorTagModifier) +import Data.Char (toLower) +import Data.List.NonEmpty (NonEmpty((:|))) +import qualified Data.List.NonEmpty as NE +import qualified Data.Scientific as SCI import Data.Semigroup -import Data.Set (Set) -import qualified Data.Set as Set -import Data.Text.Encoding.Error (UnicodeException) -import qualified JSONPointer as JP -import Network.HTTP.Types.URI (urlDecode) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text.Encoding.Error (UnicodeException) +import qualified JSONPointer as JP +import Network.HTTP.Types.URI (urlDecode) -import qualified JSONSchema.Validator.Utils as UT -import JSONSchema.Validator.Reference (BaseURI(..), - Scope(..), +import JSONSchema.Validator.Reference (BaseURI(..), Scope(..), URIAndFragment, resolveReference) +import qualified JSONSchema.Validator.Utils as UT -------------------------------------------------- -- * $ref diff --git a/src/JSONSchema/Validator/Draft4/Array.hs b/src/JSONSchema/Validator/Draft4/Array.hs --- a/src/JSONSchema/Validator/Draft4/Array.hs +++ b/src/JSONSchema/Validator/Draft4/Array.hs @@ -1,11 +1,10 @@ - module JSONSchema.Validator.Draft4.Array where import Import -import qualified Data.List.NonEmpty as NE -import qualified Data.Vector as V -import qualified JSONPointer as JP +import qualified Data.List.NonEmpty as NE +import qualified Data.Vector as V +import qualified JSONPointer as JP import JSONSchema.Validator.Utils (allUniqueValues) @@ -174,7 +173,8 @@ :: schema -> (JP.Index, Value) -> Maybe (JP.Index, NonEmpty err) - validateElem schema (index,x) = (index,) <$> NE.nonEmpty (f schema x) + validateElem schema (index,x) = + (\v -> (index, v)) <$> NE.nonEmpty (f schema x) -------------------------------------------------- -- * additionalItems @@ -219,6 +219,7 @@ AdditionalItemsBoolInvalid <$> NE.nonEmpty xs additionalItemsVal f (AdditionalObject subSchema) xs = let res = mapMaybe - (\(index,x) -> (index,) <$> NE.nonEmpty (f subSchema x)) + (\(index,x) -> (\v -> (index, v)) + <$> NE.nonEmpty (f subSchema x)) xs in AdditionalItemsObjectInvalid <$> NE.nonEmpty res diff --git a/src/JSONSchema/Validator/Draft4/Number.hs b/src/JSONSchema/Validator/Draft4/Number.hs --- a/src/JSONSchema/Validator/Draft4/Number.hs +++ b/src/JSONSchema/Validator/Draft4/Number.hs @@ -1,9 +1,8 @@ - module JSONSchema.Validator.Draft4.Number where import Import -import Data.Fixed (mod') +import Data.Fixed (mod') import Data.Scientific (Scientific) -------------------------------------------------- diff --git a/src/JSONSchema/Validator/Draft4/Object.hs b/src/JSONSchema/Validator/Draft4/Object.hs --- a/src/JSONSchema/Validator/Draft4/Object.hs +++ b/src/JSONSchema/Validator/Draft4/Object.hs @@ -1,4 +1,3 @@ - module JSONSchema.Validator.Draft4.Object ( module JSONSchema.Validator.Draft4.Object , module JSONSchema.Validator.Draft4.Object.Properties @@ -6,11 +5,11 @@ import Import -import qualified Data.HashMap.Strict as HM -import qualified Data.List.NonEmpty as NE -import Data.Set (Set) -import qualified Data.Set as Set -import qualified Data.Text as T +import qualified Data.HashMap.Strict as HM +import qualified Data.List.NonEmpty as NE +import Data.Set (Set) +import qualified Data.Set as Set +import qualified Data.Text as T import JSONSchema.Validator.Draft4.Object.Properties import JSONSchema.Validator.Utils diff --git a/src/JSONSchema/Validator/Draft4/Object/Properties.hs b/src/JSONSchema/Validator/Draft4/Object/Properties.hs --- a/src/JSONSchema/Validator/Draft4/Object/Properties.hs +++ b/src/JSONSchema/Validator/Draft4/Object/Properties.hs @@ -1,13 +1,12 @@ - module JSONSchema.Validator.Draft4.Object.Properties where import Import -import qualified Data.Hashable as HA -import qualified Data.HashMap.Strict as HM -import qualified Data.List.NonEmpty as NE -import Data.Text.Encoding (encodeUtf8) -import qualified JSONPointer as JP +import qualified Data.Hashable as HA +import qualified Data.HashMap.Strict as HM +import qualified Data.List.NonEmpty as NE +import Data.Text.Encoding (encodeUtf8) +import qualified JSONPointer as JP import qualified Text.Regex.PCRE.Heavy as RE data PropertiesRelated schema = PropertiesRelated diff --git a/src/JSONSchema/Validator/Draft4/String.hs b/src/JSONSchema/Validator/Draft4/String.hs --- a/src/JSONSchema/Validator/Draft4/String.hs +++ b/src/JSONSchema/Validator/Draft4/String.hs @@ -1,10 +1,9 @@ - module JSONSchema.Validator.Draft4.String where import Import -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) import qualified Text.Regex.PCRE.Heavy as RE -------------------------------------------------- diff --git a/src/JSONSchema/Validator/Reference.hs b/src/JSONSchema/Validator/Reference.hs --- a/src/JSONSchema/Validator/Reference.hs +++ b/src/JSONSchema/Validator/Reference.hs @@ -3,15 +3,14 @@ -- -- And is extended for JSON Schema here: -- - module JSONSchema.Validator.Reference where import Import -import qualified Data.Text as T -import System.FilePath ((), dropFileName) +import qualified Data.Text as T +import System.FilePath (dropFileName, ()) -data Scope schema = Scope +data Scope schema = Scope { _topLevelDocument :: schema , _documentURI :: Maybe Text , _currentBaseURI :: BaseURI @@ -25,9 +24,10 @@ type URIAndFragment = (Maybe Text, Maybe Text) updateResolutionScope :: BaseURI -> Maybe Text -> BaseURI -updateResolutionScope base idKeyword - | Just t <- idKeyword = BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t - | otherwise = base +updateResolutionScope base idKeyword = + case idKeyword of + Just t -> BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t + Nothing -> base resolveReference :: BaseURI -> Text -> URIAndFragment resolveReference base t = baseAndFragment (resolveScopeAgainst base t) diff --git a/src/JSONSchema/Validator/Types.hs b/src/JSONSchema/Validator/Types.hs --- a/src/JSONSchema/Validator/Types.hs +++ b/src/JSONSchema/Validator/Types.hs @@ -1,4 +1,3 @@ - module JSONSchema.Validator.Types where import Import diff --git a/src/JSONSchema/Validator/Utils.hs b/src/JSONSchema/Validator/Utils.hs --- a/src/JSONSchema/Validator/Utils.hs +++ b/src/JSONSchema/Validator/Utils.hs @@ -1,16 +1,15 @@ - module JSONSchema.Validator.Utils where import Import -import Control.Monad (fail) +import Control.Monad (fail) import qualified Data.HashMap.Strict as HM -import qualified Data.List.NonEmpty as NE -import Data.Scientific (Scientific, fromFloatDigits) -import Data.Set (Set) -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Vector as V +import qualified Data.List.NonEmpty as NE +import Data.Scientific (Scientific, fromFloatDigits) +import Data.Set (Set) +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector as V -------------------------------------------------- -- * QuickCheck diff --git a/test/Local.hs b/test/Local.hs --- a/test/Local.hs +++ b/test/Local.hs @@ -1,19 +1,18 @@ - module Main where import Protolude import Data.Aeson import qualified Data.List.NonEmpty as NE -import qualified System.Timeout as TO +import qualified System.Timeout as TO import Test.Hspec -import Test.QuickCheck (property) +import Test.QuickCheck (property) -import qualified JSONSchema.Draft4 as D4 -import qualified JSONSchema.Types as JT +import qualified JSONSchema.Draft4 as D4 +import qualified JSONSchema.Types as JT import qualified Local.Failure -import qualified Local.Validation import qualified Local.Reference +import qualified Local.Validation import Shared -- Examples diff --git a/test/Local/Failure.hs b/test/Local/Failure.hs --- a/test/Local/Failure.hs +++ b/test/Local/Failure.hs @@ -1,15 +1,14 @@ - module Local.Failure where import Protolude import Data.Aeson +import qualified Data.Vector as V +import qualified JSONPointer as JP import Test.Hspec -import qualified Data.Vector as V -import qualified JSONPointer as JP import JSONSchema.Draft4 -import qualified JSONSchema.Draft4.Spec as Spec +import qualified JSONSchema.Draft4.Spec as Spec import qualified JSONSchema.Validator.Draft4 as VAL spec :: Spec diff --git a/test/Local/Reference.hs b/test/Local/Reference.hs --- a/test/Local/Reference.hs +++ b/test/Local/Reference.hs @@ -1,4 +1,3 @@ - module Local.Reference where import Protolude diff --git a/test/Local/Validation.hs b/test/Local/Validation.hs --- a/test/Local/Validation.hs +++ b/test/Local/Validation.hs @@ -1,17 +1,16 @@ - module Local.Validation where import Protolude import Data.Aeson -import qualified Data.Aeson as AE +import qualified Data.Aeson as AE import qualified Data.HashMap.Strict as HM -import Data.String (String) +import Data.String (String) import Test.Hspec +import qualified AlternateSchema as AS import JSONSchema.Draft4 -import qualified JSONSchema.Types as JT -import qualified AlternateSchema as AS +import qualified JSONSchema.Types as JT spec :: Spec spec = do diff --git a/test/Remote.hs b/test/Remote.hs --- a/test/Remote.hs +++ b/test/Remote.hs @@ -1,17 +1,16 @@ - module Main where import Protolude -import Control.Concurrent.Async (withAsync) -import qualified Data.List.NonEmpty as NE +import Control.Concurrent.Async (withAsync) +import qualified Data.List.NonEmpty as NE import Network.Wai.Application.Static (defaultFileServerSettings, staticApp) -import Network.Wai.Handler.Warp (run) +import qualified Network.Wai.Handler.Warp as Warp import Test.Hspec -import qualified JSONSchema.Draft4 as D4 -import qualified JSONSchema.Types as JT +import qualified JSONSchema.Draft4 as D4 +import qualified JSONSchema.Types as JT import Shared -- Examples @@ -52,7 +51,7 @@ assertResult sc failures serve :: IO () -serve = run 1234 +serve = Warp.run 1234 . staticApp . defaultFileServerSettings $ "JSON-Schema-Test-Suite/remotes" diff --git a/test/Shared.hs b/test/Shared.hs --- a/test/Shared.hs +++ b/test/Shared.hs @@ -1,17 +1,16 @@ - module Shared where import Protolude -import Control.Monad (fail) +import Control.Monad (fail) import Data.Aeson -import Data.Aeson.TH (fieldLabelModifier) -import qualified Data.ByteString as BS -import Data.Char (toLower) -import Data.List (stripPrefix, unlines) -import qualified Data.Text as T +import Data.Aeson.TH (fieldLabelModifier) +import qualified Data.ByteString as BS +import Data.Char (toLower) +import Data.List (stripPrefix, unlines) +import qualified Data.Text as T import qualified System.Directory as SD -import System.FilePath (()) +import System.FilePath (()) import Test.Hspec skipTest :: FilePath -> Bool