diff --git a/changelog.txt b/changelog.txt --- a/changelog.txt +++ b/changelog.txt @@ -1,3 +1,8 @@ +# 1.1.0.0 + ++ Rename `schemaForSchemas` to `metaSchema` and `schemaForSchemasBytes` to +`metaSchemaBytes`. + # 1.0.0.0 ## Bug fixes: diff --git a/examples/AlternateSchema.hs b/examples/AlternateSchema.hs --- a/examples/AlternateSchema.hs +++ b/examples/AlternateSchema.hs @@ -23,7 +23,7 @@ import Data.Profunctor (Profunctor (..)) import Data.Text (Text) -import Data.JsonSchema.Draft4 (schemaForSchemasBytes) +import Data.JsonSchema.Draft4 (metaSchemaBytes) import Data.JsonSchema.Draft4.Failure import Data.JsonSchema.Fetch (ReferencedSchemas(..), SchemaWithURI(..)) @@ -68,21 +68,21 @@ -- A schema for schemas themselves, using @src/draft4.json@ which is loaded -- at compile time. -schemaForSchemas :: Schema -schemaForSchemas = +metaSchema :: Schema +metaSchema = fromMaybe (error "Schema decode failed (this should never happen)") . decode . LBS.fromStrict - $ schemaForSchemasBytes + $ metaSchemaBytes checkSchema :: Schema -> [Failure] -checkSchema = validate referenced Nothing schemaForSchemas . Object . _unSchema +checkSchema = validate referenced Nothing metaSchema . Object . _unSchema where referenced :: ReferencedSchemas Schema referenced = ReferencedSchemas - schemaForSchemas + metaSchema (HM.singleton "http://json-schema.org/draft-04/schema" - schemaForSchemas) + metaSchema) -------------------------------------------------- -- * Spec diff --git a/hjsonschema.cabal b/hjsonschema.cabal --- a/hjsonschema.cabal +++ b/hjsonschema.cabal @@ -1,145 +1,162 @@ -name: hjsonschema -version: 1.0.0.0 -synopsis: JSON Schema library -homepage: https://github.com/seagreen/hjsonschema -license: MIT -license-file: MIT-LICENSE.txt -author: Ian Grant Jeffries -maintainer: ian@housejeffries.com -category: Data -build-type: Simple -cabal-version: >=1.10 -tested-with: GHC == 7.8.4, GHC == 7.10.2 -extra-source-files: changelog.txt - JSON-Schema-Test-Suite/remotes/*.json - JSON-Schema-Test-Suite/remotes/folder/*.json - JSON-Schema-Test-Suite/tests/draft4/*.json - JSON-Schema-Test-Suite/tests/draft4/optional/*.json - README.md - src/draft4.json - test/Local/*.json - test/supplement/*.json - examples/json/*.json +name: hjsonschema +version: 1.1.0.0 +synopsis: JSON Schema library +homepage: https://github.com/seagreen/hjsonschema +license: MIT +license-file: MIT-LICENSE.txt +author: Ian Grant Jeffries +maintainer: ian@housejeffries.com +category: Data +build-type: Simple +cabal-version: >=1.10 +tested-with: GHC == 7.8.4, GHC == 7.10.2 +extra-source-files: + changelog.txt + JSON-Schema-Test-Suite/remotes/*.json + JSON-Schema-Test-Suite/remotes/folder/*.json + JSON-Schema-Test-Suite/tests/draft4/*.json + JSON-Schema-Test-Suite/tests/draft4/optional/*.json + README.md + src/draft4.json + test/Local/*.json + test/supplement/*.json + examples/json/*.json library - hs-source-dirs: src - exposed-modules: Data.JsonSchema.Draft4 - , Data.JsonSchema.Draft4.Failure - , Data.JsonSchema.Draft4.Schema - , Data.JsonSchema.Draft4.Spec - , Data.JsonSchema.Fetch - , Data.JsonSchema.Types - , Data.Validator.Draft4 - , Data.Validator.Draft4.Any - , Data.Validator.Draft4.Array - , Data.Validator.Draft4.Number - , Data.Validator.Draft4.Object - , Data.Validator.Draft4.String - , Data.Validator.Failure - , Data.Validator.Reference - , Data.Validator.Types - , Data.Validator.Utils - - other-modules: Data.Validator.Draft4.Object.Properties - , Import - default-language: Haskell2010 - default-extensions: NoImplicitPrelude - OverloadedStrings - ScopedTypeVariables + hs-source-dirs: + src + default-language: Haskell2010 + default-extensions: + NoImplicitPrelude + OverloadedStrings + ScopedTypeVariables if impl(ghc >= 8) default-extensions: StrictData - other-extensions: DeriveFunctor - GeneralizedNewtypeDeriving - TemplateHaskell - ghc-options: -Wall - build-depends: aeson >= 0.7 && < 0.12 - , base >= 4.7 && < 4.10 - , bytestring >= 0.10 && < 0.11 - , containers >= 0.5 && < 0.6 - , file-embed >= 0.0.8 && < 0.1 - , filepath >= 1.3 && < 1.5 - , hjsonpointer >= 0.3 && < 0.4 - -- 0.4.30 is for parseUrlThrow: - , http-client >= 0.4.30 && < 0.6 - , http-types >= 0.8 && < 0.10 - , pcre-heavy >= 1.0 && < 1.1 - , profunctors >= 5.0 && < 5.3 - , QuickCheck >= 2.8 && < 2.10 - , scientific >= 0.3 && < 0.4 - , semigroups >= 0.18 && < 0.19 - , unordered-containers >= 0.2 && < 0.3 - , text >= 1.1 && < 1.3 - , vector >= 0.10 && < 0.12 + other-extensions: + DeriveFunctor + GeneralizedNewtypeDeriving + TemplateHaskell + ghc-options: + -Wall + exposed-modules: + Data.JsonSchema.Draft4 + , Data.JsonSchema.Draft4.Failure + , Data.JsonSchema.Draft4.Schema + , Data.JsonSchema.Draft4.Spec + , Data.JsonSchema.Fetch + , Data.JsonSchema.Types + , Data.Validator.Draft4 + , Data.Validator.Draft4.Any + , Data.Validator.Draft4.Array + , Data.Validator.Draft4.Number + , Data.Validator.Draft4.Object + , Data.Validator.Draft4.String + , Data.Validator.Failure + , Data.Validator.Reference + , Data.Validator.Types + , Data.Validator.Utils + other-modules: + Data.Validator.Draft4.Object.Properties + , Import + build-depends: + aeson >= 0.11 && < 0.12 + , base >= 4.7 && < 4.10 + , bytestring >= 0.10 && < 0.11 + , containers >= 0.5 && < 0.6 + , file-embed >= 0.0.8 && < 0.1 + , filepath >= 1.3 && < 1.5 + , hjsonpointer >= 0.3 && < 0.4 + -- 0.4.30 is for parseUrlThrow: + , http-client >= 0.4.30 && < 0.6 + , http-types >= 0.8 && < 0.10 + , pcre-heavy >= 1.0 && < 1.1 + , profunctors >= 5.0 && < 5.3 + , QuickCheck >= 2.8 && < 2.10 + , scientific >= 0.3 && < 0.4 + , semigroups >= 0.18 && < 0.19 + , unordered-containers >= 0.2 && < 0.3 + , text >= 1.1 && < 1.3 + , vector >= 0.10 && < 0.12 test-suite local - type: exitcode-stdio-1.0 - hs-source-dirs: test - examples - main-is: Local.hs - other-modules: Local.Failure - , Local.Reference - , Local.Validation - , Shared - -- from ./examples: - , AlternateSchema - , Full - , Simple - default-language: Haskell2010 - ghc-options: -Wall - -fno-warn-orphans - default-extensions: OverloadedStrings - ScopedTypeVariables - build-depends: aeson - , base - , bytestring - , filepath - , hjsonpointer - , hjsonschema - , profunctors - , semigroups - , text - , QuickCheck - , unordered-containers - , vector - -- directory-1.2.5 required for `listDirectory`: - , directory >= 1.2.5 && < 1.3 - , HUnit >= 1.2 && < 1.4 - , tasty >= 0.11 && < 0.12 - , tasty-hunit >= 0.9 && < 0.10 - , tasty-quickcheck >= 0.8 && < 0.9 + hs-source-dirs: + test + examples + default-language: Haskell2010 + ghc-options: + -Wall + -fno-warn-orphans + default-extensions: + OverloadedStrings + ScopedTypeVariables + type: exitcode-stdio-1.0 + main-is: Local.hs + other-modules: + Local.Failure + , Local.Reference + , Local.Validation + , Shared + -- from ./examples: + , AlternateSchema + , Full + , Simple + build-depends: + aeson + , base + , bytestring + , filepath + , hjsonpointer + , hjsonschema + , profunctors + , semigroups + , text + , QuickCheck + , unordered-containers + , vector + -- directory-1.2.5 required for `listDirectory`: + , directory >= 1.2.5 && < 1.3 + , HUnit >= 1.2 && < 1.4 + , tasty >= 0.11 && < 0.12 + , tasty-hunit >= 0.9 && < 0.10 + , tasty-quickcheck >= 0.8 && < 0.9 test-suite remote - type: exitcode-stdio-1.0 - hs-source-dirs: test - examples - main-is: Remote.hs - other-modules: Shared - -- from ./examples: - , AlternateSchema - default-language: Haskell2010 - ghc-options: -Wall - -fno-warn-orphans - default-extensions: OverloadedStrings - ScopedTypeVariables - build-depends: aeson - , async - , base - , bytestring - , filepath - , hjsonpointer - , hjsonschema - , profunctors - , semigroups - , text - , unordered-containers - , vector - , directory - , HUnit - , tasty - , tasty-hunit - , wai-app-static - , warp + hs-source-dirs: + test + examples + default-language: Haskell2010 + ghc-options: + -Wall + -fno-warn-orphans + default-extensions: + OverloadedStrings + ScopedTypeVariables + type: exitcode-stdio-1.0 + main-is: Remote.hs + other-modules: + Shared + -- from ./examples: + , AlternateSchema + build-depends: + aeson + , async + , base + , bytestring + , filepath + , hjsonpointer + , hjsonschema + , profunctors + , semigroups + , text + , unordered-containers + , vector + , directory + , HUnit + , tasty + , tasty-hunit + , wai-app-static + , warp source-repository head - type: git - location: git://github.com/seagreen/hjsonschema.git + type: git + location: git://github.com/seagreen/hjsonschema.git diff --git a/src/Data/JsonSchema/Draft4.hs b/src/Data/JsonSchema/Draft4.hs --- a/src/Data/JsonSchema/Draft4.hs +++ b/src/Data/JsonSchema/Draft4.hs @@ -29,8 +29,8 @@ , referencesViaFilesystem -- * Other Draft 4 things exported just in case - , schemaForSchemas - , schemaForSchemasBytes + , metaSchema + , metaSchemaBytes , schemaValidity , referencesValidity , checkSchema @@ -42,7 +42,6 @@ import Control.Arrow (first, left) import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS import Data.FileEmbed (embedFile, makeRelativeToProject) import qualified Data.HashMap.Strict as HM @@ -147,28 +146,27 @@ failures = ((\v -> (Nothing, v)) <$> schemaValidity (_swSchema sw)) <> (first Just <$> referencesValidity sm) -schemaForSchemas :: Schema -schemaForSchemas = +metaSchema :: Schema +metaSchema = fromMaybe (error "Schema decode failed (this should never happen)") - . decode - . LBS.fromStrict - $ schemaForSchemasBytes + . decodeStrict + $ metaSchemaBytes -schemaForSchemasBytes :: BS.ByteString -schemaForSchemasBytes = +metaSchemaBytes :: BS.ByteString +metaSchemaBytes = $(makeRelativeToProject "src/draft4.json" >>= embedFile) -- | Check that a schema itself is valid -- (if so the returned list will be empty). schemaValidity :: Schema -> [Failure] schemaValidity = - Spec.validate referenced (SchemaWithURI schemaForSchemas Nothing) . toJSON + Spec.validate referenced (SchemaWithURI metaSchema Nothing) . toJSON where referenced :: ReferencedSchemas Schema referenced = ReferencedSchemas - schemaForSchemas + metaSchema (HM.singleton "http://json-schema.org/draft-04/schema" - schemaForSchemas) + metaSchema) -- | Check that a set of referenced schemas are valid -- (if so the returned list will be empty). diff --git a/src/Data/Validator/Draft4/Any.hs b/src/Data/Validator/Draft4/Any.hs --- a/src/Data/Validator/Draft4/Any.hs +++ b/src/Data/Validator/Draft4/Any.hs @@ -96,9 +96,9 @@ instance Arbitrary EnumVal where arbitrary = do - xs <- traverse (const UT.arbitraryValue) =<< (arbitrary :: Gen [()]) + xs <- (fmap.fmap) UT._unArbitraryValue arbitrary case NE.nonEmpty (toUnique xs) of - Nothing -> EnumVal . pure <$> UT.arbitraryValue + Nothing -> EnumVal . pure . UT._unArbitraryValue <$> arbitrary Just ne -> pure (EnumVal ne) where toUnique :: [Value] -> [Value] diff --git a/src/Data/Validator/Utils.hs b/src/Data/Validator/Utils.hs --- a/src/Data/Validator/Utils.hs +++ b/src/Data/Validator/Utils.hs @@ -29,28 +29,32 @@ . getPositive <$> arbitrary -arbitraryValue :: Gen Value -arbitraryValue = sized f - where - f :: Int -> Gen Value - f n | n <= 1 = oneof nonRecursive - | otherwise = oneof $ - fmap (Array . V.fromList) (traverse (const (f (n `div` 10))) - =<< (arbitrary :: Gen [()])) - : fmap (Object . HM.fromList) (traverse (const (g (n `div` 10))) - =<< (arbitrary :: Gen [()])) - : nonRecursive +newtype ArbitraryValue + = ArbitraryValue { _unArbitraryValue :: Value } + deriving (Eq, Show) - g :: Int -> Gen (Text, Value) - g n = (,) <$> arbitraryText <*> f n +instance Arbitrary ArbitraryValue where + arbitrary = ArbitraryValue <$> sized f + where + f :: Int -> Gen Value + f n | n <= 1 = oneof nonRecursive + | otherwise = oneof $ + fmap (Array . V.fromList) (traverse (const (f (n `div` 10))) + =<< (arbitrary :: Gen [()])) + : fmap (Object . HM.fromList) (traverse (const (g (n `div` 10))) + =<< (arbitrary :: Gen [()])) + : nonRecursive - nonRecursive :: [Gen Value] - nonRecursive = - [ pure Null - , Bool <$> arbitrary - , String <$> arbitraryText - , Number <$> arbitraryScientific - ] + g :: Int -> Gen (Text, Value) + g n = (,) <$> arbitraryText <*> f n + + nonRecursive :: [Gen Value] + nonRecursive = + [ pure Null + , Bool <$> arbitrary + , String <$> arbitraryText + , Number <$> arbitraryScientific + ] arbitraryHashMap :: Arbitrary a => Gen (HashMap Text a) arbitraryHashMap = HM.fromList . fmap (first T.pack) <$> arbitrary