8fa07b5 · typeable/hjsonschema

git.iko.soy/typeable/hjsonschema

Rename Failure to Invalid.

Before we had two data types named Failure, a general one taking a type argument for the types of errors a schema could return, and a specialized one for Draft4 without a type argument. Otherwise they were identical. Now just use the one Failure type throughout the library, and remove the otherwise identical data type for Draft4. Instead export a type alias from Draft4.hs called Invalid which is Failure specialized for Draft4.

commit8fa07b530b9245c10a5bc0203739d5eca1934d83 authorIan Grant Jeffries <ian@housejeffries.com> dateFri 6 May 2016, 12:11 (10 years ago) parent7397fd4

16 files changed+78−104

compare with master

unifiedsplit

examples/CustomSchema.hs+2−2

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

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

2424oddLength b t

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

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

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

2727

2828data CustomError

2929 = MaxLength

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

5858example =

5959 case validate schema badData of

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

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

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

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

6363 where

6464 schema :: Schema

examples/PrettyShowFailure.hs+10−10

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

1111badData :: Value

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

1313

14−failure :: D4.Failure

15−failure = D4.Failure

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

17− , D4._failureFinalValidator = Number 2

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

14+failure :: D4.Invalid

15+failure = D4.Invalid

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

17+ , D4._invalidFinalValidator = Number 2

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

1919 }

2020

2121example :: IO ()

2222example =

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

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

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

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

2626 --

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

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

3333 --

3434 -- 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

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

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

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

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

4242msg subsetOfData = unlines

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

4444 , ""

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

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

4646 , ""

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

4848 , ""

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

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

5050 , ""

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

5252 , ""

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

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

5454 , ""

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

5656 , ""

examples/Standard.hs+1−1

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

3737

3838 case validate badData of

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

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

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

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

4242

4343 where

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

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

2020 , referencesViaFilesystem

2121

2222 -- * Failure

23− , Failure(..)

23+ , Invalid

24+ , FR.Failure(..)

2425 , ValidatorChain(..)

2526

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

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

4041import qualified Data.List.NonEmpty as N

4142import Data.Maybe (fromMaybe)

4243

43−import Data.JsonSchema.Draft4.Failure

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

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

4546import Data.JsonSchema.Draft4.Schema

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

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

4849 ReferencedSchemas(..),

4950 SchemaWithURI(..))

5051import qualified Data.JsonSchema.Fetch as FE

52+import qualified Data.Validator.Failure as FR

5153

5254data HTTPValidationFailure

5355 = HVRequest HTTPFailure

54− | HVSchema (NonEmpty Failure)

55− | HVData (NonEmpty Failure)

56+ | HVSchema (NonEmpty Invalid)

57+ | HVData (NonEmpty Invalid)

5658 deriving Show

5759

5860fetchHTTPAndValidate

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

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

6567 where

6668 f :: ReferencedSchemas Schema

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

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

6870 f references = left HVSchema (checkSchema references sw)

6971

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

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

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

7274 Nothing -> Right ()

7375 Just failures -> Left (HVData failures)

7476

7577data FilesystemValidationFailure

7678 = FVRead FilesystemFailure

77− | FVSchema (NonEmpty Failure)

78− | FVData (NonEmpty Failure)

79+ | FVSchema (NonEmpty Invalid)

80+ | FVData (NonEmpty Invalid)

7981 deriving Show

8082

8183fetchFilesystemAndValidate

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

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

8890 where

8991 f :: ReferencedSchemas Schema

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

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

9193 f references = left FVSchema (checkSchema references sw)

9294

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

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

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

9597 Nothing -> Right ()

9698 Just failures -> Left (FVData failures)

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

99101checkSchema

100102 :: ReferencedSchemas Schema

101103 -> SchemaWithURI Schema

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

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

103105checkSchema referenced schemaWithURI =

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

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

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

120122

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

122124-- 'schemaValidity' and 'runValidate'.

123−schemaValidity :: Schema -> [Failure]

125+schemaValidity :: Schema -> [Invalid]

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

125127 where

126128 d4 :: Schema

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

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

22module Data.JsonSchema.Draft4.Failure where

4−import qualified Data.Aeson.Pointer as P

5−

64import 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)

195

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

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

6+type Invalid = FR.Failure ValidatorChain

227

238data ValidatorChain

249 = MultipleOf

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

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

7070 checkDependency (OB.PropertyDependency _) = Nothing

7171 checkDependency (OB.SchemaDependency s) = Just s

7272

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−

8673--------------------------------------------------

8774-- * Validation (Main internal functions)

8875--------------------------------------------------

8976

90−validateAny

77+runValidate

9178 :: ReferencedSchemas Schema

9279 -> SchemaWithURI Schema

9380 -> Value

94− -> [FR.Failure ValidatorChain]

95−validateAny referenced sw x = concat

81+ -> [Invalid]

82+runValidate referenced sw x = concat

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

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

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

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

10289 , refFailures

10390 ] <> specificValidators

10491 where

105− specificValidators :: [FR.Failure ValidatorChain]

92+ specificValidators :: [Invalid]

10693 specificValidators =

10794 case x of

10895 Number y -> validateNumber (_swSchema sw) y

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

120107 --

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

122109 -- if resolving the reference itself failed.

123− refFailures :: [FR.Failure ValidatorChain]

110+ refFailures :: [Invalid]

124111 refFailures =

125112 case _schemaRef (_swSchema sw) of

126113 Nothing -> mempty

127114 Just reference ->

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

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

129116 (fmap (modFailure Ref))

130117 $ AN.ref scope

131118 getReference

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

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

133120 reference

134121 x

135122 where

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

143130validateString

144131 :: Schema

145132 -> Text

146− -> [FR.Failure ValidatorChain]

133+ -> [Invalid]

147134validateString schema x = concat

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

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

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

155142validateNumber

156143 :: Schema

157144 -> Scientific

158− -> [FR.Failure ValidatorChain]

145+ -> [Invalid]

159146validateNumber schema x = concat

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

161148 , f _schemaMaximum

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

182169 :: ReferencedSchemas Schema

183170 -> SchemaWithURI Schema

184171 -> Vector Value

185− -> [FR.Failure ValidatorChain]

172+ -> [Invalid]

186173validateArray referenced (SchemaWithURI schema mUri) x = concat

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

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

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

204191 :: ReferencedSchemas Schema

205192 -> SchemaWithURI Schema

206193 -> HashMap Text Value

207− -> [FR.Failure ValidatorChain]

194+ -> [Invalid]

208195validateObject referenced (SchemaWithURI schema mUri) x = concat

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

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

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

262249 -> SchemaWithURI Schema

263250 -> Schema

264251 -> Value

265− -> [FR.Failure ValidatorChain]

252+ -> [Invalid]

266253descendNextLevel referenced (SchemaWithURI schema mUri) =

267− validateAny referenced . flip SchemaWithURI scope

254+ runValidate referenced . flip SchemaWithURI scope

268255 where

269256 scope :: Maybe Text

270257 scope = updateResolutionScope mUri (_schemaId schema)

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

273260 :: Schema

274261 -> dta

275262 -> (Schema -> Maybe val)

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

263+ -> (err -> Invalid)

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

278− -> [FR.Failure ValidatorChain]

265+ -> [Invalid]

279266runSingle schema dta field modifyError validate =

280267 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

8484 | not (allUniqueValues' vs) = Nothing

8585 | x `elem` vs = Nothing

8686 | otherwise =

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

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

8888

8989--------------------------------------------------

9090-- * type

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

114114

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

116116isJsonType 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)

118118 | otherwise = Nothing

119119 where

120120 okTypes :: Set Text

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

149149 -> Maybe (Failure ())

150150anyOf f subSchemas x

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

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

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

153153

154154oneOf

155155 :: forall err schema. ToJSON schema

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

159159 -> Maybe (Failure ())

160160oneOf f subSchemas x

161161 | length successes == 1 = Nothing

162− | otherwise = Just $ Failure ()

162+ | otherwise = Just $ Invalid ()

163163 (toJSON (NonEmpty' subSchemas))

164164 mempty

165165 where

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

174174 -> Maybe (Failure ())

175175notVal f schema x =

176176 case f schema x of

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

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

178178 _ -> Nothing

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

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

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

1616maxItems n xs

1717 | n < 0 = Nothing

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

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

1919 | otherwise = Nothing

2020

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

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

2323minItems n xs

2424 | n < 0 = Nothing

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

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

2626 | otherwise = Nothing

2727

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

2929uniqueItems True xs

3030 | allUniqueValues xs = Nothing

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

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

3232uniqueItems False _ = Nothing

3333

3434--------------------------------------------------

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

107107 correctIndexes

108108 :: Failure (AdditionalItemsFailure err)

109109 -> 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)

111111 where

112112 fixIndex :: P.Pointer -> P.Pointer

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

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

157157 -> [Failure (AdditionalItemsFailure err)]

158158additionalItems _ (AdditionalBool b) xs

159159 | b = mempty

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

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

161161 | otherwise = mempty

162162additionalItems f (AdditionalObject subSchema) xs =

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

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

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

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

1212multipleOf n x

1313 | n <= 0 = Nothing

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

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

1515 | otherwise = Nothing

1616

1717data MaximumFailure

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

2525 -> Scientific

2626 -> Maybe (Failure MaximumFailure)

2727maximumVal exclusiveMaximum n x

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

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

2929 | otherwise = Nothing

3030 where

3131 (greaterThan, err) = if exclusiveMaximum

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

4343 -> Scientific

4444 -> Maybe (Failure MinimumFailure)

4545minimumVal exclusiveMinimum n x

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

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

4747 | otherwise = Nothing

4848 where

4949 (lessThan, err) = if exclusiveMinimum

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

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

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

2626maxProperties n x

2727 | n < 0 = Nothing

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

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

2929 | otherwise = Nothing

3030

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

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

3333minProperties n x

3434 | n < 0 = Nothing

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

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

3636 | otherwise = Nothing

3737

3838--------------------------------------------------

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

8080 -- instead of specialized versions.

8181 | S.null ts = Nothing

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

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

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

8484 where

8585 hm :: HashMap Text Bool

8686 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

138138 | otherwise = mempty

139139 g k (PropertyDependency ts)

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

141− pure $ Failure PropertyDependencyFailure

141+ pure $ Invalid PropertyDependencyFailure

142142 (toJSON (H.singleton k ts))

143143 mempty

144144 | otherwise = mempty

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

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

179179 -> HashMap Text Value

180180 -> [Failure (AdditionalPropertiesFailure err)]

181181additionalProperties _ (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

183183 | otherwise = mempty

184184additionalProperties _ (AdditionalPropertiesBool True) _ = mempty

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

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

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

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

1414maxLength n x

1515 | n <= 0 = Nothing

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

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

1717 | otherwise = Nothing

1818

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

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

2121minLength n x

2222 | n <= 0 = Nothing

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

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

2424 | otherwise = Nothing

2525

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

2727patternVal t x =

2828 case RE.compileM (encodeUtf8 t) mempty of

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

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

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

3131 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)

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

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

2525-- that sum type as its type argument.

26−data Failure err = Failure

27− { _failureValidatorsCalled :: !err

28− , _failureFinalValidator :: !Value

29− , _failureOffendingData :: !P.Pointer

26+data Failure err = Invalid

27+ { _invalidValidatorsCalled :: !err

28+ , _invalidFinalValidator :: !Value

29+ , _invalidOffendingData :: !P.Pointer

3030 } deriving (Eq, Show)

3131

3232setFailure :: 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

3434

3535modFailure :: (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 }

3737

3838addToPath :: 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 }

4040 where

4141 addToken :: P.Pointer -> P.Pointer

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

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

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

2−module Data.Validator.Reference where

3−

42-- | JSON Reference is described here:

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

64--

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

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

2018-- 'resolveFragment'.

2119

20+module Data.Validator.Reference where

21+

2222import qualified Data.Aeson.Pointer as P

2323import qualified Data.Text as T

2424import Data.Text.Encoding

test/Local/Failure.hs+2−2

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

1919itemsObject :: IO ()

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

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

22− (_failureOffendingData failure)

22+ (_invalidOffendingData failure)

2323 where

2424 [failure] = runValidate (ReferencedSchemas schema mempty)

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

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

3838itemsArray :: IO ()

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

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

41− (_failureOffendingData failure)

41+ (_invalidOffendingData failure)

4242 where

4343 [failure] = runValidate (ReferencedSchemas schema mempty)

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

test/Shared.hs+2−2

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

7575 then assertValid sc res

7676 else assertInvalid sc res

7777

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

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

7979assertValid _ [] = pure ()

8080assertValid sc errs =

8181 HU.assertFailure $ unlines

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

8585 , " Validation failures: " <> show errs

8686 ]

8787

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

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

8989assertInvalid sc [] =

9090 HU.assertFailure $ unlines

9191 [ " Validated invalid data"