git.iko.soy/typeable/openapi3
on master help sign in
Add basic generics support for sum types
bc8b98aNickolay Kudasov
src/Data/Swagger/Schema/Internal.hs+36−7
compare with master
unifiedsplit
@@ -189,22 +189,23 @@ gdatatypeSchemaName opts _ = case name of
189instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
189instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
190 gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
190 gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
191
191
192−-- | Single constructor data type.
193−instance {-# OVERLAPPABLE #-} (Datatype d, GToSchema f) => GToSchema (D1 d (C1 c f)) where
192+instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
194 gtoNamedSchema opts _ s = (schemaName, gtoSchema opts (Proxy :: Proxy f) s)
193 gtoNamedSchema opts _ s = (schemaName, gtoSchema opts (Proxy :: Proxy f) s)
195 where
194 where
196 schemaName = gdatatypeSchemaName opts (Proxy :: Proxy d)
195 schemaName = gdatatypeSchemaName opts (Proxy :: Proxy d)
197
196
197+instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
198+ gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f)
199+
198−-- | Single field single constructor data type.
200+-- | Single field constructor.
199−instance (Datatype d, Selector s, GToSchema f) => GToSchema (D1 d (C1 c (S1 s f))) where
201+instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
200 gtoNamedSchema opts _ s
202 gtoNamedSchema opts _ s
201− | unwrapUnaryRecords opts = (schemaName, gtoSchema opts (Proxy :: Proxy f) s)
203+ | unwrapUnaryRecords opts = unnamed fieldSchema
202− | otherwise = (schemaName,) $
204+ | otherwise = unnamed $
203 case schema ^. schemaItems of
205 case schema ^. schemaItems of
204 Just (SchemaItemsArray [_]) -> fieldSchema
206 Just (SchemaItemsArray [_]) -> fieldSchema
205 _ -> schema
207 _ -> schema
206 where
208 where
207− schemaName = gdatatypeSchemaName opts (Proxy :: Proxy d)
208 schema = gtoSchema opts (Proxy :: Proxy (S1 s f)) s
209 schema = gtoSchema opts (Proxy :: Proxy (S1 s f)) s
209 fieldSchema = gtoSchema opts (Proxy :: Proxy f) s
210 fieldSchema = gtoSchema opts (Proxy :: Proxy f) s
210
211
@@ -245,6 +246,34 @@ instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) wh
245instance ToSchema c => GToSchema (K1 i c) where
246instance ToSchema c => GToSchema (K1 i c) where
246 gtoNamedSchema _ _ _ = toNamedSchema (Proxy :: Proxy c)
247 gtoNamedSchema _ _ _ = toNamedSchema (Proxy :: Proxy c)
247
248
249+instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
250+ gtoNamedSchema opts _ = unnamed . gsumToSchema opts (Proxy :: Proxy (f :+: g))
251+
252+class GSumToSchema f where
253+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> Schema
254+
255+instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
256+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) . gsumToSchema opts (Proxy :: Proxy g)
257+
258+gsumConToSchema :: forall c f proxy. Constructor c => Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
259+gsumConToSchema tagSchemaRef opts _ schema = schema
260+ & schemaType .~ SchemaObject
261+ & schemaProperties . at tag ?~ tagSchemaRef
262+ & schemaMaxProperties ?~ 1
263+ & schemaMinProperties ?~ 1
264+ where
265+ tag = T.pack (conName (Proxy3 :: Proxy3 c f p))
266+
267+instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
268+ gsumToSchema opts = gsumConToSchema tagSchemaRef opts
269+ where
270+ tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c f))
271+
272+instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
273+ gsumToSchema opts = gsumConToSchema tagSchemaRef opts
274+ where
275+ tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c (S1 s f)))
276+
248data Proxy2 a b = Proxy2
277data Proxy2 a b = Proxy2
249
278
250data Proxy3 a b c = Proxy3
279data Proxy3 a b c = Proxy3