528f5da · typeable/hjsonschema

git.iko.soy/typeable/hjsonschema

on master help sign in

1.2.0.0.

528f5daIan Grant Jeffries10 years ago

changelog.txt+6

compare with master

unifiedsplit

@@ -1,3 +1,9 @@

1+# 1.2.0.0

3++ Return `AdditionalPropertiesObject` error correctly (was mistakenly

4+returning `AdditionalItemsObject` instead.

5++ Don't silence errors resulting from subschemas of "anyOf" or "oneOf".

1# 1.1.0.1

7# 1.1.0.1

3+ Bump `aeson` and `hjsonpointer`.

9+ Bump `aeson` and `hjsonpointer`.

examples/AlternateSchema.hs+2−2

@@ -138,8 +138,8 @@ d4Spec referenced visited scope =

138 , dimap f (const Enum) D4.enumVal

139 , dimap f (const TypeValidator) D4.typeVal

140 , dimap f AllOf (D4.allOf lateral)

141− , dimap f (const AnyOf) (D4.anyOf lateral)

141+ , dimap f AnyOf (D4.anyOf lateral)

142− , dimap f (const OneOf) (D4.oneOf lateral)

142+ , dimap f oneOfE (D4.oneOf lateral)

143 , dimap f (const NotValidator) (D4.notVal lateral)

144 ]

145 where

hjsonschema.cabal+1−2

@@ -1,5 +1,5 @@

1name: hjsonschema

2−version: 1.1.0.1

2+version: 1.2.0.0

3synopsis: JSON Schema library

4homepage: https://github.com/seagreen/hjsonschema

5license: MIT

@@ -9,7 +9,6 @@ maintainer: ian@housejeffries.com

9category: Data

10build-type: Simple

11cabal-version: >=1.10

12−tested-with: GHC == 7.8.4, GHC == 7.10.2

13extra-source-files:

12extra-source-files:

14 changelog.txt

13 changelog.txt

15 JSON-Schema-Test-Suite/remotes/*.json

14 JSON-Schema-Test-Suite/remotes/*.json

src/Data/JsonSchema/Draft4/Failure.hs+8−3

@@ -71,8 +71,9 @@ data ValidatorChain

71 | Enum

72 | TypeValidator

73 | AllOf ValidatorChain

74− | AnyOf

74+ | AnyOf ValidatorChain

75− | OneOf

75+ | OneOfTooManySuccesses

76+ | OneOfNoSuccesses ValidatorChain

76 | NotValidator

77 | NotValidator

77 deriving (Eq, Show)

78 deriving (Eq, Show)

@@ -110,9 +111,13 @@ patPropE (OB.PPAdditionalPropertiesInvalid a) =

110

111

111addPropE :: OB.AdditionalPropertiesInvalid ValidatorChain -> ValidatorChain

112addPropE :: OB.AdditionalPropertiesInvalid ValidatorChain -> ValidatorChain

112addPropE OB.APBoolInvalid = AdditionalPropertiesBool

113addPropE OB.APBoolInvalid = AdditionalPropertiesBool

113−addPropE (OB.APObjectInvalid err) = AdditionalItemsObject err

114+addPropE (OB.APObjectInvalid err) = AdditionalPropertiesObject err

114

115

115refE :: AN.RefInvalid ValidatorChain -> ValidatorChain

116refE :: AN.RefInvalid ValidatorChain -> ValidatorChain

116refE AN.RefResolution = RefResolution

117refE AN.RefResolution = RefResolution

117refE AN.RefLoop = RefLoop

118refE AN.RefLoop = RefLoop

118refE (AN.RefInvalid err) = Ref err

119refE (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)

22embedded :: Schema -> ([Schema], [Schema])

23embedded s = JT.embedded (d4Spec (ReferencedSchemas s mempty) mempty Nothing) s

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+

25validate

32validate

26 :: ReferencedSchemas Schema

33 :: ReferencedSchemas Schema

27 -> SchemaWithURI Schema

34 -> SchemaWithURI Schema

@@ -52,7 +59,7 @@ d4Spec

52d4Spec referenced visited scope = Spec

59d4Spec referenced visited scope = Spec

53 [ dimap

60 [ dimap

54 (fmap D4.MultipleOf . _schemaMultipleOf)

61 (fmap D4.MultipleOf . _schemaMultipleOf)

55− (const MultipleOf)

62+ (toss MultipleOf)

56 D4.multipleOf

63 D4.multipleOf

57 , dimap

64 , dimap

58 (\s -> D4.MaximumContext (fromMaybe False (_schemaExclusiveMaximum s))

65 (\s -> D4.MaximumContext (fromMaybe False (_schemaExclusiveMaximum s))

@@ -65,13 +72,13 @@ d4Spec referenced visited scope = Spec

65 minE

72 minE

66 D4.minimumVal

73 D4.minimumVal

68− , dimap (fmap D4.MaxLength . _schemaMaxLength) (const MaxLength) D4.maxLength

75+ , dimap (fmap D4.MaxLength . _schemaMaxLength) (toss MaxLength) D4.maxLength

69− , dimap (fmap D4.MinLength . _schemaMinLength) (const MinLength) D4.minLength

76+ , dimap (fmap D4.MinLength . _schemaMinLength) (toss MinLength) D4.minLength

70− , dimap (fmap D4.PatternVal . _schemaPattern) (const PatternValidator) D4.patternVal

77+ , dimap (fmap D4.PatternVal . _schemaPattern) (toss PatternValidator) D4.patternVal

72− , dimap (fmap D4.MaxItems . _schemaMaxItems) (const MaxItems) D4.maxItems

79+ , dimap (fmap D4.MaxItems . _schemaMaxItems) (toss MaxItems) D4.maxItems

73− , dimap (fmap D4.MinItems . _schemaMinItems) (const MinItems) D4.minItems

80+ , dimap (fmap D4.MinItems . _schemaMinItems) (toss MinItems) D4.minItems

74− , dimap (fmap D4.UniqueItems . _schemaUniqueItems) (const UniqueItems) D4.uniqueItems

81+ , dimap (fmap D4.UniqueItems . _schemaUniqueItems) (toss UniqueItems) D4.uniqueItems

75 , dimap

82 , dimap

76 (\s -> D4.ItemsContext (_schemaAdditionalItems s) <$> _schemaItems s)

83 (\s -> D4.ItemsContext (_schemaAdditionalItems s) <$> _schemaItems s)

77 itemsE

84 itemsE

@@ -79,9 +86,9 @@ d4Spec referenced visited scope = Spec

79 , lmap (fmap D4.AdditionalItemsContext . _schemaAdditionalItems) D4.additionalItemsEmbedded

86 , lmap (fmap D4.AdditionalItemsContext . _schemaAdditionalItems) D4.additionalItemsEmbedded

80 , lmap (fmap D4.Definitions . _schemaDefinitions) D4.definitionsEmbedded

87 , lmap (fmap D4.Definitions . _schemaDefinitions) D4.definitionsEmbedded

82− , dimap (fmap D4.MaxProperties . _schemaMaxProperties) (const MaxProperties) D4.maxProperties

89+ , dimap (fmap D4.MaxProperties . _schemaMaxProperties) (toss MaxProperties) D4.maxProperties

83− , dimap (fmap D4.MinProperties . _schemaMinProperties) (const MinProperties) D4.minProperties

90+ , dimap (fmap D4.MinProperties . _schemaMinProperties) (toss MinProperties) D4.minProperties

84− , dimap (fmap D4.RequiredContext . _schemaRequired) (const Required) D4.required

91+ , dimap (fmap D4.RequiredContext . _schemaRequired) (toss Required) D4.required

85 , dimap (fmap D4.DependenciesContext . _schemaDependencies) depsE (D4.dependencies descend)

92 , dimap (fmap D4.DependenciesContext . _schemaDependencies) depsE (D4.dependencies descend)

86 , dimap

93 , dimap

87 (\s -> D4.PropertiesContext

94 (\s -> D4.PropertiesContext

@@ -109,12 +116,12 @@ d4Spec referenced visited scope = Spec

109 (\s -> D4.Ref <$> _schemaRef s)

116 (\s -> D4.Ref <$> _schemaRef s)

110 refE

117 refE

111 (D4.ref visited scope (FE.getReference referenced) refVal)

118 (D4.ref visited scope (FE.getReference referenced) refVal)

112− , dimap (fmap D4.EnumContext . _schemaEnum) (const Enum) D4.enumVal

119+ , dimap (fmap D4.EnumContext . _schemaEnum) (toss Enum) D4.enumVal

113− , dimap (fmap D4.TypeContext . _schemaType) (const TypeValidator) D4.typeVal

120+ , dimap (fmap D4.TypeContext . _schemaType) (toss TypeValidator) D4.typeVal

114 , dimap (fmap D4.AllOf . _schemaAllOf) AllOf (D4.allOf lateral)

121 , dimap (fmap D4.AllOf . _schemaAllOf) AllOf (D4.allOf lateral)

115− , dimap (fmap D4.AnyOf . _schemaAnyOf) (const AnyOf) (D4.anyOf lateral)

122+ , dimap (fmap D4.AnyOf . _schemaAnyOf) AnyOf (D4.anyOf lateral)

116− , dimap (fmap D4.OneOf . _schemaOneOf) (const OneOf) (D4.oneOf lateral)

123+ , dimap (fmap D4.OneOf . _schemaOneOf) oneOfE (D4.oneOf lateral)

117− , dimap (fmap D4.NotVal . _schemaNot) (const NotValidator) (D4.notVal lateral)

124+ , dimap (fmap D4.NotVal . _schemaNot) (toss NotValidator) (D4.notVal lateral)

118 ]

125 ]

119 where

126 where

120 refVal :: AN.VisitedSchemas -> Maybe Text -> Schema -> Value -> [Failure]

127 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

502 AnyOf <$> o .: "anyOf"

503

504anyOf

505− :: ToJSON schema

506− => (schema -> Value -> [Fail err])

505+ :: (schema -> Value -> [Fail err])

507− -> Validator schema (Maybe (AnyOf schema)) ()

506+ -> Validator schema (Maybe (AnyOf schema)) err

508anyOf f =

507anyOf f =

509 Validator

508 Validator

510 (\a -> case a of

509 (\a -> case a of

511 Just (AnyOf b) -> (NE.toList b, mempty)

510 Just (AnyOf b) -> (NE.toList b, mempty)

512 Nothing -> (mempty, mempty))

511 Nothing -> (mempty, mempty))

513− (run (fmap maybeToList . AN.anyOf f . _unAnyOf))

512+ (run (AN.anyOf f . _unAnyOf))

514

513

515newtype OneOf schema

514newtype OneOf schema

516 = OneOf { _unOneOf :: NonEmpty schema }

515 = OneOf { _unOneOf :: NonEmpty schema }

@@ -523,13 +522,13 @@ instance FromJSON schema => FromJSON (OneOf schema) where

523oneOf

522oneOf

524 :: ToJSON schema

523 :: ToJSON schema

525 => (schema -> Value -> [Fail err])

524 => (schema -> Value -> [Fail err])

526− -> Validator schema (Maybe (OneOf schema)) ()

525+ -> Validator schema (Maybe (OneOf schema)) (AN.OneOfInvalid err)

527oneOf f =

526oneOf f =

528 Validator

527 Validator

529 (\a -> case a of

528 (\a -> case a of

530 Just (OneOf b) -> (NE.toList b, mempty)

529 Just (OneOf b) -> (NE.toList b, mempty)

531 Nothing -> (mempty, mempty))

530 Nothing -> (mempty, mempty))

532− (run (fmap maybeToList . AN.oneOf f . _unOneOf))

531+ (run (AN.oneOf f . _unOneOf))

533

532

534newtype NotVal schema

533newtype NotVal schema

535 = NotVal { _unNotVal :: schema }

534 = NotVal { _unNotVal :: schema }

src/Data/Validator/Draft4/Any.hs+29−12

@@ -4,10 +4,11 @@ module Data.Validator.Draft4.Any where

5import Import

6-- Hiding is for GHCs before 7.10:

7−import Prelude hiding (any, elem)

7+import Prelude hiding (any, concat, elem)

9import Control.Monad

10import Data.Aeson.Types (Parser)

11+import Data.List (partition)

11import Data.List.NonEmpty (NonEmpty)

12import Data.List.NonEmpty (NonEmpty)

12import qualified Data.List.NonEmpty as NE

13import qualified Data.List.NonEmpty as NE

13import Data.Maybe

14import Data.Maybe

@@ -176,32 +177,48 @@ allOf f subSchemas x = NE.toList subSchemas >>= flip f x

176--------------------------------------------------

177--------------------------------------------------

177

178

178anyOf

179anyOf

179− :: ToJSON schema

180+ :: forall err schema.

180− => (schema -> Value -> [Fail err])

181+ (schema -> Value -> [Fail err])

181 -> NonEmpty schema

182 -> NonEmpty schema

182 -> Value

183 -> Value

183− -> Maybe (Fail ())

184+ -> [Fail err]

184anyOf f subSchemas x

185anyOf f subSchemas x

185− | any null (flip f x <$> subSchemas) = Nothing

186+ | any null results = mempty

186− | otherwise = Just $ Failure () (toJSON (UT.NonEmpty' subSchemas))

187+ | otherwise = concat results

187− mempty x

188+ where

189+ results :: [[Fail err]]

190+ results = flip f x <$> NE.toList subSchemas

188

191

189--------------------------------------------------

192--------------------------------------------------

190-- * oneOf

193-- * oneOf

191--------------------------------------------------

194--------------------------------------------------

192

195

196+data OneOfInvalid err

197+ = TooManySuccesses

198+ | NoSuccesses err

199+ deriving (Eq, Show)

200+

193oneOf

201oneOf

194 :: forall err schema. ToJSON schema

202 :: forall err schema. ToJSON schema

195 => (schema -> Value -> [Fail err])

203 => (schema -> Value -> [Fail err])

196 -> NonEmpty schema

204 -> NonEmpty schema

197 -> Value

205 -> Value

198− -> Maybe (Fail ())

206+ -> [Fail (OneOfInvalid err)]

199oneOf f subSchemas x

207oneOf f subSchemas x

200− | length successes == 1 = Nothing

208+ | length successes == 1 = mempty

201− | otherwise = Just $ Failure () (toJSON (UT.NonEmpty' subSchemas)) mempty x

209+ | length successes > 1 = pure tooManySuccesses

210+ | otherwise = fmap NoSuccesses <$> concat failures

202 where

211 where

203− successes :: [[Fail err]]

212+ (successes, failures) = partition null results

213+

214+ results :: [[Fail err]]

204− successes = filter null $ flip f x <$> NE.toList subSchemas

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

205

222

206--------------------------------------------------

223--------------------------------------------------

207-- * not

224-- * not