git.iko.soy/typeable/hjsonschema
on master help sign in
1.2.0.0.

+ Return `AdditionalPropertiesObject` error correctly (was mistakenly returning `AdditionalItemsObject` instead. + Don't silence errors resulting from subschemas of "anyOf" or "oneOf".

commit528f5dac25e7579a6467512ad3d53bd6986fd7f4 authorIan Grant Jeffries <ian@housejeffries.com> dateTue 4 Oct 2016, 09:40 (10 years ago) parenta7b2a63
7 files changed+73−40
compare with master
unifiedsplit
changelog.txt+6 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
changelog.txt+6
@@ -1,3 +1,9 @@
1+# 1.2.0.0
2+
3++ Return `AdditionalPropertiesObject` error correctly (was mistakenly
4+returning `AdditionalItemsObject` instead.
5++ Don't silence errors resulting from subschemas of "anyOf" or "oneOf".
6+
17# 1.1.0.1
28
39+ Bump `aeson` and `hjsonpointer`.
examples/AlternateSchema.hs+2−2
@@ -138,8 +138,8 @@ d4Spec referenced visited scope =
138138 , dimap f (const Enum) D4.enumVal
139139 , dimap f (const TypeValidator) D4.typeVal
140140 , dimap f AllOf (D4.allOf lateral)
141− , dimap f (const AnyOf) (D4.anyOf lateral)
142− , dimap f (const OneOf) (D4.oneOf lateral)
141+ , dimap f AnyOf (D4.anyOf lateral)
142+ , dimap f oneOfE (D4.oneOf lateral)
143143 , dimap f (const NotValidator) (D4.notVal lateral)
144144 ]
145145 where
hjsonschema.cabal+1−2
@@ -1,5 +1,5 @@
11name: hjsonschema
2−version: 1.1.0.1
2+version: 1.2.0.0
33synopsis: JSON Schema library
44homepage: https://github.com/seagreen/hjsonschema
55license: MIT
@@ -9,7 +9,6 @@ maintainer: ian@housejeffries.com
99category: Data
1010build-type: Simple
1111cabal-version: >=1.10
12−tested-with: GHC == 7.8.4, GHC == 7.10.2
1312extra-source-files:
1413 changelog.txt
1514 JSON-Schema-Test-Suite/remotes/*.json
src/Data/JsonSchema/Draft4/Failure.hs+8−3
@@ -71,8 +71,9 @@ data ValidatorChain
7171 | Enum
7272 | TypeValidator
7373 | AllOf ValidatorChain
74− | AnyOf
75− | OneOf
74+ | AnyOf ValidatorChain
75+ | OneOfTooManySuccesses
76+ | OneOfNoSuccesses ValidatorChain
7677 | NotValidator
7778 deriving (Eq, Show)
7879
@@ -110,9 +111,13 @@ patPropE (OB.PPAdditionalPropertiesInvalid a) =
110111
111112addPropE :: OB.AdditionalPropertiesInvalid ValidatorChain -> ValidatorChain
112113addPropE OB.APBoolInvalid = AdditionalPropertiesBool
113−addPropE (OB.APObjectInvalid err) = AdditionalItemsObject err
114+addPropE (OB.APObjectInvalid err) = AdditionalPropertiesObject err
114115
115116refE :: AN.RefInvalid ValidatorChain -> ValidatorChain
116117refE AN.RefResolution = RefResolution
117118refE AN.RefLoop = RefLoop
118119refE (AN.RefInvalid err) = Ref err
120+
121+oneOfE :: AN.OneOfInvalid ValidatorChain -> ValidatorChain
122+oneOfE AN.TooManySuccesses = OneOfTooManySuccesses
123+oneOfE (AN.NoSuccesses err) = OneOfNoSuccesses err
src/Data/JsonSchema/Draft4/Spec.hs+22−15
@@ -22,6 +22,13 @@ import Data.Validator.Reference (updateResolutionScope)
2222embedded :: Schema -> ([Schema], [Schema])
2323embedded s = JT.embedded (d4Spec (ReferencedSchemas s mempty) mempty Nothing) s
2424
25+-- | For internal use.
26+--
27+-- A specialized version of 'const' that prevents overwriting
28+-- useful information.
29+toss :: a -> () -> a
30+toss = const
31+
2532validate
2633 :: ReferencedSchemas Schema
2734 -> SchemaWithURI Schema
@@ -52,7 +59,7 @@ d4Spec
5259d4Spec referenced visited scope = Spec
5360 [ dimap
5461 (fmap D4.MultipleOf . _schemaMultipleOf)
55− (const MultipleOf)
62+ (toss MultipleOf)
5663 D4.multipleOf
5764 , dimap
5865 (\s -> D4.MaximumContext (fromMaybe False (_schemaExclusiveMaximum s))
@@ -65,13 +72,13 @@ d4Spec referenced visited scope = Spec
6572 minE
6673 D4.minimumVal
6774
68− , dimap (fmap D4.MaxLength . _schemaMaxLength) (const MaxLength) D4.maxLength
69− , dimap (fmap D4.MinLength . _schemaMinLength) (const MinLength) D4.minLength
70− , dimap (fmap D4.PatternVal . _schemaPattern) (const PatternValidator) D4.patternVal
75+ , dimap (fmap D4.MaxLength . _schemaMaxLength) (toss MaxLength) D4.maxLength
76+ , dimap (fmap D4.MinLength . _schemaMinLength) (toss MinLength) D4.minLength
77+ , dimap (fmap D4.PatternVal . _schemaPattern) (toss PatternValidator) D4.patternVal
7178
72− , dimap (fmap D4.MaxItems . _schemaMaxItems) (const MaxItems) D4.maxItems
73− , dimap (fmap D4.MinItems . _schemaMinItems) (const MinItems) D4.minItems
74− , dimap (fmap D4.UniqueItems . _schemaUniqueItems) (const UniqueItems) D4.uniqueItems
79+ , dimap (fmap D4.MaxItems . _schemaMaxItems) (toss MaxItems) D4.maxItems
80+ , dimap (fmap D4.MinItems . _schemaMinItems) (toss MinItems) D4.minItems
81+ , dimap (fmap D4.UniqueItems . _schemaUniqueItems) (toss UniqueItems) D4.uniqueItems
7582 , dimap
7683 (\s -> D4.ItemsContext (_schemaAdditionalItems s) <$> _schemaItems s)
7784 itemsE
@@ -79,9 +86,9 @@ d4Spec referenced visited scope = Spec
7986 , lmap (fmap D4.AdditionalItemsContext . _schemaAdditionalItems) D4.additionalItemsEmbedded
8087 , lmap (fmap D4.Definitions . _schemaDefinitions) D4.definitionsEmbedded
8188
82− , dimap (fmap D4.MaxProperties . _schemaMaxProperties) (const MaxProperties) D4.maxProperties
83− , dimap (fmap D4.MinProperties . _schemaMinProperties) (const MinProperties) D4.minProperties
84− , dimap (fmap D4.RequiredContext . _schemaRequired) (const Required) D4.required
89+ , dimap (fmap D4.MaxProperties . _schemaMaxProperties) (toss MaxProperties) D4.maxProperties
90+ , dimap (fmap D4.MinProperties . _schemaMinProperties) (toss MinProperties) D4.minProperties
91+ , dimap (fmap D4.RequiredContext . _schemaRequired) (toss Required) D4.required
8592 , dimap (fmap D4.DependenciesContext . _schemaDependencies) depsE (D4.dependencies descend)
8693 , dimap
8794 (\s -> D4.PropertiesContext
@@ -109,12 +116,12 @@ d4Spec referenced visited scope = Spec
109116 (\s -> D4.Ref <$> _schemaRef s)
110117 refE
111118 (D4.ref visited scope (FE.getReference referenced) refVal)
112− , dimap (fmap D4.EnumContext . _schemaEnum) (const Enum) D4.enumVal
113− , dimap (fmap D4.TypeContext . _schemaType) (const TypeValidator) D4.typeVal
119+ , dimap (fmap D4.EnumContext . _schemaEnum) (toss Enum) D4.enumVal
120+ , dimap (fmap D4.TypeContext . _schemaType) (toss TypeValidator) D4.typeVal
114121 , dimap (fmap D4.AllOf . _schemaAllOf) AllOf (D4.allOf lateral)
115− , dimap (fmap D4.AnyOf . _schemaAnyOf) (const AnyOf) (D4.anyOf lateral)
116− , dimap (fmap D4.OneOf . _schemaOneOf) (const OneOf) (D4.oneOf lateral)
117− , dimap (fmap D4.NotVal . _schemaNot) (const NotValidator) (D4.notVal lateral)
122+ , dimap (fmap D4.AnyOf . _schemaAnyOf) AnyOf (D4.anyOf lateral)
123+ , dimap (fmap D4.OneOf . _schemaOneOf) oneOfE (D4.oneOf lateral)
124+ , dimap (fmap D4.NotVal . _schemaNot) (toss NotValidator) (D4.notVal lateral)
118125 ]
119126 where
120127 refVal :: AN.VisitedSchemas -> Maybe Text -> Schema -> Value -> [Failure]
src/Data/Validator/Draft4.hs+5−6
@@ -502,15 +502,14 @@ instance FromJSON schema => FromJSON (AnyOf schema) where
502502 AnyOf <$> o .: "anyOf"
503503
504504anyOf
505− :: ToJSON schema
506− => (schema -> Value -> [Fail err])
507− -> Validator schema (Maybe (AnyOf schema)) ()
505+ :: (schema -> Value -> [Fail err])
506+ -> Validator schema (Maybe (AnyOf schema)) err
508507anyOf f =
509508 Validator
510509 (\a -> case a of
511510 Just (AnyOf b) -> (NE.toList b, mempty)
512511 Nothing -> (mempty, mempty))
513− (run (fmap maybeToList . AN.anyOf f . _unAnyOf))
512+ (run (AN.anyOf f . _unAnyOf))
514513
515514newtype OneOf schema
516515 = OneOf { _unOneOf :: NonEmpty schema }
@@ -523,13 +522,13 @@ instance FromJSON schema => FromJSON (OneOf schema) where
523522oneOf
524523 :: ToJSON schema
525524 => (schema -> Value -> [Fail err])
526− -> Validator schema (Maybe (OneOf schema)) ()
525+ -> Validator schema (Maybe (OneOf schema)) (AN.OneOfInvalid err)
527526oneOf f =
528527 Validator
529528 (\a -> case a of
530529 Just (OneOf b) -> (NE.toList b, mempty)
531530 Nothing -> (mempty, mempty))
532− (run (fmap maybeToList . AN.oneOf f . _unOneOf))
531+ (run (AN.oneOf f . _unOneOf))
533532
534533newtype NotVal schema
535534 = NotVal { _unNotVal :: schema }
src/Data/Validator/Draft4/Any.hs+29−12
@@ -4,10 +4,11 @@ module Data.Validator.Draft4.Any where
44
55import Import
66-- Hiding is for GHCs before 7.10:
7−import Prelude hiding (any, elem)
7+import Prelude hiding (any, concat, elem)
88
99import Control.Monad
1010import Data.Aeson.Types (Parser)
11+import Data.List (partition)
1112import Data.List.NonEmpty (NonEmpty)
1213import qualified Data.List.NonEmpty as NE
1314import Data.Maybe
@@ -176,32 +177,48 @@ allOf f subSchemas x = NE.toList subSchemas >>= flip f x
176177--------------------------------------------------
177178
178179anyOf
179− :: ToJSON schema
180− => (schema -> Value -> [Fail err])
180+ :: forall err schema.
181+ (schema -> Value -> [Fail err])
181182 -> NonEmpty schema
182183 -> Value
183− -> Maybe (Fail ())
184+ -> [Fail err]
184185anyOf f subSchemas x
185− | any null (flip f x <$> subSchemas) = Nothing
186− | otherwise = Just $ Failure () (toJSON (UT.NonEmpty' subSchemas))
187− mempty x
186+ | any null results = mempty
187+ | otherwise = concat results
188+ where
189+ results :: [[Fail err]]
190+ results = flip f x <$> NE.toList subSchemas
188191
189192--------------------------------------------------
190193-- * oneOf
191194--------------------------------------------------
192195
196+data OneOfInvalid err
197+ = TooManySuccesses
198+ | NoSuccesses err
199+ deriving (Eq, Show)
200+
193201oneOf
194202 :: forall err schema. ToJSON schema
195203 => (schema -> Value -> [Fail err])
196204 -> NonEmpty schema
197205 -> Value
198− -> Maybe (Fail ())
206+ -> [Fail (OneOfInvalid err)]
199207oneOf f subSchemas x
200− | length successes == 1 = Nothing
201− | otherwise = Just $ Failure () (toJSON (UT.NonEmpty' subSchemas)) mempty x
208+ | length successes == 1 = mempty
209+ | length successes > 1 = pure tooManySuccesses
210+ | otherwise = fmap NoSuccesses <$> concat failures
202211 where
203− successes :: [[Fail err]]
204− successes = filter null $ flip f x <$> NE.toList subSchemas
212+ (successes, failures) = partition null results
213+
214+ results :: [[Fail err]]
215+ results = flip f x <$> NE.toList subSchemas
216+
217+ -- NOTE: This could also return information about the specific
218+ -- validators that succeeded.
219+ tooManySuccesses :: Fail (OneOfInvalid err)
220+ tooManySuccesses = Failure TooManySuccesses
221+ (toJSON (UT.NonEmpty' subSchemas)) mempty x
205222
206223--------------------------------------------------
207224-- * not