@@ -6,6 +6,7 @@ module JsonSchema
6
6
, JsonSchemaObjectProperty
7
7
, JsonSchema (..)
8
8
, JsonStringSchemaSpec
9
+ , ObjectFormJsonSchemaSpec (..)
9
10
, genSchema
10
11
, genArraySchema
11
12
, genIntegerSchema
@@ -30,6 +31,16 @@ import Data.NonEmpty ((:|))
30
31
import Data.Show.Generic (genericShow )
31
32
32
33
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
33
44
= JsonArraySchema JsonArraySchemaSpec
34
45
| JsonBooleanSchema
35
46
| JsonEmptySchema
@@ -39,10 +50,10 @@ data JsonSchema
39
50
| JsonObjectSchema JsonObjectSchemaSpec
40
51
| JsonStringSchema JsonStringSchemaSpec
41
52
42
- derive instance Generic JsonSchema _
43
- derive instance Eq JsonSchema
53
+ derive instance Generic ObjectFormJsonSchemaSpec _
54
+ derive instance Eq ObjectFormJsonSchemaSpec
44
55
45
- instance Show JsonSchema where
56
+ instance Show ObjectFormJsonSchemaSpec where
46
57
show schema = genericShow schema
47
58
48
59
type JsonArraySchemaSpec =
@@ -67,42 +78,58 @@ type JsonSchemaObjectProperty =
67
78
, schema ∷ JsonSchema
68
79
}
69
80
81
+ -- genSchema ∷ ∀ m. Lazy (m JsonSchema) ⇒ MonadGen m ⇒ m JsonSchema
82
+ -- genSchema = genBooleanFormSchema <|> genObjectFormSchema
83
+
70
84
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
+ ]
80
105
81
106
genArraySchema ∷ ∀ m . Lazy (m JsonSchema ) ⇒ MonadGen m ⇒ m JsonSchema
82
107
genArraySchema = do
83
108
itemsSchema ← GenCommon .genMaybe genSchema
84
109
uniqueItems ← Gen .chooseBool
85
- pure $ JsonArraySchema { itemsSchema, uniqueItems }
110
+ pure
111
+ $ ObjectFormJsonSchema
112
+ $ JsonArraySchema { itemsSchema, uniqueItems }
86
113
87
114
genBooleanSchema ∷ ∀ m . MonadGen m ⇒ m JsonSchema
88
- genBooleanSchema = pure JsonBooleanSchema
115
+ genBooleanSchema = pure $ ObjectFormJsonSchema JsonBooleanSchema
89
116
90
117
genEmptySchema ∷ ∀ m . MonadGen m ⇒ m JsonSchema
91
- genEmptySchema = pure JsonEmptySchema
118
+ genEmptySchema = pure $ ObjectFormJsonSchema JsonEmptySchema
92
119
93
120
genIntegerSchema ∷ ∀ m . MonadGen m ⇒ m JsonSchema
94
- genIntegerSchema = pure $ JsonIntegerSchema {}
121
+ genIntegerSchema = pure $ ObjectFormJsonSchema $ JsonIntegerSchema {}
95
122
96
123
genNullSchema ∷ ∀ m . MonadGen m ⇒ m JsonSchema
97
- genNullSchema = pure JsonNullSchema
124
+ genNullSchema = pure $ ObjectFormJsonSchema JsonNullSchema
98
125
99
126
genNumberSchema ∷ ∀ m . MonadGen m ⇒ m JsonSchema
100
- genNumberSchema = pure $ JsonNumberSchema {}
127
+ genNumberSchema = pure $ ObjectFormJsonSchema $ JsonNumberSchema {}
101
128
102
129
genObjectSchema ∷ ∀ m . Lazy (m JsonSchema ) ⇒ MonadGen m ⇒ m JsonSchema
103
130
genObjectSchema = do
104
131
properties ← genProperties
105
- pure $ JsonObjectSchema { properties }
132
+ pure $ ObjectFormJsonSchema $ JsonObjectSchema { properties }
106
133
where
107
134
genProperties ∷ m (Map String JsonSchemaObjectProperty )
108
135
genProperties = (Map .fromFoldable <<< List .singleton)
@@ -115,4 +142,4 @@ genObjectSchema = do
115
142
pure { isRequired, schema }
116
143
117
144
genStringSchema ∷ ∀ m . MonadGen m ⇒ m JsonSchema
118
- genStringSchema = pure $ JsonStringSchema {}
145
+ genStringSchema = pure $ ObjectFormJsonSchema $ JsonStringSchema {}
0 commit comments