Skip to content

Commit e57a16d

Browse files
committed
feat: add support for boolean form of schema
1 parent 75a6026 commit e57a16d

File tree

4 files changed

+167
-79
lines changed

4 files changed

+167
-79
lines changed

src/purs/JsonSchema.purs

Lines changed: 47 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module JsonSchema
66
, JsonSchemaObjectProperty
77
, JsonSchema(..)
88
, JsonStringSchemaSpec
9+
, ObjectFormJsonSchemaSpec(..)
910
, genSchema
1011
, genArraySchema
1112
, genIntegerSchema
@@ -30,6 +31,16 @@ import Data.NonEmpty ((:|))
3031
import Data.Show.Generic (genericShow)
3132

3233
data JsonSchema
34+
= BooleanFormJsonSchema Boolean
35+
| ObjectFormJsonSchema ObjectFormJsonSchemaSpec
36+
37+
derive instance Generic JsonSchema _
38+
derive instance Eq JsonSchema
39+
40+
instance Show JsonSchema where
41+
show schema = genericShow schema
42+
43+
data ObjectFormJsonSchemaSpec
3344
= JsonArraySchema JsonArraySchemaSpec
3445
| JsonBooleanSchema
3546
| JsonEmptySchema
@@ -39,10 +50,10 @@ data JsonSchema
3950
| JsonObjectSchema JsonObjectSchemaSpec
4051
| JsonStringSchema JsonStringSchemaSpec
4152

42-
derive instance Generic JsonSchema _
43-
derive instance Eq JsonSchema
53+
derive instance Generic ObjectFormJsonSchemaSpec _
54+
derive instance Eq ObjectFormJsonSchemaSpec
4455

45-
instance Show JsonSchema where
56+
instance Show ObjectFormJsonSchemaSpec where
4657
show schema = genericShow schema
4758

4859
type JsonArraySchemaSpec =
@@ -67,42 +78,58 @@ type JsonSchemaObjectProperty =
6778
, schema JsonSchema
6879
}
6980

81+
-- genSchema ∷ ∀ m. Lazy (m JsonSchema) ⇒ MonadGen m ⇒ m JsonSchema
82+
-- genSchema = genBooleanFormSchema <|> genObjectFormSchema
83+
7084
genSchema m. Lazy (m JsonSchema) MonadGen m m JsonSchema
71-
genSchema = Lazy.defer \_ → Gen.oneOf $ genBooleanSchema :|
72-
[ genArraySchema
73-
, genEmptySchema
74-
, genIntegerSchema
75-
, genNullSchema
76-
, genNumberSchema
77-
, genObjectSchema
78-
, genStringSchema
79-
]
85+
genSchema = Lazy.defer \_ →
86+
Gen.choose genBooleanFormSchema genObjectFormSchema
87+
88+
genBooleanFormSchema
89+
m. Lazy (m JsonSchema) MonadGen m m JsonSchema
90+
genBooleanFormSchema = Lazy.defer \_ →
91+
BooleanFormJsonSchema <$> Gen.chooseBool
92+
93+
genObjectFormSchema
94+
m. Lazy (m JsonSchema) MonadGen m m JsonSchema
95+
genObjectFormSchema = Lazy.defer \_ →
96+
Gen.oneOf $ genBooleanSchema :|
97+
[ genArraySchema
98+
, genEmptySchema
99+
, genIntegerSchema
100+
, genNullSchema
101+
, genNumberSchema
102+
, genObjectSchema
103+
, genStringSchema
104+
]
80105

81106
genArraySchema m. Lazy (m JsonSchema) MonadGen m m JsonSchema
82107
genArraySchema = do
83108
itemsSchema ← GenCommon.genMaybe genSchema
84109
uniqueItems ← Gen.chooseBool
85-
pure $ JsonArraySchema { itemsSchema, uniqueItems }
110+
pure
111+
$ ObjectFormJsonSchema
112+
$ JsonArraySchema { itemsSchema, uniqueItems }
86113

87114
genBooleanSchema m. MonadGen m m JsonSchema
88-
genBooleanSchema = pure JsonBooleanSchema
115+
genBooleanSchema = pure $ ObjectFormJsonSchema JsonBooleanSchema
89116

90117
genEmptySchema m. MonadGen m m JsonSchema
91-
genEmptySchema = pure JsonEmptySchema
118+
genEmptySchema = pure $ ObjectFormJsonSchema JsonEmptySchema
92119

93120
genIntegerSchema m. MonadGen m m JsonSchema
94-
genIntegerSchema = pure $ JsonIntegerSchema {}
121+
genIntegerSchema = pure $ ObjectFormJsonSchema $ JsonIntegerSchema {}
95122

96123
genNullSchema m. MonadGen m m JsonSchema
97-
genNullSchema = pure JsonNullSchema
124+
genNullSchema = pure $ ObjectFormJsonSchema JsonNullSchema
98125

99126
genNumberSchema m. MonadGen m m JsonSchema
100-
genNumberSchema = pure $ JsonNumberSchema {}
127+
genNumberSchema = pure $ ObjectFormJsonSchema $ JsonNumberSchema {}
101128

102129
genObjectSchema m. Lazy (m JsonSchema) MonadGen m m JsonSchema
103130
genObjectSchema = do
104131
properties ← genProperties
105-
pure $ JsonObjectSchema { properties }
132+
pure $ ObjectFormJsonSchema $ JsonObjectSchema { properties }
106133
where
107134
genProperties m (Map String JsonSchemaObjectProperty)
108135
genProperties = (Map.fromFoldable <<< List.singleton)
@@ -115,4 +142,4 @@ genObjectSchema = do
115142
pure { isRequired, schema }
116143

117144
genStringSchema m. MonadGen m m JsonSchema
118-
genStringSchema = pure $ JsonStringSchema {}
145+
genStringSchema = pure $ ObjectFormJsonSchema $ JsonStringSchema {}

src/purs/JsonSchema/Codec.purs

Lines changed: 53 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ module JsonSchema.Codec (parseSchema, printSchema) where
22

33
import Prelude
44

5+
import Control.Alternative ((<|>))
56
import Data.Argonaut.Core (Json)
67
import Data.Argonaut.Core as A
78
import Data.Array as Array
@@ -12,7 +13,7 @@ import Data.FunctorWithIndex (mapWithIndex)
1213
import Data.List (List(..), (:))
1314
import Data.Map (Map)
1415
import Data.Map as Map
15-
import Data.Maybe (Maybe(..), fromMaybe, maybe)
16+
import Data.Maybe (Maybe(..), maybe)
1617
import Data.Set (Set)
1718
import Data.Set as Set
1819
import Data.Traversable (traverse)
@@ -28,41 +29,57 @@ import JsonSchema
2829
, JsonSchema(..)
2930
, JsonSchemaObjectProperty
3031
, JsonStringSchemaSpec
32+
, ObjectFormJsonSchemaSpec(..)
3133
)
3234

3335
parseSchema Json String \/ JsonSchema
34-
parseSchema json = do
36+
parseSchema json = parseBooleanFormSchema json <|> parseObjectFormSchema
37+
json
38+
39+
parseBooleanFormSchema Json String \/ JsonSchema
40+
parseBooleanFormSchema json = do
41+
bool ← note
42+
(parsingErrorMessage "schema is not a JSON boolean")
43+
(A.toBoolean json)
44+
pure $ BooleanFormJsonSchema bool
45+
46+
parseObjectFormSchema Json String \/ JsonSchema
47+
parseObjectFormSchema json = do
3548
schemaObject ← note
3649
(parsingErrorMessage "schema is not a JSON object")
3750
(A.toObject json)
3851

39-
maybe
40-
(Right JsonEmptySchema)
41-
( \schemaTypeJson → case A.toString schemaTypeJson of
42-
Nothing
43-
Left
44-
$ parsingErrorMessage
45-
$ "invalid schema type JSON " <> A.stringify schemaTypeJson
46-
Just "array"
47-
JsonArraySchema <$> parseArraySchemaSpec schemaObject
48-
Just "boolean"
49-
Right JsonBooleanSchema
50-
Just "integer"
51-
JsonIntegerSchema <$> parseIntegerSchemaSpec schemaObject
52-
Just "null"
53-
Right JsonNullSchema
54-
Just "number"
55-
JsonNumberSchema <$> parseNumberSchemaSpec schemaObject
56-
Just "object"
57-
JsonObjectSchema <$> parseObjectSchemaSpec schemaObject
58-
Just "string"
59-
JsonStringSchema <$> parseStringSchemaSpec schemaObject
60-
Just unsupportedType →
61-
Left
62-
$ parsingErrorMessage
63-
$ "unsupported schema type " <> unsupportedType
64-
)
65-
(Object.lookup "type" schemaObject)
52+
objectFormJsonSchemaSpec ←
53+
maybe
54+
(Right JsonEmptySchema)
55+
( \schemaTypeJson → case A.toString schemaTypeJson of
56+
Nothing
57+
Left
58+
$ parsingErrorMessage
59+
$ "invalid schema type JSON " <> A.stringify
60+
schemaTypeJson
61+
Just "array"
62+
JsonArraySchema <$> parseArraySchemaSpec schemaObject
63+
Just "boolean"
64+
Right JsonBooleanSchema
65+
Just "integer"
66+
JsonIntegerSchema <$> parseIntegerSchemaSpec schemaObject
67+
Just "null"
68+
Right JsonNullSchema
69+
Just "number"
70+
JsonNumberSchema <$> parseNumberSchemaSpec schemaObject
71+
Just "object"
72+
JsonObjectSchema <$> parseObjectSchemaSpec schemaObject
73+
Just "string"
74+
JsonStringSchema <$> parseStringSchemaSpec schemaObject
75+
Just unsupportedType →
76+
Left
77+
$ parsingErrorMessage
78+
$ "unsupported schema type " <> unsupportedType
79+
)
80+
(Object.lookup "type" schemaObject)
81+
82+
pure $ ObjectFormJsonSchema objectFormJsonSchemaSpec
6683

6784
parseArraySchemaSpec Object Json String \/ JsonArraySchemaSpec
6885
parseArraySchemaSpec obj = do
@@ -148,6 +165,13 @@ parsingErrorMessage reason = "Invalid schema: " <> reason
148165

149166
printSchema JsonSchema Json
150167
printSchema = case _ of
168+
BooleanFormJsonSchema bool →
169+
A.fromBoolean bool
170+
ObjectFormJsonSchema spec →
171+
printObjectFormSchema spec
172+
173+
printObjectFormSchema ObjectFormJsonSchemaSpec Json
174+
printObjectFormSchema = case _ of
151175
JsonArraySchema spec →
152176
printArraySchema spec
153177
JsonBooleanSchema

src/purs/JsonSchema/Validation.purs

Lines changed: 26 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -15,26 +15,36 @@ import JsonSchema
1515
, JsonObjectSchemaSpec
1616
, JsonSchema(..)
1717
, JsonStringSchemaSpec
18+
, ObjectFormJsonSchemaSpec(..)
1819
)
1920

2021
validateAgainst Json JsonSchema Set String
2122
validateAgainst json schema = case schema of
22-
JsonArraySchema spec →
23-
validateAgainstArraySchema json spec
24-
JsonBooleanSchema
25-
validateAgainstBooleanSchema json
26-
JsonIntegerSchema spec →
27-
validateAgainstIntegerSchema json spec
28-
JsonEmptySchema
29-
Set.empty
30-
JsonNullSchema
31-
validateAgainstNullSchema json
32-
JsonNumberSchema spec →
33-
validateAgainstNumberSchema json spec
34-
JsonObjectSchema spec →
35-
validateAgainstObjectSchema json spec
36-
JsonStringSchema spec →
37-
validateAgainstStringSchema json spec
23+
BooleanFormJsonSchema bool →
24+
if bool then Set.empty else Set.singleton "invalid JSON value"
25+
ObjectFormJsonSchema spec →
26+
validateAgainstObjectFormSchema json spec
27+
28+
validateAgainstObjectFormSchema
29+
Json ObjectFormJsonSchemaSpec Set String
30+
validateAgainstObjectFormSchema json objectFormSpec =
31+
case objectFormSpec of
32+
JsonArraySchema spec →
33+
validateAgainstArraySchema json spec
34+
JsonBooleanSchema
35+
validateAgainstBooleanSchema json
36+
JsonIntegerSchema spec →
37+
validateAgainstIntegerSchema json spec
38+
JsonEmptySchema
39+
Set.empty
40+
JsonNullSchema
41+
validateAgainstNullSchema json
42+
JsonNumberSchema spec →
43+
validateAgainstNumberSchema json spec
44+
JsonObjectSchema spec →
45+
validateAgainstObjectSchema json spec
46+
JsonStringSchema spec →
47+
validateAgainstStringSchema json spec
3848

3949
validateAgainstArraySchema Json JsonArraySchemaSpec Set String
4050
validateAgainstArraySchema json spec =

0 commit comments

Comments
 (0)