8fa07b5 · typeable/hjsonschema

examples/CustomSchema.hs+2−2

compare with master

unifiedsplit

@@ -23,7 +23,7 @@ import qualified Data.Validator.Failure as FR

23oddLength :: Bool -> Text -> Maybe (FR.Failure () )

24oddLength b t

25 | b == odd (T.length t) = Nothing

26− | otherwise = Just (FR.Failure () (Bool b) mempty)

26+ | otherwise = Just (FR.Invalid () (Bool b) mempty)

27

28data CustomError

29 = MaxLength

@@ -58,7 +58,7 @@ example :: IO ()

58example =

59 case validate schema badData of

60 [] -> error "We validated bad data."

61− [FR.Failure OddLength _ _] -> return () -- Success.

61+ [FR.Invalid OddLength _ _] -> return () -- Success.

62 _ -> error "We got a different failure than expected."

63 where

64 schema :: Schema

examples/PrettyShowFailure.hs+10−10

@@ -11,16 +11,16 @@ import qualified Data.JsonSchema.Draft4 as D4

11badData :: Value

12badData = toJSON [1, 2 :: Int]

13

14−failure :: D4.Failure

14+failure :: D4.Invalid

15−failure = D4.Failure

15+failure = D4.Invalid

16− { D4._failureValidatorsCalled = D4.Items D4.MultipleOf

16+ { D4._invalidValidatorsCalled = D4.Items D4.MultipleOf

17− , D4._failureFinalValidator = Number 2

17+ , D4._invalidFinalValidator = Number 2

18− , D4._failureOffendingData = AP.Pointer [AP.Token "0"]

18+ , D4._invalidOffendingData = AP.Pointer [AP.Token "0"]

19 }

20

21example :: IO ()

22example =

23− -- 'D4.Failure's contain the sequence of embedded validators that caused

23+ -- 'D4.Invalid's contain the sequence of embedded validators that caused

24 -- the invalidation, the contents of the final validator in that sequence,

25 -- and a JSON Pointer to the subset of data that caused validation to fail.

26 --

@@ -32,7 +32,7 @@ example =

32 -- 'D4._failureOffendingData') against the original data.

33 --

34 -- NOTE: You have to have hjsonpointer in your build-depends.

35− case AP.resolve (D4._failureOffendingData failure) badData of

35+ case AP.resolve (D4._invalidOffendingData failure) badData of

36 Left _ -> error "Couldn't resolve pointer."

37 Right _ -> return () -- Success. We could feed the 'Right' value into

38 -- the otherwise unused 'msg' if we wanted to

@@ -42,15 +42,15 @@ msg :: Value -> String

42msg subsetOfData = unlines

43 [ "Invalid data. Here's the sequence of validators that caught it:"

44 , ""

45− , " " <> show (D4._failureValidatorsCalled failure)

45+ , " " <> show (D4._invalidValidatorsCalled failure)

46 , ""

47 , "Here's the contents of the final validator in that sequence:"

48 , ""

49− , " " <> show (D4._failureFinalValidator failure)

49+ , " " <> show (D4._invalidFinalValidator failure)

50 , ""

51 , "Here's a JSON Pointer to the invalid part of the data:"

52 , ""

53− , " " <> show (D4._failureOffendingData failure)

53+ , " " <> show (D4._invalidOffendingData failure)

54 , ""

55 , "Here's the invalid part of the data:"

56 , ""

examples/Standard.hs+1−1

@@ -37,7 +37,7 @@ example = do

37

38 case validate badData of

39 [] -> error "We validated bad data."

40− [D4.Failure D4.UniqueItems _ _] -> return () -- Success.

40+ [D4.Invalid D4.UniqueItems _ _] -> return () -- Success.

41 _ -> error "We got a different failure than expected."

42

43 where

src/Data/JsonSchema/Draft4.hs+14−12

@@ -20,7 +20,8 @@ module Data.JsonSchema.Draft4

20 , referencesViaFilesystem

21

22 -- * Failure

23+ , Invalid

23− , Failure(..)

24+ , FR.Failure(..)

24 , ValidatorChain(..)

25 , ValidatorChain(..)

25

26

26 -- * Other Draft 4 things exported just in case

27 -- * Other Draft 4 things exported just in case

@@ -40,7 +41,7 @@ import Data.List.NonEmpty (NonEmpty)

40import qualified Data.List.NonEmpty as N

41import qualified Data.List.NonEmpty as N

41import Data.Maybe (fromMaybe)

42import Data.Maybe (fromMaybe)

42

43

43−import Data.JsonSchema.Draft4.Failure

44+import Data.JsonSchema.Draft4.Failure (Invalid, ValidatorChain(..))

44import qualified Data.JsonSchema.Draft4.Internal as IN

45import qualified Data.JsonSchema.Draft4.Internal as IN

45import Data.JsonSchema.Draft4.Schema

46import Data.JsonSchema.Draft4.Schema

46import Data.JsonSchema.Fetch (FilesystemFailure(..),

47import Data.JsonSchema.Fetch (FilesystemFailure(..),

@@ -48,11 +49,12 @@ import Data.JsonSchema.Fetch (FilesystemFailure(..),

48 ReferencedSchemas(..),

49 ReferencedSchemas(..),

49 SchemaWithURI(..))

50 SchemaWithURI(..))

50import qualified Data.JsonSchema.Fetch as FE

51import qualified Data.JsonSchema.Fetch as FE

52+import qualified Data.Validator.Failure as FR

51

53

52data HTTPValidationFailure

54data HTTPValidationFailure

53 = HVRequest HTTPFailure

55 = HVRequest HTTPFailure

54− | HVSchema (NonEmpty Failure)

56+ | HVSchema (NonEmpty Invalid)

55− | HVData (NonEmpty Failure)

57+ | HVData (NonEmpty Invalid)

56 deriving Show

58 deriving Show

57

59

58fetchHTTPAndValidate

60fetchHTTPAndValidate

@@ -64,18 +66,18 @@ fetchHTTPAndValidate sw v = do

64 pure (g =<< f =<< left HVRequest res)

66 pure (g =<< f =<< left HVRequest res)

65 where

67 where

66 f :: ReferencedSchemas Schema

68 f :: ReferencedSchemas Schema

67− -> Either HTTPValidationFailure (Value -> [Failure])

69+ -> Either HTTPValidationFailure (Value -> [Invalid])

68 f references = left HVSchema (checkSchema references sw)

70 f references = left HVSchema (checkSchema references sw)

69

71

70− g :: (Value -> [Failure]) -> Either HTTPValidationFailure ()

72+ g :: (Value -> [Invalid]) -> Either HTTPValidationFailure ()

71 g validate = case N.nonEmpty (validate v) of

73 g validate = case N.nonEmpty (validate v) of

72 Nothing -> Right ()

74 Nothing -> Right ()

73 Just failures -> Left (HVData failures)

75 Just failures -> Left (HVData failures)

74

76

75data FilesystemValidationFailure

77data FilesystemValidationFailure

76 = FVRead FilesystemFailure

78 = FVRead FilesystemFailure

77− | FVSchema (NonEmpty Failure)

79+ | FVSchema (NonEmpty Invalid)

78− | FVData (NonEmpty Failure)

80+ | FVData (NonEmpty Invalid)

79 deriving Show

81 deriving Show

80

82

81fetchFilesystemAndValidate

83fetchFilesystemAndValidate

@@ -87,10 +89,10 @@ fetchFilesystemAndValidate sw v = do

87 pure (g =<< f =<< left FVRead res)

89 pure (g =<< f =<< left FVRead res)

88 where

90 where

89 f :: ReferencedSchemas Schema

91 f :: ReferencedSchemas Schema

90− -> Either FilesystemValidationFailure (Value -> [Failure])

92+ -> Either FilesystemValidationFailure (Value -> [Invalid])

91 f references = left FVSchema (checkSchema references sw)

93 f references = left FVSchema (checkSchema references sw)

92

94

93− g :: (Value -> [Failure]) -> Either FilesystemValidationFailure ()

95+ g :: (Value -> [Invalid]) -> Either FilesystemValidationFailure ()

94 g validate = case N.nonEmpty (validate v) of

96 g validate = case N.nonEmpty (validate v) of

95 Nothing -> Right ()

97 Nothing -> Right ()

96 Just failures -> Left (FVData failures)

98 Just failures -> Left (FVData failures)

@@ -99,7 +101,7 @@ fetchFilesystemAndValidate sw v = do

99checkSchema

101checkSchema

100 :: ReferencedSchemas Schema

102 :: ReferencedSchemas Schema

101 -> SchemaWithURI Schema

103 -> SchemaWithURI Schema

102− -> Either (NonEmpty Failure) (Value -> [Failure])

104+ -> Either (NonEmpty Invalid) (Value -> [Invalid])

103checkSchema referenced schemaWithURI =

105checkSchema referenced schemaWithURI =

104 case N.nonEmpty . schemaValidity . _swSchema $ schemaWithURI of

106 case N.nonEmpty . schemaValidity . _swSchema $ schemaWithURI of

105 Nothing -> Right (IN.runValidate referenced schemaWithURI)

107 Nothing -> Right (IN.runValidate referenced schemaWithURI)

@@ -120,7 +122,7 @@ referencesViaFilesystem = FE.referencesViaFilesystem' draft4Spec

120

122

121-- | In normal situations just use 'checkSchema', which is a combination of

123-- | In normal situations just use 'checkSchema', which is a combination of

122-- 'schemaValidity' and 'runValidate'.

124-- 'schemaValidity' and 'runValidate'.

123−schemaValidity :: Schema -> [Failure]

125+schemaValidity :: Schema -> [Invalid]

124schemaValidity = IN.runValidate referenced (SchemaWithURI d4 Nothing) . toJSON

126schemaValidity = IN.runValidate referenced (SchemaWithURI d4 Nothing) . toJSON

125 where

127 where

126 d4 :: Schema

128 d4 :: Schema

src/Data/JsonSchema/Draft4/Failure.hs+1−16

@@ -1,24 +1,9 @@

1

2module Data.JsonSchema.Draft4.Failure where

3

4−import qualified Data.Aeson.Pointer as P

5−

6import qualified Data.Validator.Failure as FR

4import qualified Data.Validator.Failure as FR

7−import Import

8−

9−-- | A version of 'FR.Failure' specialized for JSON Schema Draft 4.

10−data Failure = Failure

11− -- NOTE: We use a data type here instead of a newtype to provide a cleaner

12− -- API for those importing only 'Data.JsonSchema.Draft4' (which should be

13− -- the vast majority of users). Downsides: slower and hacky. I'd appreciate

14− -- feedback on this.

15− { _failureValidatorsCalled :: !ValidatorChain

16− , _failureFinalValidator :: !Value

17− , _failureOffendingData :: !P.Pointer

18− } deriving (Eq, Show)

19

5

20−specializeForDraft4 :: FR.Failure ValidatorChain -> Failure

6+type Invalid = FR.Failure ValidatorChain

21−specializeForDraft4 (FR.Failure a b c) = Failure a b c

22

7

23data ValidatorChain

8data ValidatorChain

24 = MultipleOf

9 = MultipleOf

src/Data/JsonSchema/Draft4/Internal.hs+15−28

@@ -70,29 +70,16 @@ embedded schema = concat

70 checkDependency (OB.PropertyDependency _) = Nothing

71 checkDependency (OB.SchemaDependency s) = Just s

72

73−--------------------------------------------------

74−-- * Validation (Exported from 'Data.JsonSchema.Draft4')

75−--------------------------------------------------

76−

77−-- | In normal situations just use 'checkSchema', which is a combination of

78−-- 'schemaValidity' and 'runValidate'.

79−runValidate

80− :: ReferencedSchemas Schema

81− -> SchemaWithURI Schema

82− -> Value

83− -> [Failure]

84−runValidate = (fmap.fmap.fmap.fmap) specializeForDraft4 validateAny

85−

86--------------------------------------------------

73--------------------------------------------------

87-- * Validation (Main internal functions)

74-- * Validation (Main internal functions)

88--------------------------------------------------

75--------------------------------------------------

89

76

90−validateAny

77+runValidate

91 :: ReferencedSchemas Schema

78 :: ReferencedSchemas Schema

92 -> SchemaWithURI Schema

79 -> SchemaWithURI Schema

93 -> Value

80 -> Value

94− -> [FR.Failure ValidatorChain]

81+ -> [Invalid]

95−validateAny referenced sw x = concat

82+runValidate referenced sw x = concat

96 [ f _schemaEnum (setFailure Enum) (fmap maybeToList . AN.enumVal)

83 [ f _schemaEnum (setFailure Enum) (fmap maybeToList . AN.enumVal)

97 , f _schemaType (setFailure TypeValidator) (fmap maybeToList . AN.typeVal)

84 , f _schemaType (setFailure TypeValidator) (fmap maybeToList . AN.typeVal)

98 , f _schemaAllOf (modFailure AllOf) (AN.allOf recurse)

85 , f _schemaAllOf (modFailure AllOf) (AN.allOf recurse)

@@ -102,7 +89,7 @@ validateAny referenced sw x = concat

102 , refFailures

89 , refFailures

103 ] <> specificValidators

90 ] <> specificValidators

104 where

91 where

105− specificValidators :: [FR.Failure ValidatorChain]

92+ specificValidators :: [Invalid]

106 specificValidators =

93 specificValidators =

107 case x of

94 case x of

108 Number y -> validateNumber (_swSchema sw) y

95 Number y -> validateNumber (_swSchema sw) y

@@ -120,16 +107,16 @@ validateAny referenced sw x = concat

120 --

107 --

121 -- [1] A list of errors wrapped in a 'Maybe' where 'Nothing' represents

108 -- [1] A list of errors wrapped in a 'Maybe' where 'Nothing' represents

122 -- if resolving the reference itself failed.

109 -- if resolving the reference itself failed.

123− refFailures :: [FR.Failure ValidatorChain]

110+ refFailures :: [Invalid]

124 refFailures =

111 refFailures =

125 case _schemaRef (_swSchema sw) of

112 case _schemaRef (_swSchema sw) of

126 Nothing -> mempty

113 Nothing -> mempty

127 Just reference ->

114 Just reference ->

128− maybe [FR.Failure RefResolution (toJSON reference) mempty]

115+ maybe [FR.Invalid RefResolution (toJSON reference) mempty]

129 (fmap (modFailure Ref))

116 (fmap (modFailure Ref))

130 $ AN.ref scope

117 $ AN.ref scope

131 getReference

118 getReference

132− (\a b -> validateAny referenced (SchemaWithURI b a))

119+ (\a b -> runValidate referenced (SchemaWithURI b a))

133 reference

120 reference

134 x

121 x

135 where

122 where

@@ -143,7 +130,7 @@ validateAny referenced sw x = concat

143validateString

130validateString

144 :: Schema

131 :: Schema

145 -> Text

132 -> Text

146− -> [FR.Failure ValidatorChain]

133+ -> [Invalid]

147validateString schema x = concat

134validateString schema x = concat

148 [ f _schemaMaxLength (setFailure MaxLength) (fmap maybeToList . ST.maxLength)

135 [ f _schemaMaxLength (setFailure MaxLength) (fmap maybeToList . ST.maxLength)

149 , f _schemaMinLength (setFailure MinLength) (fmap maybeToList . ST.minLength)

136 , f _schemaMinLength (setFailure MinLength) (fmap maybeToList . ST.minLength)

@@ -155,7 +142,7 @@ validateString schema x = concat

155validateNumber

142validateNumber

156 :: Schema

143 :: Schema

157 -> Scientific

144 -> Scientific

158− -> [FR.Failure ValidatorChain]

145+ -> [Invalid]

159validateNumber schema x = concat

146validateNumber schema x = concat

160 [ f _schemaMultipleOf (setFailure MultipleOf) (fmap maybeToList . NU.multipleOf)

147 [ f _schemaMultipleOf (setFailure MultipleOf) (fmap maybeToList . NU.multipleOf)

161 , f _schemaMaximum

148 , f _schemaMaximum

@@ -182,7 +169,7 @@ validateArray

182 :: ReferencedSchemas Schema

169 :: ReferencedSchemas Schema

183 -> SchemaWithURI Schema

170 -> SchemaWithURI Schema

184 -> Vector Value

171 -> Vector Value

185− -> [FR.Failure ValidatorChain]

172+ -> [Invalid]

186validateArray referenced (SchemaWithURI schema mUri) x = concat

173validateArray referenced (SchemaWithURI schema mUri) x = concat

187 [ f _schemaMaxItems (setFailure MaxItems) (fmap maybeToList . AR.maxItems)

174 [ f _schemaMaxItems (setFailure MaxItems) (fmap maybeToList . AR.maxItems)

188 , f _schemaMinItems (setFailure MinItems) (fmap maybeToList . AR.minItems)

175 , f _schemaMinItems (setFailure MinItems) (fmap maybeToList . AR.minItems)

@@ -204,7 +191,7 @@ validateObject

204 :: ReferencedSchemas Schema

191 :: ReferencedSchemas Schema

205 -> SchemaWithURI Schema

192 -> SchemaWithURI Schema

206 -> HashMap Text Value

193 -> HashMap Text Value

207− -> [FR.Failure ValidatorChain]

194+ -> [Invalid]

208validateObject referenced (SchemaWithURI schema mUri) x = concat

195validateObject referenced (SchemaWithURI schema mUri) x = concat

209 [ f _schemaMaxProperties (setFailure MaxProperties) (fmap maybeToList . OB.maxProperties)

196 [ f _schemaMaxProperties (setFailure MaxProperties) (fmap maybeToList . OB.maxProperties)

210 , f _schemaMinProperties (setFailure MinProperties) (fmap maybeToList . OB.minProperties)

197 , f _schemaMinProperties (setFailure MinProperties) (fmap maybeToList . OB.minProperties)

@@ -262,9 +249,9 @@ descendNextLevel

262 -> SchemaWithURI Schema

249 -> SchemaWithURI Schema

263 -> Schema

250 -> Schema

264 -> Value

251 -> Value

265− -> [FR.Failure ValidatorChain]

252+ -> [Invalid]

266descendNextLevel referenced (SchemaWithURI schema mUri) =

253descendNextLevel referenced (SchemaWithURI schema mUri) =

267− validateAny referenced . flip SchemaWithURI scope

254+ runValidate referenced . flip SchemaWithURI scope

268 where

255 where

269 scope :: Maybe Text

256 scope :: Maybe Text

270 scope = updateResolutionScope mUri (_schemaId schema)

257 scope = updateResolutionScope mUri (_schemaId schema)

@@ -273,8 +260,8 @@ runSingle

273 :: Schema

260 :: Schema

274 -> dta

261 -> dta

275 -> (Schema -> Maybe val)

262 -> (Schema -> Maybe val)

276− -> (err -> FR.Failure ValidatorChain)

263+ -> (err -> Invalid)

277 -> (val -> dta -> [err])

264 -> (val -> dta -> [err])

278− -> [FR.Failure ValidatorChain]

265+ -> [Invalid]

279runSingle schema dta field modifyError validate =

266runSingle schema dta field modifyError validate =

280 maybe mempty (\val -> modifyError <$> validate val dta) (field schema)

267 maybe mempty (\val -> modifyError <$> validate val dta) (field schema)

src/Data/Validator/Draft4/Any.hs+5−5

@@ -84,7 +84,7 @@ enumVal (EnumVal vs) x

84 | not (allUniqueValues' vs) = Nothing

85 | x `elem` vs = Nothing

86 | otherwise =

87− Just $ Failure () (toJSON (NonEmpty' vs)) mempty

87+ Just $ Invalid () (toJSON (NonEmpty' vs)) mempty

88

89--------------------------------------------------

90-- * type

@@ -114,7 +114,7 @@ typeVal (TypeValArray ts) x = isJsonType x ts

114

115isJsonType :: Value -> Set Text -> Maybe (Failure ())

116isJsonType x ts

117− | S.null (S.intersection okTypes ts) = Just (Failure () (toJSON ts) mempty)

117+ | S.null (S.intersection okTypes ts) = Just (Invalid () (toJSON ts) mempty)

118 | otherwise = Nothing

119 where

120 okTypes :: Set Text

@@ -149,7 +149,7 @@ anyOf

149 -> Maybe (Failure ())

150anyOf f subSchemas x

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

152− | otherwise = Just $ Failure () (toJSON (NonEmpty' subSchemas)) mempty

152+ | otherwise = Just $ Invalid () (toJSON (NonEmpty' subSchemas)) mempty

153

154oneOf

155 :: forall err schema. ToJSON schema

@@ -159,7 +159,7 @@ oneOf

159 -> Maybe (Failure ())

160oneOf f subSchemas x

161 | length successes == 1 = Nothing

162− | otherwise = Just $ Failure ()

162+ | otherwise = Just $ Invalid ()

163 (toJSON (NonEmpty' subSchemas))

164 mempty

165 where

@@ -174,5 +174,5 @@ notVal

174 -> Maybe (Failure ())

175notVal f schema x =

176 case f schema x of

177− [] -> Just (Failure () (toJSON schema) mempty)

177+ [] -> Just (Invalid () (toJSON schema) mempty)

178 _ -> Nothing

src/Data/Validator/Draft4/Array.hs+5−5

@@ -15,20 +15,20 @@ import Import

15maxItems :: Int -> Vector Value -> Maybe (Failure ())

16maxItems n xs

17 | n < 0 = Nothing

18− | V.length xs > n = Just (Failure () (toJSON n) mempty)

18+ | V.length xs > n = Just (Invalid () (toJSON n) mempty)

19 | otherwise = Nothing

20

21-- | The spec requires "minItems" to be non-negative.

22minItems :: Int -> Vector Value -> Maybe (Failure ())

23minItems n xs

24 | n < 0 = Nothing

25− | V.length xs < n = Just (Failure () (toJSON n) mempty)

25+ | V.length xs < n = Just (Invalid () (toJSON n) mempty)

26 | otherwise = Nothing

27

28uniqueItems :: Bool -> Vector Value -> Maybe (Failure ())

29uniqueItems True xs

30 | allUniqueValues xs = Nothing

31− | otherwise = Just (Failure () (Bool True) mempty)

31+ | otherwise = Just (Invalid () (Bool True) mempty)

32uniqueItems False _ = Nothing

33

34--------------------------------------------------

@@ -107,7 +107,7 @@ items f mAdditional (ItemsArray subSchemas) xs = itemFailures

107 correctIndexes

108 :: Failure (AdditionalItemsFailure err)

109 -> Failure (AdditionalItemsFailure err)

110− correctIndexes (Failure a b c) = Failure a b (fixIndex c)

110+ correctIndexes (Invalid a b c) = Invalid a b (fixIndex c)

111 where

112 fixIndex :: P.Pointer -> P.Pointer

113 fixIndex (P.Pointer (tok:toks)) =

@@ -157,7 +157,7 @@ additionalItems

157 -> [Failure (AdditionalItemsFailure err)]

158additionalItems _ (AdditionalBool b) xs

159 | b = mempty

160− | V.length xs > 0 = pure (Failure AdditionalBoolFailure (Bool b) mempty)

160+ | V.length xs > 0 = pure (Invalid AdditionalBoolFailure (Bool b) mempty)

161 | otherwise = mempty

162additionalItems f (AdditionalObject subSchema) xs =

163 zip [0..] (V.toList xs) >>= g

src/Data/Validator/Draft4/Number.hs+3−3

@@ -11,7 +11,7 @@ import Import

11multipleOf :: Scientific -> Scientific -> Maybe (Failure ())

12multipleOf n x

13 | n <= 0 = Nothing

14− | x `mod'` n /= 0 = Just (Failure () (toJSON n) mempty)

14+ | x `mod'` n /= 0 = Just (Invalid () (toJSON n) mempty)

15 | otherwise = Nothing

16

17data MaximumFailure

@@ -25,7 +25,7 @@ maximumVal

25 -> Scientific

26 -> Maybe (Failure MaximumFailure)

27maximumVal exclusiveMaximum n x

28− | x `greaterThan` n = Just (Failure err (toJSON n) mempty)

28+ | x `greaterThan` n = Just (Invalid err (toJSON n) mempty)

29 | otherwise = Nothing

30 where

31 (greaterThan, err) = if exclusiveMaximum

@@ -43,7 +43,7 @@ minimumVal

43 -> Scientific

44 -> Maybe (Failure MinimumFailure)

45minimumVal exclusiveMinimum n x

46− | x `lessThan` n = Just (Failure err (toJSON n) mempty)

46+ | x `lessThan` n = Just (Invalid err (toJSON n) mempty)

47 | otherwise = Nothing

48 where

49 (lessThan, err) = if exclusiveMinimum

src/Data/Validator/Draft4/Object.hs+4−4

@@ -25,14 +25,14 @@ import Prelude hiding (all, concat,

25maxProperties :: Int -> HashMap Text Value -> Maybe (Failure ())

26maxProperties n x

27 | n < 0 = Nothing

28− | H.size x > n = Just (Failure () (toJSON n) mempty)

28+ | H.size x > n = Just (Invalid () (toJSON n) mempty)

29 | otherwise = Nothing

30

31-- | The spec requires "minProperties" to be non-negative.

32minProperties :: Int -> HashMap Text Value -> Maybe (Failure ())

33minProperties n x

34 | n < 0 = Nothing

35− | H.size x < n = Just (Failure () (toJSON n) mempty)

35+ | H.size x < n = Just (Invalid () (toJSON n) mempty)

36 | otherwise = Nothing

37

38--------------------------------------------------

@@ -80,7 +80,7 @@ required (Required ts) x

80 -- instead of specialized versions.

81 | S.null ts = Nothing

82 | H.null (H.difference hm x) = Nothing

83− | otherwise = Just (Failure () (toJSON ts) mempty)

83+ | otherwise = Just (Invalid () (toJSON ts) mempty)

84 where

85 hm :: HashMap Text Bool

86 hm = foldl (\b a -> H.insert a True b) mempty ts

@@ -138,7 +138,7 @@ dependencies f hm x = concat . fmap (uncurry g) . H.toList $ hm

138 | otherwise = mempty

139 g k (PropertyDependency ts)

140 | H.member k x && not allPresent =

141− pure $ Failure PropertyDependencyFailure

141+ pure $ Invalid PropertyDependencyFailure

142 (toJSON (H.singleton k ts))

143 mempty

144 | otherwise = mempty

src/Data/Validator/Draft4/Object/Properties.hs+1−1

@@ -179,7 +179,7 @@ additionalProperties

179 -> HashMap Text Value

180 -> [Failure (AdditionalPropertiesFailure err)]

181additionalProperties _ (AdditionalPropertiesBool False) x

182− | H.size x > 0 = pure $ Failure APBoolFailure (Bool False) mempty

182+ | H.size x > 0 = pure $ Invalid APBoolFailure (Bool False) mempty

183 | otherwise = mempty

184additionalProperties _ (AdditionalPropertiesBool True) _ = mempty

185additionalProperties f (AdditionalPropertiesObject schema) x = H.toList x >>= g

src/Data/Validator/Draft4/String.hs+4−4

@@ -13,20 +13,20 @@ import Import

13maxLength :: Int -> Text -> Maybe (Failure ())

14maxLength n x

15 | n <= 0 = Nothing

16− | T.length x > n = Just (Failure () (toJSON n) mempty)

16+ | T.length x > n = Just (Invalid () (toJSON n) mempty)

17 | otherwise = Nothing

18

19-- | The spec requires "minLength" to be non-negative.

20minLength :: Int -> Text -> Maybe (Failure ())

21minLength n x

22 | n <= 0 = Nothing

23− | T.length x < n = Just (Failure () (toJSON n) mempty)

23+ | T.length x < n = Just (Invalid () (toJSON n) mempty)

24 | otherwise = Nothing

25

26patternVal :: Text -> Text -> Maybe (Failure ())

27patternVal t x =

28 case RE.compileM (encodeUtf8 t) mempty of

29− Left _ -> Just (Failure () (toJSON t) mempty)

29+ Left _ -> Just (Invalid () (toJSON t) mempty)

30 Right re -> if x RE.=~ re

31 then Nothing

32− else Just (Failure () (toJSON t) mempty)

32+ else Just (Invalid () (toJSON t) mempty)

src/Data/Validator/Failure.hs+7−7

@@ -23,20 +23,20 @@ import Prelude hiding (concat, sequence)

23-- by the validators it uses into a single error sum type for that schema.

24-- The schema's validate function will return a 'ValidationFailure' with

25-- that sum type as its type argument.

26−data Failure err = Failure

26+data Failure err = Invalid

27− { _failureValidatorsCalled :: !err

27+ { _invalidValidatorsCalled :: !err

28− , _failureFinalValidator :: !Value

28+ , _invalidFinalValidator :: !Value

29− , _failureOffendingData :: !P.Pointer

29+ , _invalidOffendingData :: !P.Pointer

30 } deriving (Eq, Show)

31

32setFailure :: b -> Failure a -> Failure b

33−setFailure e (Failure _ a b) = Failure e a b

33+setFailure e (Invalid _ a b) = Invalid e a b

34

35modFailure :: (a -> b) -> Failure a -> Failure b

36−modFailure f v@(Failure a _ _) = v { _failureValidatorsCalled = f a }

36+modFailure f v@(Invalid a _ _) = v { _invalidValidatorsCalled = f a }

37

38addToPath :: P.Token -> Failure a -> Failure a

39−addToPath tok v@(Failure _ _ a) = v { _failureOffendingData = addToken a }

39+addToPath tok v@(Invalid _ _ a) = v { _invalidOffendingData = addToken a }

40 where

41 addToken :: P.Pointer -> P.Pointer

42 addToken (P.Pointer ts) = P.Pointer (ts <> pure tok)

src/Data/Validator/Reference.hs+2−2

@@ -1,6 +1,4 @@

1

2−module Data.Validator.Reference where

3−

4-- | JSON Reference is described here:

2-- | JSON Reference is described here:

5-- <http://tools.ietf.org/html/draft-pbryan-zyp-json-ref-03>

3-- <http://tools.ietf.org/html/draft-pbryan-zyp-json-ref-03>

6--

4--

@@ -19,6 +17,8 @@ module Data.Validator.Reference where

19-- * 'Data.Validator.Draft4.Any.ref' uses 'resolveReference' and

17-- * 'Data.Validator.Draft4.Any.ref' uses 'resolveReference' and

20-- 'resolveFragment'.

18-- 'resolveFragment'.

21

19

20+module Data.Validator.Reference where

21+

22import qualified Data.Aeson.Pointer as P

23import qualified Data.Text as T

24import Data.Text.Encoding

test/Local/Failure.hs+2−2

@@ -19,7 +19,7 @@ correctPaths =

19itemsObject :: IO ()

20itemsObject = HU.assertEqual "Path to invalid data"

21 (P.Pointer [P.Token "0"])

22− (_failureOffendingData failure)

22+ (_invalidOffendingData failure)

23 where

24 [failure] = runValidate (ReferencedSchemas schema mempty)

25 sw (toJSON [[True, True]])

@@ -38,7 +38,7 @@ itemsObject = HU.assertEqual "Path to invalid data"

38itemsArray :: IO ()

39itemsArray = HU.assertEqual "Path to invalid data"

40 (P.Pointer [P.Token "0"])

41− (_failureOffendingData failure)

41+ (_invalidOffendingData failure)

42 where

43 [failure] = runValidate (ReferencedSchemas schema mempty)

44 sw (toJSON [[True, True]])

test/Shared.hs+2−2

@@ -75,7 +75,7 @@ toTest st =

75 then assertValid sc res

76 else assertInvalid sc res

77

78−assertValid :: SchemaTestCase -> [D4.Failure] -> HU.Assertion

78+assertValid :: SchemaTestCase -> [D4.Invalid] -> HU.Assertion

79assertValid _ [] = pure ()

80assertValid sc errs =

81 HU.assertFailure $ unlines

@@ -85,7 +85,7 @@ assertValid sc errs =

85 , " Validation failures: " <> show errs

86 ]

87

88−assertInvalid :: SchemaTestCase -> [D4.Failure] -> HU.Assertion

88+assertInvalid :: SchemaTestCase -> [D4.Invalid] -> HU.Assertion

89assertInvalid sc [] =

90 HU.assertFailure $ unlines

91 [ " Validated invalid data"