@@ -2,6 +2,7 @@
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE FlexibleInstances #-}
44{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE OverloadedLists #-}
56{-# LANGUAGE OverloadedStrings #-}
67{-# LANGUAGE PackageImports #-}
78{-# LANGUAGE PolyKinds #-}
@@ -40,40 +41,56 @@ import Data.Swagger.SchemaOptions
4041-- This name can be used in references.
4142type NamedSchema = (Maybe String, Schema)
4243
44+-- | Schema definitions, a mapping from schema name to @'Schema'@.
45+type Definitions = HashMap T.Text Schema
46+
47+-- | Annotate @'NamedSchema'@ with its definition if name is present.
48+independent :: NamedSchema -> (Definitions, NamedSchema)
49+independent ns@(Just name, schema) = ([(T.pack name, schema)], ns)
50+independent ns = pure ns
51+
4352unnamed :: Schema -> NamedSchema
4453unnamed schema = (Nothing, schema)
4554
4655named :: String -> Schema -> NamedSchema
4756named name schema = (Just name, schema)
4857
58+plain :: Schema -> (Definitions, NamedSchema)
59+plain schema = (mempty, unnamed schema)
60+
61+unname :: NamedSchema -> NamedSchema
62+unname (_, schema) = (Nothing, schema)
63+
4964-- | Convert a type into @'Schema'@.
5065--
5166-- An example type and instance:
5267--
5368-- @
5469-- {-\# LANGUAGE OverloadedStrings \#-} -- allows to write 'T.Text' literals
55−-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' as list
70+-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
5671--
5772-- import Control.Lens
5873--
5974-- data Coord = Coord { x :: Double, y :: Double }
6075--
6176-- instance ToSchema Coord where
62−-- toNamedSchema = (Just \"Coord\", mempty
63−-- & schemaType .~ SwaggerObject
64−-- & schemaProperties .~
65−-- [ ("x", toSchemaRef (Proxy :: Proxy Double))
66−-- , ("y", toSchemaRef (Proxy :: Proxy Double))
67−-- ]
68−-- & schemaRequired .~ [ "x", "y" ]
77+-- toSchemaDefinitions = ([("Coord", schema)], (Just "Coord", schema))
78+-- where
79+-- schema = mempty
80+-- & schemaType .~ SwaggerObject
81+-- & schemaProperties .~
82+-- [ ("x", toSchemaRef (Proxy :: Proxy Double))
83+-- , ("y", toSchemaRef (Proxy :: Proxy Double))
84+-- ]
85+-- & schemaRequired .~ [ "x", "y" ]
6986-- @
7087--
7188-- Instead of manually writing your @'ToSchema'@ instance you can
72−-- use a default generic implementation of @'toNamedSchema'@.
89+-- use a default generic implementation of @'toSchemaDefinitions'@.
7390--
7491-- To do that, simply add @deriving 'Generic'@ clause to your datatype
7592-- and declare a @'ToSchema'@ instance for your datatype without
76−-- giving definition for @'toNamedSchema'@.
93+-- giving definition for @'toSchemaDefinitions'@.
7794--
7895-- For instance, the previous example can be simplified into this:
7996--
@@ -87,10 +104,15 @@ named name schema = (Just name, schema)
87104-- instance ToSchema Coord
88105-- @
89106class ToSchema a where
90− -- | Convert a type into an optionally named schema.
91− toNamedSchema :: proxy a -> NamedSchema
92− default toNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> NamedSchema
93− toNamedSchema = genericToNamedSchema defaultSchemaOptions
107+ -- | Convert a type into an optionally named schema
108+ -- together with all used definitions (including this schema).
109+ toSchemaDefinitions :: proxy a -> (Definitions, NamedSchema)
110+ default toSchemaDefinitions :: (Generic a, GToSchema (Rep a)) => proxy a -> (Definitions, NamedSchema)
111+ toSchemaDefinitions = genericToSchemaDefinitions defaultSchemaOptions
112+
113+-- | Convert a type into an optionally named schema.
114+toNamedSchema :: ToSchema a => proxy a -> NamedSchema
115+toNamedSchema = snd . toSchemaDefinitions
94116
95117-- | Get type's schema name according to its @'ToSchema'@ instance.
96118schemaName :: ToSchema a => proxy a -> Maybe String
@@ -108,37 +130,40 @@ toSchemaRef proxy = case toNamedSchema proxy of
108130 (_, schema) -> Inline schema
109131
110132class GToSchema (f :: * -> *) where
111− gtoNamedSchema :: SchemaOptions -> proxy f -> Schema -> NamedSchema
133+ gtoSchemaDefinitions :: SchemaOptions -> proxy f -> Schema -> (Definitions, NamedSchema)
134+
135+gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> Schema -> NamedSchema
136+gtoNamedSchema opts proxy = snd . gtoSchemaDefinitions opts proxy
112137
113138gtoSchema :: GToSchema f => SchemaOptions -> proxy f -> Schema -> Schema
114139gtoSchema opts proxy = snd . gtoNamedSchema opts proxy
115140
116141instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
117− toNamedSchema _ = unnamed $ mempty
142+ toSchemaDefinitions _ = plain $ mempty
118143 & schemaType .~ SwaggerArray
119144 & schemaItems ?~ SchemaItemsObject (toSchemaRef (Proxy :: Proxy a))
120145
121−instance {-# OVERLAPPING #-} ToSchema String where toNamedSchema = unnamed . paramSchemaToSchema
122−instance ToSchema Bool where toNamedSchema = unnamed . paramSchemaToSchema
123−instance ToSchema Integer where toNamedSchema = unnamed . paramSchemaToSchema
124−instance ToSchema Int where toNamedSchema = unnamed . paramSchemaToSchema
125−instance ToSchema Int8 where toNamedSchema = unnamed . paramSchemaToSchema
126−instance ToSchema Int16 where toNamedSchema = unnamed . paramSchemaToSchema
127−instance ToSchema Int32 where toNamedSchema = unnamed . paramSchemaToSchema
128−instance ToSchema Int64 where toNamedSchema = unnamed . paramSchemaToSchema
129−instance ToSchema Word where toNamedSchema = unnamed . paramSchemaToSchema
130−instance ToSchema Word8 where toNamedSchema = unnamed . paramSchemaToSchema
131−instance ToSchema Word16 where toNamedSchema = unnamed . paramSchemaToSchema
132−instance ToSchema Word32 where toNamedSchema = unnamed . paramSchemaToSchema
133−instance ToSchema Word64 where toNamedSchema = unnamed . paramSchemaToSchema
134−
135−instance ToSchema Char where toNamedSchema = unnamed . paramSchemaToSchema
136−instance ToSchema Scientific where toNamedSchema = unnamed . paramSchemaToSchema
137−instance ToSchema Double where toNamedSchema = unnamed . paramSchemaToSchema
138−instance ToSchema Float where toNamedSchema = unnamed . paramSchemaToSchema
146+instance {-# OVERLAPPING #-} ToSchema String where toSchemaDefinitions = plain . paramSchemaToSchema
147+instance ToSchema Bool where toSchemaDefinitions = plain . paramSchemaToSchema
148+instance ToSchema Integer where toSchemaDefinitions = plain . paramSchemaToSchema
149+instance ToSchema Int where toSchemaDefinitions = plain . paramSchemaToSchema
150+instance ToSchema Int8 where toSchemaDefinitions = plain . paramSchemaToSchema
151+instance ToSchema Int16 where toSchemaDefinitions = plain . paramSchemaToSchema
152+instance ToSchema Int32 where toSchemaDefinitions = plain . paramSchemaToSchema
153+instance ToSchema Int64 where toSchemaDefinitions = plain . paramSchemaToSchema
154+instance ToSchema Word where toSchemaDefinitions = plain . paramSchemaToSchema
155+instance ToSchema Word8 where toSchemaDefinitions = plain . paramSchemaToSchema
156+instance ToSchema Word16 where toSchemaDefinitions = plain . paramSchemaToSchema
157+instance ToSchema Word32 where toSchemaDefinitions = plain . paramSchemaToSchema
158+instance ToSchema Word64 where toSchemaDefinitions = plain . paramSchemaToSchema
159+
160+instance ToSchema Char where toSchemaDefinitions = plain . paramSchemaToSchema
161+instance ToSchema Scientific where toSchemaDefinitions = plain . paramSchemaToSchema
162+instance ToSchema Double where toSchemaDefinitions = plain . paramSchemaToSchema
163+instance ToSchema Float where toSchemaDefinitions = plain . paramSchemaToSchema
139164
140165instance ToSchema a => ToSchema (Maybe a) where
141− toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
166+ toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy a)
142167
143168instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
144169
@@ -150,8 +175,8 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchem
150175instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
151176instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
152177
153−timeNamedSchema :: String -> String -> NamedSchema
154−timeNamedSchema name format = (Just name, mempty
178+timeSchemaDefinitions :: String -> String -> (Definitions, NamedSchema)
179+timeSchemaDefinitions name format = pure (Just name, mempty
155180 & schemaType .~ SwaggerString
156181 & schemaFormat ?~ T.pack format
157182 & schemaMinLength ?~ toInteger (length format))
@@ -160,67 +185,67 @@ timeNamedSchema name format = (Just name, mempty
160185-- >>> toSchema (Proxy :: Proxy Day) ^. schemaFormat
161186-- Just "yyyy-mm-dd"
162187instance ToSchema Day where
163− toNamedSchema _ = timeNamedSchema "Day" "yyyy-mm-dd"
188+ toSchemaDefinitions _ = timeSchemaDefinitions "Day" "yyyy-mm-dd"
164189
165190-- |
166191-- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
167192-- Just "yyyy-mm-ddThh:MM:ss"
168193instance ToSchema LocalTime where
169− toNamedSchema _ = timeNamedSchema "LocalTime" "yyyy-mm-ddThh:MM:ss"
194+ toSchemaDefinitions _ = timeSchemaDefinitions "LocalTime" "yyyy-mm-ddThh:MM:ss"
170195
171196-- |
172197-- >>> toSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat
173198-- Just "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
174199instance ToSchema ZonedTime where
175− toNamedSchema _ = (Just "ZonedTime", mempty
200+ toSchemaDefinitions _ = pure (Just "ZonedTime", mempty
176201 & schemaType .~ SwaggerString
177202 & schemaFormat ?~ "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
178203 & schemaMinLength ?~ toInteger (length ("yyyy-mm-ddThh:MM:ssZ" :: String)))
179204
180205instance ToSchema NominalDiffTime where
181− toNamedSchema _ = toNamedSchema (Proxy :: Proxy Integer)
206+ toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy Integer)
182207
183208-- |
184209-- >>> toSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
185210-- Just "yyyy-mm-ddThh:MM:ssZ"
186211instance ToSchema UTCTime where
187− toNamedSchema _ = timeNamedSchema "UTCTime" "yyyy-mm-ddThh:MM:ssZ"
212+ toSchemaDefinitions _ = timeSchemaDefinitions "UTCTime" "yyyy-mm-ddThh:MM:ssZ"
188213
189−instance ToSchema T.Text where toNamedSchema = unnamed . paramSchemaToSchema
190−instance ToSchema TL.Text where toNamedSchema = unnamed . paramSchemaToSchema
214+instance ToSchema T.Text where toSchemaDefinitions = plain . paramSchemaToSchema
215+instance ToSchema TL.Text where toSchemaDefinitions = plain . paramSchemaToSchema
191216
192−instance ToSchema IntSet where toNamedSchema _ = toNamedSchema (Proxy :: Proxy (Set Int))
217+instance ToSchema IntSet where toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy (Set Int))
193218
194219-- | NOTE: This schema does not account for the uniqueness of keys.
195220instance ToSchema a => ToSchema (IntMap a) where
196− toNamedSchema _ = toNamedSchema (Proxy :: Proxy [(Int, a)])
221+ toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy [(Int, a)])
197222
198223instance ToSchema a => ToSchema (Map String a) where
199− toNamedSchema _ = unnamed $ mempty
224+ toSchemaDefinitions _ = plain $ mempty
200225 & schemaType .~ SwaggerObject
201226 & schemaAdditionalProperties ?~ toSchema (Proxy :: Proxy a)
202227
203−instance ToSchema a => ToSchema (Map T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
204−instance ToSchema a => ToSchema (Map TL.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
228+instance ToSchema a => ToSchema (Map T.Text a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy (Map String a))
229+instance ToSchema a => ToSchema (Map TL.Text a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy (Map String a))
205230
206−instance ToSchema a => ToSchema (HashMap String a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
207−instance ToSchema a => ToSchema (HashMap T.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
208−instance ToSchema a => ToSchema (HashMap TL.Text a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Map String a))
231+instance ToSchema a => ToSchema (HashMap String a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy (Map String a))
232+instance ToSchema a => ToSchema (HashMap T.Text a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy (Map String a))
233+instance ToSchema a => ToSchema (HashMap TL.Text a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy (Map String a))
209234
210235instance ToSchema a => ToSchema (Set a) where
211− toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy [a])
236+ toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy [a])
212237 & schemaUniqueItems ?~ True
213238
214−instance ToSchema a => ToSchema (HashSet a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy (Set a))
239+instance ToSchema a => ToSchema (HashSet a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy (Set a))
215240
216−instance ToSchema All where toNamedSchema = unnamed . paramSchemaToSchema
217−instance ToSchema Any where toNamedSchema = unnamed . paramSchemaToSchema
241+instance ToSchema All where toSchemaDefinitions = plain . paramSchemaToSchema
242+instance ToSchema Any where toSchemaDefinitions = plain . paramSchemaToSchema
218243
219−instance ToSchema a => ToSchema (Sum a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
220−instance ToSchema a => ToSchema (Product a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
221−instance ToSchema a => ToSchema (First a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
222−instance ToSchema a => ToSchema (Last a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
223−instance ToSchema a => ToSchema (Dual a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
244+instance ToSchema a => ToSchema (Sum a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy a)
245+instance ToSchema a => ToSchema (Product a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy a)
246+instance ToSchema a => ToSchema (First a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy a)
247+instance ToSchema a => ToSchema (Last a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy a)
248+instance ToSchema a => ToSchema (Dual a) where toSchemaDefinitions _ = plain $ toSchema (Proxy :: Proxy a)
224249
225250-- | Default schema for @'Bounded'@, @'Integral'@ types.
226251toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
@@ -242,11 +267,15 @@ genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a ->
242267genericToSchema opts = snd . genericToNamedSchema opts
243268
244269-- | A configurable generic @'NamedSchema'@ creator.
270+genericToNamedSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> NamedSchema
271+genericToNamedSchema opts = snd . genericToSchemaDefinitions opts
272+
273+-- | A configurable generic @('NamedSchema', 'Definitions')@ creator.
245274-- This function applied to @'defaultSchemaOptions'@
246−-- is used as the default for @'toNamedSchema'@
275+-- is used as the default for @'toSchemaDefinitions'@
247276-- when the type is an instance of @'Generic'@.
248−genericToNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> NamedSchema
249−genericToNamedSchema opts _ = gtoNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
277+genericToSchemaDefinitions :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> (Definitions, NamedSchema)
278+genericToSchemaDefinitions opts _ = gtoSchemaDefinitions opts (Proxy :: Proxy (Rep a)) mempty
250279
251280gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe String
252281gdatatypeSchemaName opts _ = case name of
@@ -271,74 +300,86 @@ nullarySchema = mempty
271300 & schemaEnum ?~ [ toJSON () ]
272301
273302instance GToSchema U1 where
274− gtoNamedSchema _ _ _ = unnamed nullarySchema
303+ gtoSchemaDefinitions _ _ _ = plain nullarySchema
275304
276305instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
277− gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f) . gtoSchema opts (Proxy :: Proxy g)
306+ gtoSchemaDefinitions opts _ schema = (fdefs <> gdefs, unnamed fschema)
307+ where
308+ (fdefs, (_, fschema)) = gtoSchemaDefinitions opts (Proxy :: Proxy f) gschema
309+ (gdefs, (_, gschema)) = gtoSchemaDefinitions opts (Proxy :: Proxy g) schema
278310
279311instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
280− gtoNamedSchema opts _ s = (name, gtoSchema opts (Proxy :: Proxy f) s)
312+ gtoSchemaDefinitions opts _ s = (defs, (name, schema))
281313 where
314+ defs = case name of
315+ Nothing -> schemaDefs
316+ Just n -> [(T.pack n, schema)] <> schemaDefs
317+ (schemaDefs, (_, schema)) = gtoSchemaDefinitions opts (Proxy :: Proxy f) s
282318 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
283319
284320instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
285− gtoNamedSchema opts _ = unnamed . gtoSchema opts (Proxy :: Proxy f)
321+ gtoSchemaDefinitions opts _ s = (defs, unnamed schema)
322+ where
323+ (defs, (_, schema)) = gtoSchemaDefinitions opts (Proxy :: Proxy f) s
286324
287325-- | Single field constructor.
288326instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
289− gtoNamedSchema opts _ s
290− | unwrapUnaryRecords opts = fieldSchema
327+ gtoSchemaDefinitions opts _ s
328+ | unwrapUnaryRecords opts = fieldSchemaDefs
291329 | otherwise =
292330 case schema ^. schemaItems of
293− Just (SchemaItemsArray [_]) -> fieldSchema
294− _ -> unnamed schema
331+ Just (SchemaItemsArray [_]) -> fieldSchemaDefs
332+ _ -> unname <$> schemaDefs
295333 where
296− schema = gtoSchema opts (Proxy :: Proxy (S1 s f)) s
297− fieldSchema = gtoNamedSchema opts (Proxy :: Proxy f) s
334+ (_, (_, schema)) = schemaDefs
335+ schemaDefs = gtoSchemaDefinitions opts (Proxy :: Proxy (S1 s f)) s
336+ fieldSchemaDefs = gtoSchemaDefinitions opts (Proxy :: Proxy f) s
298337
299−gtoSchemaRef :: GToSchema f => SchemaOptions -> proxy f -> Referenced Schema
300−gtoSchemaRef opts proxy = case gtoNamedSchema opts proxy mempty of
301− (Just name, _)
302− | useReferences opts -> Ref (Reference ("#/definitions/" <> T.pack name))
303− (_, schema) -> Inline schema
338+gtoSchemaRef :: GToSchema f => SchemaOptions -> proxy f -> (Definitions, Referenced Schema)
339+gtoSchemaRef opts proxy = case gtoSchemaDefinitions opts proxy mempty of
340+ (defs, (Just name, _))
341+ | useReferences opts -> (defs, Ref (Reference ("#/definitions/" <> T.pack name)))
342+ (defs, (_, schema)) -> (defs, Inline schema)
304343
305344appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
306345appendItem x Nothing = Just (SchemaItemsArray [x])
307346appendItem x (Just (SchemaItemsArray xs)) = Just (SchemaItemsArray (x:xs))
308347appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject"
309348
310−withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) => SchemaOptions -> proxy s f -> Bool -> Schema -> Schema
311−withFieldSchema opts _ isRequiredField schema
312− | T.null fieldName = schema
313− & schemaType .~ SwaggerArray
314− & schemaItems %~ appendItem fieldSchemaRef
315− | otherwise = schema
316− & schemaType .~ SwaggerObject
317− & schemaProperties . at fieldName ?~ fieldSchemaRef
318− & if isRequiredField
319− then schemaRequired %~ (fieldName :)
320− else id
349+withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) => SchemaOptions -> proxy s f -> Bool -> Schema -> (Definitions, Schema)
350+withFieldSchema opts _ isRequiredField schema = (defs, schema')
321351 where
352+ schema'
353+ | T.null fieldName = schema
354+ & schemaType .~ SwaggerArray
355+ & schemaItems %~ appendItem fieldSchemaRef
356+ | otherwise = schema
357+ & schemaType .~ SwaggerObject
358+ & schemaProperties . at fieldName ?~ fieldSchemaRef
359+ & if isRequiredField
360+ then schemaRequired %~ (fieldName :)
361+ else id
362+
322363 fieldName = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
323− fieldSchemaRef = gtoSchemaRef opts (Proxy :: Proxy f)
364+ (defs, fieldSchemaRef) = gtoSchemaRef opts (Proxy :: Proxy f)
324365
325366-- | Optional record fields.
326367instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
327− gtoNamedSchema opts _ = unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
368+ gtoSchemaDefinitions opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
328369
329370-- | Record fields.
330371instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
331− gtoNamedSchema opts _ = unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
372+ gtoSchemaDefinitions opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
332373
333374instance ToSchema c => GToSchema (K1 i c) where
334− gtoNamedSchema _ _ _ = toNamedSchema (Proxy :: Proxy c)
375+ gtoSchemaDefinitions _ _ _ = toSchemaDefinitions (Proxy :: Proxy c)
335376
336377instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
337− gtoNamedSchema opts _ s
338− | allNullaryToStringTag opts && allNullary = unnamed (toStringTag sumSchema)
339− | otherwise = unnamed sumSchema
378+ gtoSchemaDefinitions opts _ s
379+ | allNullaryToStringTag opts && allNullary = plain (toStringTag sumSchema)
380+ | otherwise = (defs, unnamed sumSchema)
340381 where
341− (All allNullary, sumSchema) = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
382+ ((All allNullary, defs), sumSchema) = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
342383
343384 toStringTag schema = mempty
344385 & schemaType .~ SwaggerString
@@ -347,7 +388,7 @@ instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
347388type AllNullary = All
348389
349390class GSumToSchema f where
350− gsumToSchema :: SchemaOptions -> proxy f -> Schema -> (AllNullary, Schema)
391+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> ((AllNullary, Definitions), Schema)
351392
352393instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
353394 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) `after` gsumToSchema opts (Proxy :: Proxy g)
@@ -358,8 +399,8 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
358399 (b, s'') = g s'
359400
360401gsumConToSchema :: forall c f proxy. Constructor c =>
361− Bool -> Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> (AllNullary, Schema)
362−gsumConToSchema isNullary tagSchemaRef opts _ schema = (All isNullary, schema
402+ Bool -> (Definitions, Referenced Schema) -> SchemaOptions -> proxy (C1 c f) -> Schema -> ((AllNullary, Definitions), Schema)
403+gsumConToSchema isNullary (tagSchemaDefs, tagSchemaRef) opts _ schema = ((All isNullary, tagSchemaDefs), schema
363404 & schemaType .~ SwaggerObject
364405 & schemaProperties . at tag ?~ tagSchemaRef
365406 & schemaMaxProperties ?~ 1