hjsonschema 1.1.0.1 → 1.2.0.0

raw patch · 7 files changed

+73/−40 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.txt +6/−0
• examples/AlternateSchema.hs +2/−2
• hjsonschema.cabal +1/−2
• src/Data/JsonSchema/Draft4/Failure.hs +8/−3
• src/Data/JsonSchema/Draft4/Spec.hs +22/−15
• src/Data/Validator/Draft4.hs +5/−6
• src/Data/Validator/Draft4/Any.hs +29/−12

@@ -1,3 +1,9 @@+# 1.2.0.0+++ Return `AdditionalPropertiesObject` error correctly (was mistakenly+returning `AdditionalItemsObject` instead.++ Don't silence errors resulting from subschemas of "anyOf" or "oneOf".+ # 1.1.0.1  + Bump `aeson` and `hjsonpointer`.

@@ -138,8 +138,8 @@         , dimap f (const Enum) D4.enumVal         , dimap f (const TypeValidator) D4.typeVal         , dimap f AllOf (D4.allOf lateral)-        , dimap f (const AnyOf) (D4.anyOf lateral)-        , dimap f (const OneOf) (D4.oneOf lateral)+        , dimap f AnyOf (D4.anyOf lateral)+        , dimap f oneOfE (D4.oneOf lateral)         , dimap f (const NotValidator) (D4.notVal lateral)         ]   where

@@ -1,5 +1,5 @@ name:               hjsonschema-version:            1.1.0.1+version:            1.2.0.0 synopsis:           JSON Schema library homepage:           https://github.com/seagreen/hjsonschema license:            MIT@@ -9,7 +9,6 @@ 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

@@ -71,8 +71,9 @@     | Enum     | TypeValidator     | AllOf ValidatorChain-    | AnyOf-    | OneOf+    | AnyOf ValidatorChain+    | OneOfTooManySuccesses+    | OneOfNoSuccesses ValidatorChain     | NotValidator     deriving (Eq, Show) @@ -110,9 +111,13 @@  addPropE :: OB.AdditionalPropertiesInvalid ValidatorChain -> ValidatorChain addPropE OB.APBoolInvalid         = AdditionalPropertiesBool-addPropE (OB.APObjectInvalid err) = AdditionalItemsObject err+addPropE (OB.APObjectInvalid err) = AdditionalPropertiesObject err  refE :: AN.RefInvalid ValidatorChain -> ValidatorChain refE AN.RefResolution    = RefResolution refE AN.RefLoop          = RefLoop refE (AN.RefInvalid err) = Ref err++oneOfE :: AN.OneOfInvalid ValidatorChain -> ValidatorChain+oneOfE AN.TooManySuccesses  = OneOfTooManySuccesses+oneOfE (AN.NoSuccesses err) = OneOfNoSuccesses err

@@ -22,6 +22,13 @@ embedded :: Schema -> ([Schema], [Schema]) embedded s = JT.embedded (d4Spec (ReferencedSchemas s mempty) mempty Nothing) s +-- | For internal use.+--+-- A specialized version of 'const' that prevents overwriting+-- useful information.+toss :: a -> () -> a+toss = const+ validate     :: ReferencedSchemas Schema     -> SchemaWithURI Schema@@ -52,7 +59,7 @@ d4Spec referenced visited scope = Spec     [ dimap         (fmap D4.MultipleOf . _schemaMultipleOf)-        (const MultipleOf)+        (toss MultipleOf)         D4.multipleOf     , dimap         (\s -> D4.MaximumContext (fromMaybe False (_schemaExclusiveMaximum s))@@ -65,13 +72,13 @@         minE         D4.minimumVal -    , dimap (fmap D4.MaxLength . _schemaMaxLength) (const MaxLength) D4.maxLength-    , dimap (fmap D4.MinLength . _schemaMinLength) (const MinLength) D4.minLength-    , dimap (fmap D4.PatternVal . _schemaPattern) (const PatternValidator) D4.patternVal+    , dimap (fmap D4.MaxLength . _schemaMaxLength) (toss MaxLength) D4.maxLength+    , dimap (fmap D4.MinLength . _schemaMinLength) (toss MinLength) D4.minLength+    , dimap (fmap D4.PatternVal . _schemaPattern) (toss PatternValidator) D4.patternVal -    , dimap (fmap D4.MaxItems . _schemaMaxItems) (const MaxItems) D4.maxItems-    , dimap (fmap D4.MinItems . _schemaMinItems) (const MinItems) D4.minItems-    , dimap (fmap D4.UniqueItems . _schemaUniqueItems) (const UniqueItems) D4.uniqueItems+    , dimap (fmap D4.MaxItems . _schemaMaxItems) (toss MaxItems) D4.maxItems+    , dimap (fmap D4.MinItems . _schemaMinItems) (toss MinItems) D4.minItems+    , dimap (fmap D4.UniqueItems . _schemaUniqueItems) (toss UniqueItems) D4.uniqueItems     , dimap         (\s -> D4.ItemsContext (_schemaAdditionalItems s) <$> _schemaItems s)         itemsE@@ -79,9 +86,9 @@     , lmap (fmap D4.AdditionalItemsContext . _schemaAdditionalItems) D4.additionalItemsEmbedded     , lmap (fmap D4.Definitions . _schemaDefinitions) D4.definitionsEmbedded -    , dimap (fmap D4.MaxProperties . _schemaMaxProperties) (const MaxProperties) D4.maxProperties-    , dimap (fmap D4.MinProperties . _schemaMinProperties) (const MinProperties) D4.minProperties-    , dimap (fmap D4.RequiredContext . _schemaRequired) (const Required) D4.required+    , dimap (fmap D4.MaxProperties . _schemaMaxProperties) (toss MaxProperties) D4.maxProperties+    , dimap (fmap D4.MinProperties . _schemaMinProperties) (toss MinProperties) D4.minProperties+    , dimap (fmap D4.RequiredContext . _schemaRequired) (toss Required) D4.required     , dimap (fmap D4.DependenciesContext . _schemaDependencies) depsE (D4.dependencies descend)     , dimap         (\s -> D4.PropertiesContext@@ -109,12 +116,12 @@         (\s -> D4.Ref <$> _schemaRef s)         refE         (D4.ref visited scope (FE.getReference referenced) refVal)-    , dimap (fmap D4.EnumContext . _schemaEnum) (const Enum) D4.enumVal-    , dimap (fmap D4.TypeContext . _schemaType) (const TypeValidator) D4.typeVal+    , dimap (fmap D4.EnumContext . _schemaEnum) (toss Enum) D4.enumVal+    , dimap (fmap D4.TypeContext . _schemaType) (toss TypeValidator) D4.typeVal     , dimap (fmap D4.AllOf . _schemaAllOf) AllOf (D4.allOf lateral)-    , dimap (fmap D4.AnyOf . _schemaAnyOf) (const AnyOf) (D4.anyOf lateral)-    , dimap (fmap D4.OneOf . _schemaOneOf) (const OneOf) (D4.oneOf lateral)-    , dimap (fmap D4.NotVal . _schemaNot) (const NotValidator) (D4.notVal lateral)+    , dimap (fmap D4.AnyOf . _schemaAnyOf) AnyOf (D4.anyOf lateral)+    , dimap (fmap D4.OneOf . _schemaOneOf) oneOfE (D4.oneOf lateral)+    , dimap (fmap D4.NotVal . _schemaNot) (toss NotValidator) (D4.notVal lateral)     ]   where     refVal :: AN.VisitedSchemas -> Maybe Text -> Schema -> Value -> [Failure]

@@ -502,15 +502,14 @@         AnyOf <$> o .: "anyOf"  anyOf-    :: ToJSON schema-    => (schema -> Value -> [Fail err])-    -> Validator schema (Maybe (AnyOf schema)) ()+    :: (schema -> Value -> [Fail err])+    -> Validator schema (Maybe (AnyOf schema)) err anyOf f =     Validator         (\a -> case a of                  Just (AnyOf b) -> (NE.toList b, mempty)                  Nothing        -> (mempty, mempty))-        (run (fmap maybeToList . AN.anyOf f . _unAnyOf))+        (run (AN.anyOf f . _unAnyOf))  newtype OneOf schema     = OneOf { _unOneOf :: NonEmpty schema }@@ -523,13 +522,13 @@ oneOf     :: ToJSON schema     => (schema -> Value -> [Fail err])-    -> Validator schema (Maybe (OneOf schema)) ()+    -> Validator schema (Maybe (OneOf schema)) (AN.OneOfInvalid err) oneOf f =     Validator         (\a -> case a of                    Just (OneOf b) -> (NE.toList b, mempty)                    Nothing        -> (mempty, mempty))-        (run (fmap maybeToList . AN.oneOf f . _unOneOf))+        (run (AN.oneOf f . _unOneOf))  newtype NotVal schema     = NotVal { _unNotVal :: schema }

@@ -4,10 +4,11 @@  import           Import -- Hiding is for GHCs before 7.10:-import           Prelude hiding           (any, elem)+import           Prelude hiding           (any, concat, elem)  import           Control.Monad import           Data.Aeson.Types         (Parser)+import           Data.List                (partition) import           Data.List.NonEmpty       (NonEmpty) import qualified Data.List.NonEmpty       as NE import           Data.Maybe@@ -176,32 +177,48 @@ --------------------------------------------------  anyOf-    :: ToJSON schema-    => (schema -> Value -> [Fail err])+    :: forall err schema.+       (schema -> Value -> [Fail err])     -> NonEmpty schema     -> Value-    -> Maybe (Fail ())+    -> [Fail err] anyOf f subSchemas x-    | any null (flip f x <$> subSchemas) = Nothing-    | otherwise = Just $ Failure () (toJSON (UT.NonEmpty' subSchemas))-                                 mempty x+    | any null results = mempty+    | otherwise        = concat results+  where+    results :: [[Fail err]]+    results = flip f x <$> NE.toList subSchemas  -------------------------------------------------- -- * oneOf -------------------------------------------------- +data OneOfInvalid err+    = TooManySuccesses+    | NoSuccesses err+    deriving (Eq, Show)+ oneOf     :: forall err schema. ToJSON schema     => (schema -> Value -> [Fail err])     -> NonEmpty schema     -> Value-    -> Maybe (Fail ())+    -> [Fail (OneOfInvalid err)] oneOf f subSchemas x-    | length successes == 1 = Nothing-    | otherwise = Just $ Failure () (toJSON (UT.NonEmpty' subSchemas)) mempty x+    | length successes == 1 = mempty+    | length successes > 1  = pure tooManySuccesses+    | otherwise             = fmap NoSuccesses <$> concat failures   where-    successes :: [[Fail err]]-    successes = filter null $ flip f x <$> NE.toList subSchemas+    (successes, failures) = partition null results++    results :: [[Fail err]]+    results = flip f x <$> NE.toList subSchemas++    -- NOTE: This could also return information about the specific+    -- validators that succeeded.+    tooManySuccesses :: Fail (OneOfInvalid err)+    tooManySuccesses = Failure TooManySuccesses+                               (toJSON (UT.NonEmpty' subSchemas)) mempty x  -------------------------------------------------- -- * not