generate a value schema as well

This commit is contained in:
Tom Sydney Kerckhove 2021-11-01 16:56:56 +01:00
parent cf7f92f50b
commit de9fc92a9d
2 changed files with 6 additions and 2 deletions

View File

@ -55,9 +55,12 @@ data JSONSchema
JSONSchema JSONSchema
| CommentSchema !Text !JSONSchema | CommentSchema !Text !JSONSchema
| RefSchema !Text | RefSchema !Text
| WithDefSchema !(Map Text JSONSchema) JSONSchema | WithDefSchema !(Map Text JSONSchema) !JSONSchema
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
-- NOTE, this is a recursive schema so we've had to manually write our generators for it.
-- If you add any constructors here, make sure to go add the constructor to the GenValid instance as well.
validateAccordingTo :: JSON.Value -> JSONSchema -> Bool validateAccordingTo :: JSON.Value -> JSONSchema -> Bool
validateAccordingTo val schema = (`evalState` M.empty) $ go val schema validateAccordingTo val schema = (`evalState` M.empty) $ go val schema
where where
@ -219,7 +222,7 @@ instance FromJSON JSONSchema where
case mAny of case mAny of
Just anies -> pure $ ChoiceSchema anies Just anies -> pure $ ChoiceSchema anies
Nothing -> do Nothing -> do
mConst <- o JSON..:? "const" let mConst = HM.lookup "const" o
case mConst of case mConst of
Just constant -> pure $ ValueSchema constant Just constant -> pure $ ValueSchema constant
Nothing -> do Nothing -> do

View File

@ -100,6 +100,7 @@ instance GenValid JSONSchema where
oneof oneof
[ ArraySchema <$> resize (n -1) genValid, [ ArraySchema <$> resize (n -1) genValid,
(ObjectSchema <$> resize (n -1) genValid) `suchThat` isValid, (ObjectSchema <$> resize (n -1) genValid) `suchThat` isValid,
ValueSchema <$> genValid,
do do
(a, b, c) <- genSplit3 (n -1) (a, b, c) <- genSplit3 (n -1)
choice1 <- resize a genValid choice1 <- resize a genValid