@@ -98,6 +98,7 @@ data Schema
9898 | SchemaObject [(Symbol, Schema)]
9999 | SchemaArray [ArrayConstraint] Schema
100100 | SchemaNull
101+ | SchemaOptional Schema
101102 deriving (Generic)
102103
103104data instance Sing (schema :: Schema) where
@@ -105,6 +106,7 @@ data instance Sing (schema :: Schema) where
105106 SSchemaNumber :: Known (Sing ncs) => Sing ncs -> Sing (SchemaNumber ncs)
106107 SSchemaArray :: (Known (Sing acs), Known (Sing schema)) => Sing acs -> Sing schema -> Sing (SchemaArray acs schema)
107108 SSchemaObject :: Known (Sing fields) => Sing fields -> Sing (SchemaObject fields)
109+ SSchemaOptional :: Known (Sing s) => Sing s -> Sing (SchemaOptional s)
108110 SSchemaNull :: Sing SchemaNull
109111
110112instance Known (Sing sl) => Known (Sing (SchemaText sl)) where
@@ -117,12 +119,15 @@ instance (Known (Sing ac), Known (Sing s)) => Known (Sing (SchemaArray ac s)) wh
117119 known = SSchemaArray known known
118120instance Known (Sing stl) => Known (Sing (SchemaObject stl)) where
119121 known = SSchemaObject known
122+instance Known (Sing s) => Known (Sing (SchemaOptional s)) where
123+ known = SSchemaOptional known
120124
121125instance Eq (Sing (SchemaText cs)) where a == b = True
122126instance Eq (Sing (SchemaNumber cs)) where a == b = True
123127instance Eq (Sing SchemaNull) where a == b = True
124128instance Eq (Sing (SchemaArray as s)) where a == b = True
125129instance Eq (Sing (SchemaObject cs)) where a == b = True
130+instance Eq (Sing (SchemaOptional s)) where a == b = True
126131
127132data FieldRepr :: (Symbol, Schema) -> Type where
128133 FieldRepr :: KnownSymbol name => JsonRepr schema -> FieldRepr '(name, schema)
@@ -148,6 +153,7 @@ data JsonRepr :: Schema -> Type where
148153 ReprNull :: JsonRepr SchemaNull
149154 ReprArray :: V.Vector (JsonRepr s) -> JsonRepr (SchemaArray cs s)
150155 ReprObject :: Rec FieldRepr fs -> JsonRepr (SchemaObject fs)
156+ ReprOptional :: Maybe (JsonRepr s) -> JsonRepr (SchemaOptional s)
151157
152158instance Show (JsonRepr (SchemaText cs)) where
153159 show (ReprText t) = "ReprText " P.++ show t
@@ -163,6 +169,9 @@ instance Show (JsonRepr s) => Show (JsonRepr (SchemaArray acs s)) where
163169instance RecAll FieldRepr fs Show => Show (JsonRepr (SchemaObject fs)) where
164170 show (ReprObject fs) = "ReprObject " P.++ show fs
165171
172+instance Show (JsonRepr s) => Show (JsonRepr (SchemaOptional s)) where
173+ show (ReprOptional s) = "ReprOptional " P.++ show s
174+
166175instance (Monad m, Serial m Text)
167176 => Serial m (JsonRepr (SchemaText cs)) where
168177 series = cons1 ReprText
@@ -178,6 +187,10 @@ instance (Serial m (V.Vector (JsonRepr s)))
178187 => Serial m (JsonRepr (SchemaArray cs s)) where
179188 series = cons1 ReprArray
180189
190+instance (Serial m (JsonRepr s))
191+ => Serial m (JsonRepr (SchemaOptional s)) where
192+ series = cons1 ReprOptional
193+
181194instance (Monad m, Serial m (Rec FieldRepr fs))
182195 => Serial m (JsonRepr (SchemaObject fs)) where
183196 series = cons1 ReprObject
@@ -197,15 +210,26 @@ instance Eq (JsonRepr SchemaNull) where
197210instance Eq (JsonRepr s) => Eq (JsonRepr (SchemaArray as s)) where
198211 ReprArray a == ReprArray b = a == b
199212
213+instance Eq (JsonRepr s) => Eq (JsonRepr (SchemaOptional s)) where
214+ ReprOptional a == ReprOptional b = a == b
215+
216+fromOptional
217+ :: (Known (Sing s))
218+ => Sing (SchemaOptional s)
219+ -> J.Value
220+ -> Parser (Maybe (JsonRepr s))
221+fromOptional _ = parseJSON
222+
200223instance Known (Sing schema) => J.FromJSON (JsonRepr schema) where
201224 parseJSON value = case known :: Sing schema of
202− SSchemaText _ -> withText "String" (pure . ReprText) value
203− SSchemaNumber _ -> withScientific "Number" (pure . ReprNumber) value
204− SSchemaNull -> case value of
225+ SSchemaText _ -> withText "String" (pure . ReprText) value
226+ SSchemaNumber _ -> withScientific "Number" (pure . ReprNumber) value
227+ SSchemaNull -> case value of
205228 J.Null -> pure ReprNull
206229 _ -> typeMismatch "Null" value
207− SSchemaArray c s -> withArray "Array" (fmap ReprArray . traverse parseJSON) value
208− SSchemaObject fs -> do
230+ so@(SSchemaOptional _) -> ReprOptional <$> fromOptional so value
231+ SSchemaArray c s -> withArray "Array" (fmap ReprArray . traverse parseJSON) value
232+ SSchemaObject fs -> do
209233 let
210234 demoteFields :: SList s -> H.HashMap Text J.Value -> Parser (Rec FieldRepr s)
211235 demoteFields SNil h = pure RNil
@@ -213,29 +237,35 @@ instance Known (Sing schema) => J.FromJSON (JsonRepr schema) where
213237 let fieldName = T.pack $ symbolVal (Proxy @fn)
214238 fieldRepr <- case s of
215239 SSchemaText _ -> case H.lookup fieldName h of
216− Just v -> FieldRepr <$> parseJSON v
217− Nothing -> fail "schematext"
240+ Just v -> FieldRepr <$> parseJSON v
241+ Nothing -> fail "schematext"
218242 SSchemaNumber _ -> case H.lookup fieldName h of
219− Just v -> FieldRepr <$> parseJSON v
220− Nothing -> fail "schemanumber"
243+ Just v -> FieldRepr <$> parseJSON v
244+ Nothing -> fail "schemanumber"
221245 SSchemaNull -> case H.lookup fieldName h of
222− Just v -> FieldRepr <$> parseJSON v
223− Nothing -> fail "schemanull"
246+ Just v -> FieldRepr <$> parseJSON v
247+ Nothing -> fail "schemanull"
224248 SSchemaArray _ _ -> case H.lookup fieldName h of
225− Just v -> FieldRepr <$> parseJSON v
226− Nothing -> fail "schemaarray"
249+ Just v -> FieldRepr <$> parseJSON v
250+ Nothing -> fail "schemaarray"
227251 SSchemaObject _ -> case H.lookup fieldName h of
228− Just v -> FieldRepr <$> parseJSON v
229− Nothing -> fail "schemaobject"
252+ Just v -> FieldRepr <$> parseJSON v
253+ Nothing -> fail "schemaobject"
254+ SSchemaOptional s -> case H.lookup fieldName h of
255+ Just v -> FieldRepr <$> parseJSON v
256+ Nothing -> fail "schemaoptional"
230257 (fieldRepr :&) <$> demoteFields tl h
231258 ReprObject <$> withObject "Object" (demoteFields fs) value
232259
233260instance J.ToJSON (JsonRepr a) where
234− toJSON ReprNull = J.Null
235− toJSON (ReprText t) = J.String t
236− toJSON (ReprNumber n) = J.Number n
237− toJSON (ReprArray v) = J.Array $ toJSON <$> v
238− toJSON (ReprObject r) = J.Object . H.fromList . fold $ r
261+ toJSON ReprNull = J.Null
262+ toJSON (ReprText t) = J.String t
263+ toJSON (ReprNumber n) = J.Number n
264+ toJSON (ReprOptional s) = case s of
265+ Just v -> toJSON v
266+ Nothing -> J.Null
267+ toJSON (ReprArray v) = J.Array $ toJSON <$> v
268+ toJSON (ReprObject r) = J.Object . H.fromList . fold $ r
239269 where
240270 extract :: forall name s . (KnownSymbol name)
241271 => FieldRepr '(name, s)