@@ -1,38 +1,36 @@
11-- | Turn the validation functions into actual 'Validator's.
2−--
3−-- From this point on they know how to parse themselves from JSON
4−-- and also know how to extract subschemas embedded within themselves.
52
6−module Data.Validator.Draft4 where
3+module Data.Validator.Draft4
4+ ( module Data.Validator.Draft4
5+ , module Export
6+ ) where
77
8−import Prelude
98import Import
109
11−import Data.Aeson.Types (Parser)
1210import qualified Data.HashMap.Strict as HM
13−import Data.List.NonEmpty (NonEmpty)
1411import qualified Data.List.NonEmpty as NE
15−import Data.Maybe (catMaybes, isNothing,
16− maybe, maybeToList)
17−import Data.Scientific (Scientific)
12+import Data.Maybe (catMaybes, maybe, maybeToList)
1813import Data.Text (Text)
1914
20−import qualified Data.Validator.Draft4.Any as AN
21−import qualified Data.Validator.Draft4.Array as AR
22−import qualified Data.Validator.Draft4.Number as NU
23−import qualified Data.Validator.Draft4.Object as OB
24−import qualified Data.Validator.Draft4.String as ST
25−import Data.Validator.Failure (Fail(..))
15+import Data.Validator.Draft4.Any as Export
16+import Data.Validator.Draft4.Array as Export
17+import Data.Validator.Draft4.Number as Export
18+import Data.Validator.Draft4.Object as Export
19+import Data.Validator.Draft4.String as Export
2620import Data.Validator.Types (Validator(..))
2721import Data.Validator.Utils (fromJSONEither)
2822
2923-- | For internal use.
30−run :: FromJSON b => (a -> b -> [c]) -> Maybe a -> Value -> [c]
24+--
25+-- Take a validation function, a possibly existing validator, and some data.
26+-- If the validator is exists and can validate the type of data we have,
27+-- attempt to do so and return any failures.
28+run :: FromJSON b => (a -> b -> Maybe c) -> Maybe a -> Value -> [c]
3129run _ Nothing _ = mempty
3230run f (Just a) b =
3331 case fromJSONEither b of
3432 Left _ -> mempty
35− Right c -> f a c
33+ Right c -> maybeToList (f a c)
3634
3735-- | For internal use.
3836noEmbedded :: a -> ([b], [b])
@@ -42,190 +40,116 @@ noEmbedded = const (mempty, mempty)
4240-- * Numbers
4341--------------------------------------------------
4442
45−newtype MultipleOf
46− = MultipleOf { _unMultipleOf :: Scientific }
47− deriving (Eq, Show)
48−
49−instance FromJSON MultipleOf where
50− parseJSON = withObject "MultipleOf" $ \o ->
51− MultipleOf <$> o .: "multipleOf"
52−
53−multipleOf :: Validator a (Maybe MultipleOf) ()
54−multipleOf =
55− Validator
56− noEmbedded
57− (run (fmap maybeToList . NU.multipleOf . _unMultipleOf))
43+multipleOfValidator :: Validator a (Maybe MultipleOf) MultipleOfInvalid
44+multipleOfValidator = Validator noEmbedded (run multipleOfVal)
5845
59−data MaximumContext
60− = MaximumContext Bool Scientific
61− deriving (Eq, Show)
46+maximumValidator :: Validator a (Maybe Maximum) MaximumInvalid
47+maximumValidator = Validator noEmbedded (run maximumVal)
6248
63−instance FromJSON MaximumContext where
64− parseJSON = withObject "MaximumContext" $ \o -> MaximumContext
65− <$> o .:! "exclusiveMaximum" .!= False
66− <*> o .: "maximum"
67−
68−maximumVal :: Validator a (Maybe MaximumContext) NU.MaximumInvalid
69−maximumVal =
70− Validator
71− noEmbedded
72− (run (\(MaximumContext a b) -> maybeToList . NU.maximumVal a b))
73−
74−data MinimumContext
75− = MinimumContext Bool Scientific
76− deriving (Eq, Show)
77−
78−instance FromJSON MinimumContext where
79− parseJSON = withObject "MinimumContext" $ \o -> MinimumContext
80− <$> o .:! "exclusiveMinimum" .!= False
81− <*> o .: "minimum"
82−
83−minimumVal :: Validator a (Maybe MinimumContext) NU.MinimumInvalid
84−minimumVal =
85− Validator
86− noEmbedded
87− (run (\(MinimumContext a b) -> maybeToList . NU.minimumVal a b))
49+minimumValidator :: Validator a (Maybe Minimum) MinimumInvalid
50+minimumValidator = Validator noEmbedded (run minimumVal)
8851
8952--------------------------------------------------
9053-- * Strings
9154--------------------------------------------------
9255
93−newtype MaxLength
94− = MaxLength { _unMaxLength :: Int }
95− deriving (Eq, Show)
56+maxLengthValidator :: Validator a (Maybe MaxLength) MaxLengthInvalid
57+maxLengthValidator = Validator noEmbedded (run maxLengthVal)
9658
97−instance FromJSON MaxLength where
98− parseJSON = withObject "MaxLength" $ \o ->
99− MaxLength <$> o .: "maxLength"
59+minLengthValidator :: Validator a (Maybe MinLength) MinLengthInvalid
60+minLengthValidator = Validator noEmbedded (run minLengthVal)
10061
101−maxLength :: Validator a (Maybe MaxLength) ()
102−maxLength =
103− Validator
104− noEmbedded
105− (run (fmap maybeToList . ST.maxLength . _unMaxLength))
106−
107−newtype MinLength
108− = MinLength { _unMinLength :: Int }
109− deriving (Eq, Show)
110−
111−instance FromJSON MinLength where
112− parseJSON = withObject "MinLength" $ \o ->
113− MinLength <$> o .: "minLength"
114−
115−minLength :: Validator a (Maybe MinLength) ()
116−minLength =
117− Validator
118− noEmbedded
119− (run (fmap maybeToList . ST.minLength . _unMinLength))
120−
121−newtype PatternVal
122− = PatternVal { _unPatternVal :: Text }
123− deriving (Eq, Show)
124−
125−instance FromJSON PatternVal where
126− parseJSON = withObject "PatternVal" $ \o ->
127− PatternVal <$> o .: "pattern"
128−
129−patternVal :: Validator a (Maybe PatternVal) ()
130−patternVal =
131− Validator
132− noEmbedded
133− (run (fmap maybeToList . ST.patternVal . _unPatternVal))
62+patternValidator :: Validator a (Maybe PatternValidator) PatternInvalid
63+patternValidator = Validator noEmbedded (run patternVal)
13464
13565--------------------------------------------------
13666-- * Arrays
13767--------------------------------------------------
13868
139−newtype MaxItems
140− = MaxItems { _unMaxItems :: Int }
141− deriving (Eq, Show)
142−
143−instance FromJSON MaxItems where
144− parseJSON = withObject "MaxItems" $ \o ->
145− MaxItems <$> o .: "maxItems"
146−
147−maxItems :: Validator a (Maybe MaxItems) ()
148−maxItems =
149− Validator
150− noEmbedded
151− (run (fmap maybeToList . AR.maxItems . _unMaxItems))
152−
153−newtype MinItems
154− = MinItems { _unMinItems :: Int }
155− deriving (Eq, Show)
156−
157−instance FromJSON MinItems where
158− parseJSON = withObject "MinItems" $ \o ->
159− MinItems <$> o .: "minItems"
160−
161−minItems :: Validator a (Maybe MinItems) ()
162−minItems =
163− Validator
164− noEmbedded
165− (run (fmap maybeToList . AR.minItems . _unMinItems))
166−
167−newtype UniqueItems
168− = UniqueItems { _unUniqueItems :: Bool }
169− deriving (Eq, Show)
69+maxItemsValidator :: Validator a (Maybe MaxItems) MaxItemsInvalid
70+maxItemsValidator = Validator noEmbedded (run maxItemsVal)
71+
72+minItemsValidator :: Validator a (Maybe MinItems) MinItemsInvalid
73+minItemsValidator = Validator noEmbedded (run minItemsVal)
74+
75+uniqueItemsValidator :: Validator a (Maybe UniqueItems) UniqueItemsInvalid
76+uniqueItemsValidator = Validator noEmbedded (run uniqueItemsVal)
77+
78+itemsRelatedValidator
79+ :: (schema -> Value -> [err])
80+ -> Validator schema (ItemsRelated schema) (ItemsRelatedInvalid err)
81+itemsRelatedValidator f =
82+ Validator
83+ (\a -> ( mempty
84+ , case _irItems a of
85+ Just (ItemsObject b) -> pure b
86+ Just (ItemsArray cs) -> cs
87+ Nothing -> mempty
88+ <> case _irAdditional a of
89+ Just (AdditionalObject b) -> pure b
90+ _ -> mempty
91+ ))
92+ (\a b -> case fromJSONEither b of
93+ Left _ -> mempty
94+ Right c -> itemsRelatedVal f a c)
17095
171−instance FromJSON UniqueItems where
172− parseJSON = withObject "UniqueItems" $ \o ->
173− UniqueItems <$> o .: "uniqueItems"
96+--------------------------------------------------
97+-- * Objects
98+--------------------------------------------------
17499
175−uniqueItems :: Validator a (Maybe UniqueItems) ()
176−uniqueItems =
177− Validator
178− noEmbedded
179− (run (fmap maybeToList . AR.uniqueItems . _unUniqueItems))
100+maxPropertiesValidator
101+ :: Validator
102+ a
103+ (Maybe MaxProperties)
104+ MaxPropertiesInvalid
105+maxPropertiesValidator = Validator noEmbedded (run maxPropertiesVal)
180106
181−data ItemsContext schema =
182− ItemsContext
183− (Maybe (AR.AdditionalItems schema))
184− (AR.Items schema)
185− deriving (Eq, Show)
107+minPropertiesValidator
108+ :: Validator
109+ a
110+ (Maybe MinProperties)
111+ MinPropertiesInvalid
112+minPropertiesValidator = Validator noEmbedded (run minPropertiesVal)
186113
187−instance FromJSON schema => FromJSON (ItemsContext schema) where
188− parseJSON = withObject "ItemsContext" $ \o -> ItemsContext
189− <$> o .:! "additionalItems"
190− <*> o .: "items"
114+requiredValidator :: Validator a (Maybe Required) ()
115+requiredValidator = Validator noEmbedded (run requiredVal)
191116
192−items
193− :: (schema -> Value -> [Fail err])
194− -> Validator schema (Maybe (ItemsContext schema)) (AR.ItemsInvalid err)
195−items f =
117+dependenciesValidator
118+ :: (schema -> Value -> [err])
119+ -> Validator
120+ schema
121+ (Maybe (DependenciesValidator schema))
122+ (DependenciesInvalid err)
123+dependenciesValidator f =
196124 Validator
197− (\a -> case a of
198− Nothing -> mempty
199− Just (ItemsContext _ b) ->
200− case b of
201− AR.ItemsObject c -> (mempty, pure c)
202− AR.ItemsArray cs -> (mempty, cs))
203− (run (\(ItemsContext a b) -> AR.items f a b))
204−
205−newtype AdditionalItemsContext schema
206− = AdditionalItemsContext
207− { _unAdditionalItemsContext :: AR.AdditionalItems schema }
208− deriving (Eq, Show)
209−
210−instance FromJSON schema => FromJSON (AdditionalItemsContext schema) where
211− parseJSON = withObject "AdditionalItemsContext" $ \o ->
212− AdditionalItemsContext <$> o .: "additionalItems"
125+ (maybe mempty ( (\a -> (mempty, a))
126+ . catMaybes . fmap checkDependency
127+ . HM.elems . _unDependenciesValidator
128+ ))
129+ (run (dependenciesVal f))
130+ where
131+ checkDependency :: Dependency schema -> Maybe schema
132+ checkDependency (PropertyDependency _) = Nothing
133+ checkDependency (SchemaDependency s) = Just s
213134
214−-- | Since 'items' will always take care of validating 'additionalItems'
215−-- as well, the actual validation side of 'additionalItemsEmbedded' is
216−-- disabled.
217−additionalItemsEmbedded
218− :: Validator
135+propertiesRelatedValidator
136+ :: (schema -> Value -> [err])
137+ -> Validator
219138 schema
220− (Maybe (AdditionalItemsContext schema))
221− err
222−additionalItemsEmbedded=
223− Validator
224− (\a -> case a of
225− Just (AdditionalItemsContext (AR.AdditionalObject b)) ->
226− (mempty, pure b)
227− _ -> (mempty, mempty))
228− (const (const mempty))
139+ (PropertiesRelated schema)
140+ (PropertiesRelatedInvalid err)
141+propertiesRelatedValidator f =
142+ Validator
143+ (\a -> ( mempty
144+ , HM.elems (fromMaybe mempty (_propProperties a))
145+ <> HM.elems (fromMaybe mempty (_propPattern a))
146+ <> case _propAdditional a of
147+ Just (AdditionalPropertiesObject b) -> [b]
148+ _ -> mempty
149+ ))
150+ (\a b -> case fromJSONEither b of
151+ Left _ -> mempty
152+ Right c -> maybeToList (propertiesRelatedVal f a c))
229153
230154newtype Definitions schema
231155 = Definitions { _unDefinitions :: HashMap Text schema }
@@ -235,11 +159,9 @@ instance FromJSON schema => FromJSON (Definitions schema) where
235159 parseJSON = withObject "Definitions" $ \o ->
236160 Definitions <$> o .: "definitions"
237161
238−-- | Placing this here since it's similar to @"additionalItems"@.
239−-- in that its validator doesn't run.
240−--
241−-- TODO: Add tests to the language agnostic test suite for both
242−-- @"additionalItems"@ and this.
162+-- TODO: Add tests to the language agnostic test suite to
163+-- make sure these schemas are embedded correctly
164+-- (and do so for @"additionalItems"@ as well).
243165definitionsEmbedded
244166 :: Validator
245167 schema
@@ -252,299 +174,69 @@ definitionsEmbedded =
252174 Nothing -> (mempty, mempty))
253175 (const (const mempty))
254176
255−--------------------------------------------------
256−-- * Objects
257−--------------------------------------------------
258−
259−newtype MaxProperties
260− = MaxProperties { _unMaxProperties :: Int }
261− deriving (Eq, Show)
262−
263−instance FromJSON MaxProperties where
264− parseJSON = withObject "MaxProperties" $ \o ->
265− MaxProperties <$> o .: "maxProperties"
266−
267−maxProperties :: Validator a (Maybe MaxProperties) ()
268−maxProperties =
269− Validator
270− noEmbedded
271− (run (fmap maybeToList . OB.maxProperties . _unMaxProperties))
272−
273−newtype MinProperties
274− = MinProperties { _unMinProperties :: Int }
275− deriving (Eq, Show)
276−
277−instance FromJSON MinProperties where
278− parseJSON = withObject "MinProperties" $ \o ->
279− MinProperties <$> o .: "minProperties"
280−
281−minProperties :: Validator a (Maybe MinProperties) ()
282−minProperties =
283− Validator
284− noEmbedded
285− (run (fmap maybeToList . OB.minProperties . _unMinProperties))
286−
287−newtype RequiredContext
288− = RequiredContext { _unRequiredContext :: OB.Required }
289− deriving (Eq, Show)
290−
291−instance FromJSON RequiredContext where
292− parseJSON = withObject "RequiredContext" $ \o ->
293− RequiredContext <$> o .: "required"
294−
295−required :: Validator a (Maybe RequiredContext) ()
296−required =
297− Validator
298− noEmbedded
299− (run (fmap maybeToList . OB.required . _unRequiredContext))
300−
301−newtype DependenciesContext schema
302− = DependenciesContext
303− { _unDependenciesContext :: HashMap Text (OB.Dependency schema) }
304− deriving (Eq, Show)
305−
306−instance FromJSON schema => FromJSON (DependenciesContext schema) where
307− parseJSON = withObject "DependenciesContext" $ \o ->
308− DependenciesContext <$> o .: "dependencies"
309−
310−dependencies
311− :: (schema -> Value -> [Fail err])
312− -> Validator
313− schema
314− (Maybe (DependenciesContext schema))
315− (OB.DependencyInvalid err)
316−dependencies f =
317− Validator
318− (maybe mempty ( (\a -> (mempty, a))
319− . catMaybes . fmap checkDependency
320− . HM.elems . _unDependenciesContext
321− ))
322− (run (OB.dependencies f . _unDependenciesContext))
323− where
324− checkDependency :: OB.Dependency schema -> Maybe schema
325− checkDependency (OB.PropertyDependency _) = Nothing
326− checkDependency (OB.SchemaDependency s) = Just s
327−
328−data PropertiesContext schema
329− = PropertiesContext
330− (Maybe (HashMap Text schema))
331− (Maybe (OB.AdditionalProperties schema))
332− (HashMap Text schema)
333− deriving (Eq, Show)
334−
335−instance FromJSON schema => FromJSON (PropertiesContext schema) where
336− parseJSON = withObject "PropertiesContext" $ \o -> PropertiesContext
337− <$> o .:! "patternProperties"
338− <*> o .:! "additionalProperties"
339− <*> o .: "properties"
340−
341−properties
342− :: (schema -> Value -> [Fail err])
343− -> Validator
344− schema
345− (Maybe (PropertiesContext schema))
346− (OB.PropertiesInvalid err)
347−properties f =
348− Validator
349− (\a -> case a of
350− Just (PropertiesContext _ _ b) -> (mempty, HM.elems b)
351− Nothing -> (mempty, mempty))
352− (run (\(PropertiesContext a b c) -> OB.properties f a b c))
353−
354−-- | The first argument is whether the validator should be run.
355−-- If @"properties"@ exists it will be parsed to 'False'.
356−data PatternPropertiesContext schema
357− = PatternPropertiesContext
358− Bool
359− (Maybe (OB.AdditionalProperties schema))
360− (HashMap Text schema)
361− deriving (Eq, Show)
362−
363−instance FromJSON schema => FromJSON (PatternPropertiesContext schema) where
364− parseJSON = withObject "PatternPropertiesContext" $ \o ->
365− PatternPropertiesContext
366− <$> shouldRun o
367− <*> o .:! "additionalProperties"
368− <*> o .: "patternProperties"
369− where
370− shouldRun :: HashMap Text Value -> Parser Bool
371− shouldRun o = do
372− a <- o .:! "properties"
373− pure $ isNothing (a :: Maybe (HashMap Text schema))
374−
375−patternProperties
376− :: (schema -> Value -> [Fail err])
377− -> Validator
378− schema
379− (Maybe (PatternPropertiesContext schema))
380− (OB.PatternPropertiesInvalid err)
381−patternProperties f =
382− Validator
383− (\a -> case a of
384− Just (PatternPropertiesContext _ _ b) -> (mempty, HM.elems b)
385− Nothing -> (mempty, mempty))
386− (run (\(PatternPropertiesContext a b c) -> OB.patternProperties f a b c))
387−
388−-- | The first argument is whether the validator should be run.
389−-- If @"properties"@ or @"patternProperties"@ exist it will be parsed
390−-- to 'False'.
391−data AdditionalPropertiesContext schema
392− = AdditionalPropertiesContext
393− Bool
394− (OB.AdditionalProperties schema)
395− deriving (Eq, Show)
396−
397−instance FromJSON schema => FromJSON (AdditionalPropertiesContext schema) where
398− parseJSON = withObject "AdditionalPropertiesContext" $ \o ->
399− AdditionalPropertiesContext
400− <$> shouldRun o
401− <*> o .: "additionalProperties"
402− where
403− shouldRun :: HashMap Text Value -> Parser Bool
404− shouldRun o = do
405− a <- o .:! "properties"
406− b <- o .:! "patternProperties"
407− pure $ isNothing (a :: Maybe (HashMap Text schema))
408− && isNothing (b :: Maybe (HashMap Text schema))
409−
410−additionalProperties
411− :: (schema -> Value -> [Fail err])
412− -> Validator
413− schema
414− (Maybe (AdditionalPropertiesContext schema))
415− (OB.AdditionalPropertiesInvalid err)
416−additionalProperties f =
417− Validator
418− (\a -> case a of
419− Nothing -> mempty
420− Just (AdditionalPropertiesContext _ b) ->
421− case b of
422− OB.AdditionalPropertiesBool _ -> (mempty, mempty)
423− OB.AdditionalPropertiesObject c -> (mempty, pure c))
424− (run (\(AdditionalPropertiesContext a b) -> OB.additionalProperties f a b))
425−
426177--------------------------------------------------
427178-- * Any
428179--------------------------------------------------
429180
430−newtype Ref
431− = Ref { _unRef :: Text }
432− deriving (Eq, Show)
433−
434−instance FromJSON Ref where
435− parseJSON = withObject "Ref" $ \o ->
436− Ref <$> o .: "$ref"
437−
438−ref
181+refValidator
439182 :: (FromJSON schema, ToJSON schema)
440− => AN.VisitedSchemas
183+ => VisitedSchemas
441184 -> Maybe Text
442185 -> (Maybe Text -> Maybe schema)
443− -> (AN.VisitedSchemas -> Maybe Text -> schema -> Value -> [Fail err])
444− -> Validator a (Maybe Ref) (AN.RefInvalid err)
445−ref visited scope getRef f =
186+ -> (VisitedSchemas -> Maybe Text -> schema -> Value -> [err])
187+ -> Validator a (Maybe Ref) (RefInvalid err)
188+refValidator visited scope getRef f =
446189 Validator
447190 noEmbedded
448− (run (AN.ref visited scope getRef f . _unRef))
191+ (run (refVal visited scope getRef f))
449192
450−newtype EnumContext
451− = EnumContext { _unEnumContext :: AN.EnumVal }
452− deriving (Eq, Show)
193+enumValidator :: Validator a (Maybe EnumValidator) EnumInvalid
194+enumValidator = Validator noEmbedded (run enumVal)
453195
454−instance FromJSON EnumContext where
455− parseJSON = withObject "EnumContext" $ \o ->
456− EnumContext <$> o .: "enum"
196+typeValidator :: Validator a (Maybe TypeContext) TypeValidatorInvalid
197+typeValidator = Validator noEmbedded (run typeVal)
457198
458−enumVal :: Validator a (Maybe EnumContext) ()
459−enumVal =
460− Validator
461− noEmbedded
462− (run (fmap maybeToList . AN.enumVal . _unEnumContext))
463−
464−newtype TypeContext
465− = TypeContext { _unTypeContext :: AN.TypeVal }
466− deriving (Eq, Show)
467−
468−instance FromJSON TypeContext where
469− parseJSON = withObject "TypeContext" $ \o ->
470− TypeContext <$> o .: "type"
471−
472−typeVal :: Validator a (Maybe TypeContext) ()
473−typeVal =
474− Validator
475− noEmbedded
476− (run (fmap maybeToList . AN.typeVal . _unTypeContext))
477−
478−newtype AllOf schema
479− = AllOf { _unAllOf :: NonEmpty schema }
480− deriving (Eq, Show)
481−
482−instance FromJSON schema => FromJSON (AllOf schema) where
483− parseJSON = withObject "AllOf" $ \o ->
484− AllOf <$> o .: "allOf"
485−
486−allOf
487− :: (schema -> Value -> [Fail err])
488− -> Validator schema (Maybe (AllOf schema)) err
489−allOf f =
199+allOfValidator
200+ :: (schema -> Value -> [err])
201+ -> Validator schema (Maybe (AllOf schema)) (AllOfInvalid err)
202+allOfValidator f =
490203 Validator
491204 (\a -> case a of
492205 Just (AllOf b) -> (NE.toList b, mempty)
493206 Nothing -> (mempty, mempty))
494− (run (AN.allOf f . _unAllOf))
495−
496−newtype AnyOf schema
497− = AnyOf { _unAnyOf :: NonEmpty schema }
498− deriving (Eq, Show)
207+ (run (allOfVal f))
499208
500−instance FromJSON schema => FromJSON (AnyOf schema) where
501− parseJSON = withObject "AnyOf" $ \o ->
502− AnyOf <$> o .: "anyOf"
503−
504−anyOf
505− :: (schema -> Value -> [Fail err])
506− -> Validator schema (Maybe (AnyOf schema)) err
507−anyOf f =
209+anyOfValidator
210+ :: (schema -> Value -> [err])
211+ -> Validator schema (Maybe (AnyOf schema)) (AnyOfInvalid err)
212+anyOfValidator f =
508213 Validator
509214 (\a -> case a of
510215 Just (AnyOf b) -> (NE.toList b, mempty)
511216 Nothing -> (mempty, mempty))
512− (run (AN.anyOf f . _unAnyOf))
513−
514−newtype OneOf schema
515− = OneOf { _unOneOf :: NonEmpty schema }
516− deriving (Eq, Show)
217+ (run (anyOfVal f))
517218
518−instance FromJSON schema => FromJSON (OneOf schema) where
519− parseJSON = withObject "OneOf" $ \o ->
520− OneOf <$> o .: "oneOf"
521−
522−oneOf
219+oneOfValidator
523220 :: ToJSON schema
524− => (schema -> Value -> [Fail err])
525− -> Validator schema (Maybe (OneOf schema)) (AN.OneOfInvalid err)
526−oneOf f =
221+ => (schema -> Value -> [err])
222+ -> Validator schema (Maybe (OneOf schema)) (OneOfInvalid err)
223+oneOfValidator f =
527224 Validator
528225 (\a -> case a of
529226 Just (OneOf b) -> (NE.toList b, mempty)
530227 Nothing -> (mempty, mempty))
531− (run (AN.oneOf f . _unOneOf))
228+ (run (oneOfVal f))
532229
533−newtype NotVal schema
534− = NotVal { _unNotVal :: schema }
535− deriving (Eq, Show)
536−
537−instance FromJSON schema => FromJSON (NotVal schema) where
538− parseJSON = withObject "NotVal" $ \o ->
539− NotVal <$> o .: "not"
540−
541−notVal
230+notValidator
542231 :: ToJSON schema
543− => (schema -> Value -> [Fail err])
544− -> Validator schema (Maybe (NotVal schema)) ()
545−notVal f =
232+ => (schema -> Value -> [err])
233+ -> Validator
234+ schema
235+ (Maybe (NotValidator schema))
236+ NotValidatorInvalid
237+notValidator f =
546238 Validator
547239 (\a -> case a of
548− Just (NotVal b) -> (pure b, mempty)
549− Nothing -> (mempty, mempty))
550− (run (fmap maybeToList . AN.notVal f . _unNotVal))
240+ Just (NotValidator b) -> (pure b, mempty)
241+ Nothing -> (mempty, mempty))
242+ (run (notVal f))