@@ -14,6 +14,8 @@
1414module Data.Swagger.Internal.Schema where
1515
1616import Control.Lens
17+import Control.Monad
18+import Control.Monad.Writer
1719import Data.Aeson
1820import Data.Char
1921import Data.HashMap.Strict (HashMap)
@@ -33,6 +35,7 @@ import Data.Time
3335import Data.Word
3436import GHC.Generics
3537
38+import Data.Swagger.Declare
3639import Data.Swagger.Internal
3740import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
3841import Data.Swagger.Lens
@@ -51,12 +54,15 @@ unnamed schema = (Nothing, schema)
5154named :: String -> Schema -> NamedSchema
5255named name schema = (Just name, schema)
5356
54−plain :: Schema -> (Definitions, NamedSchema)
55−plain schema = (mempty, unnamed schema)
57+plain :: Schema -> Declare Definitions NamedSchema
58+plain = pure . unnamed
5659
5760unname :: NamedSchema -> NamedSchema
5861unname (_, schema) = (Nothing, schema)
5962
63+rename :: Maybe String -> NamedSchema -> NamedSchema
64+rename name (_, schema) = (name, schema)
65+
6066-- | Convert a type into @'Schema'@.
6167--
6268-- An example type and instance:
@@ -104,13 +110,13 @@ class ToSchema a where
104110 -- together with all used definitions.
105111 -- Note that the schema itself is included in definitions
106112 -- only if it is recursive (and thus needs its definition in scope).
107− toSchemaDefinitions :: proxy a -> (Definitions, NamedSchema)
108− default toSchemaDefinitions :: (Generic a, GToSchema (Rep a)) => proxy a -> (Definitions, NamedSchema)
113+ toSchemaDefinitions :: proxy a -> Declare Definitions NamedSchema
114+ default toSchemaDefinitions :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare Definitions NamedSchema
109115 toSchemaDefinitions = genericToSchemaDefinitions defaultSchemaOptions
110116
111117-- | Convert a type into an optionally named schema.
112118toNamedSchema :: ToSchema a => proxy a -> NamedSchema
113−toNamedSchema = snd . toSchemaDefinitions
119+toNamedSchema = undeclare . toSchemaDefinitions
114120
115121-- | Get type's schema name according to its @'ToSchema'@ instance.
116122schemaName :: ToSchema a => proxy a -> Maybe String
@@ -120,30 +126,34 @@ schemaName = fst . toNamedSchema
120126toSchema :: ToSchema a => proxy a -> Schema
121127toSchema = snd . toNamedSchema
122128
129+declareSchema :: ToSchema a => proxy a -> Declare Definitions Schema
130+declareSchema = fmap snd . toSchemaDefinitions
131+
123132-- | Convert a type into a referenced schema if possible.
124133-- Only named schemas can be references, nameless schemas are inlined.
125134toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
126−toSchemaRef proxy = case toNamedSchema proxy of
127− (Just name, _) -> Ref (Reference ("#/definitions/" <> T.pack name))
128− (_, schema) -> Inline schema
135+toSchemaRef = undeclare . declareSchemaRef
136+
137+declareSchemaRef :: ToSchema a => proxy a -> Declare Definitions (Referenced Schema)
138+declareSchemaRef proxy = do
139+ case toNamedSchema proxy of
140+ (Just name, schema) -> do
141+ known <- looks (HashMap.member (T.pack name))
142+ when (not known) $ do
143+ declare [(T.pack name, schema)]
144+ void $ toSchemaDefinitions proxy
145+ return $ Ref (Reference ("#/definitions/" <> T.pack name))
146+ _ -> Inline <$> declareSchema proxy
129147
130148class GToSchema (f :: * -> *) where
131− gtoSchemaDefinitions :: SchemaOptions -> proxy f -> (Definitions, Schema) -> (Definitions, NamedSchema)
132−
133−gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> (Definitions, Schema) -> NamedSchema
134−gtoNamedSchema opts proxy = snd . gtoSchemaDefinitions opts proxy
135−
136−gtoSchema :: GToSchema f => SchemaOptions -> proxy f -> (Definitions, Schema) -> Schema
137−gtoSchema opts proxy = snd . gtoNamedSchema opts proxy
149+ gtoSchemaDefinitions :: SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema
138150
139151instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
140− toSchemaDefinitions _ = (defs, unnamed schema)
141− where
142− schema = mempty
143− & schemaType .~ SwaggerArray
144− & schemaItems ?~ SchemaItemsObject (toSchemaRef (Proxy :: Proxy a))
145−
146− (defs, _) = toSchemaDefinitions (Proxy :: Proxy a)
152+ toSchemaDefinitions _ = do
153+ ref <- declareSchemaRef (Proxy :: Proxy a)
154+ return $ unnamed $ mempty
155+ & schemaType .~ SwaggerArray
156+ & schemaItems ?~ SchemaItemsObject ref
147157
148158instance {-# OVERLAPPING #-} ToSchema String where toSchemaDefinitions = plain . paramSchemaToSchema
149159instance ToSchema Bool where toSchemaDefinitions = plain . paramSchemaToSchema
@@ -165,9 +175,7 @@ instance ToSchema Double where toSchemaDefinitions = plain . paramSchemaToS
165175instance ToSchema Float where toSchemaDefinitions = plain . paramSchemaToSchema
166176
167177instance ToSchema a => ToSchema (Maybe a) where
168− toSchemaDefinitions _ = (defs, unnamed schema)
169− where
170− (defs, (_, schema)) = toSchemaDefinitions (Proxy :: Proxy a)
178+ toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy a)
171179
172180instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
173181
@@ -179,32 +187,30 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchem
179187instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
180188instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
181189
182−timeSchemaDefinitions :: String -> String -> (Definitions, NamedSchema)
183−timeSchemaDefinitions name format = pure (Just name, mempty
190+timeSchema :: String -> Schema
191+timeSchema format = mempty
184192 & schemaType .~ SwaggerString
185193 & schemaFormat ?~ T.pack format
186− & schemaMinLength ?~ toInteger (length format))
194+ & schemaMinLength ?~ toInteger (length format)
187195
188196-- |
189197-- >>> toSchema (Proxy :: Proxy Day) ^. schemaFormat
190198-- Just "yyyy-mm-dd"
191199instance ToSchema Day where
192− toSchemaDefinitions _ = timeSchemaDefinitions "Day" "yyyy-mm-dd"
200+ toSchemaDefinitions _ = pure $ named "Day" (timeSchema "yyyy-mm-dd")
193201
194202-- |
195203-- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
196204-- Just "yyyy-mm-ddThh:MM:ss"
197205instance ToSchema LocalTime where
198− toSchemaDefinitions _ = timeSchemaDefinitions "LocalTime" "yyyy-mm-ddThh:MM:ss"
206+ toSchemaDefinitions _ = pure $ named "LocalTime" (timeSchema "yyyy-mm-ddThh:MM:ss")
199207
200208-- |
201209-- >>> toSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat
202210-- Just "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
203211instance ToSchema ZonedTime where
204− toSchemaDefinitions _ = pure (Just "ZonedTime", mempty
205− & schemaType .~ SwaggerString
206− & schemaFormat ?~ "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
207− & schemaMinLength ?~ toInteger (length ("yyyy-mm-ddThh:MM:ssZ" :: String)))
212+ toSchemaDefinitions _ = pure $ named "ZonedTime" $ timeSchema "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"
213+ & schemaMinLength ?~ toInteger (length ("yyyy-mm-ddThh:MM:ssZ" :: String))
208214
209215instance ToSchema NominalDiffTime where
210216 toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy Integer)
@@ -213,7 +219,7 @@ instance ToSchema NominalDiffTime where
213219-- >>> toSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
214220-- Just "yyyy-mm-ddThh:MM:ssZ"
215221instance ToSchema UTCTime where
216− toSchemaDefinitions _ = timeSchemaDefinitions "UTCTime" "yyyy-mm-ddThh:MM:ssZ"
222+ toSchemaDefinitions _ = pure $ named "UTCTime" (timeSchema "yyyy-mm-ddThh:MM:ssZ")
217223
218224instance ToSchema T.Text where toSchemaDefinitions = plain . paramSchemaToSchema
219225instance ToSchema TL.Text where toSchemaDefinitions = plain . paramSchemaToSchema
@@ -225,13 +231,11 @@ instance ToSchema a => ToSchema (IntMap a) where
225231 toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy [(Int, a)])
226232
227233instance ToSchema a => ToSchema (Map String a) where
228− toSchemaDefinitions _ = (defs, unnamed schema)
229− where
230− schema = mempty
231− & schemaType .~ SwaggerObject
232− & schemaAdditionalProperties ?~ toSchema (Proxy :: Proxy a)
233−
234− (defs, _) = toSchemaDefinitions (Proxy :: Proxy a)
234+ toSchemaDefinitions _ = do
235+ schema <- declareSchema (Proxy :: Proxy a)
236+ return $ unnamed $ mempty
237+ & schemaType .~ SwaggerObject
238+ & schemaAdditionalProperties ?~ schema
235239
236240instance ToSchema a => ToSchema (Map T.Text a) where toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy (Map String a))
237241instance ToSchema a => ToSchema (Map TL.Text a) where toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy (Map String a))
@@ -241,9 +245,10 @@ instance ToSchema a => ToSchema (HashMap T.Text a) where toSchemaDefinitions _
241245instance ToSchema a => ToSchema (HashMap TL.Text a) where toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy (Map String a))
242246
243247instance ToSchema a => ToSchema (Set a) where
244− toSchemaDefinitions _ = (defs, unnamed (schema & schemaUniqueItems ?~ True))
245− where
246− (defs, (_, schema)) = toSchemaDefinitions (Proxy :: Proxy [a])
248+ toSchemaDefinitions _ = do
249+ schema <- declareSchema (Proxy :: Proxy [a])
250+ return $ unnamed $ schema
251+ & schemaUniqueItems ?~ True
247252
248253instance ToSchema a => ToSchema (HashSet a) where toSchemaDefinitions _ = toSchemaDefinitions (Proxy :: Proxy (Set a))
249254
@@ -277,13 +282,13 @@ genericToSchema opts = snd . genericToNamedSchema opts
277282
278283-- | A configurable generic @'NamedSchema'@ creator.
279284genericToNamedSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> NamedSchema
280−genericToNamedSchema opts = snd . genericToSchemaDefinitions opts
285+genericToNamedSchema opts = undeclare . genericToSchemaDefinitions opts
281286
282−-- | A configurable generic @('NamedSchema', 'Definitions')@ creator.
287+-- | A configurable generic @'NamedSchema'@ creator with declarations.
283288-- This function applied to @'defaultSchemaOptions'@
284289-- is used as the default for @'toSchemaDefinitions'@
285290-- when the type is an instance of @'Generic'@.
286−genericToSchemaDefinitions :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> (Definitions, NamedSchema)
291+genericToSchemaDefinitions :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare Definitions NamedSchema
287292genericToSchemaDefinitions opts _ = gtoSchemaDefinitions opts (Proxy :: Proxy (Rep a)) mempty
288293
289294gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe String
@@ -308,44 +313,57 @@ nullarySchema = mempty
308313 & schemaType .~ SwaggerArray
309314 & schemaEnum ?~ [ toJSON () ]
310315
316+gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
317+gtoNamedSchema opts proxy = undeclare $ gtoSchemaDefinitions opts proxy mempty
318+
319+gtoSchema :: GToSchema f => SchemaOptions -> proxy f -> Schema
320+gtoSchema opts = snd . gtoNamedSchema opts
321+
322+gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare Definitions Schema
323+gdeclareSchema opts proxy = snd <$> gtoSchemaDefinitions opts proxy mempty
324+
325+gschemaName :: GToSchema f => SchemaOptions -> proxy f -> Maybe String
326+gschemaName opts = fst . gtoNamedSchema opts
327+
311328instance GToSchema U1 where
312329 gtoSchemaDefinitions _ _ _ = plain nullarySchema
313330
314331instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
315− gtoSchemaDefinitions opts _ (defs, schema) = (fdefs, unnamed fschema)
316− where
317− (fdefs, (_, fschema)) = gtoSchemaDefinitions opts (Proxy :: Proxy f) (gdefs, gschema)
318− (gdefs, (_, gschema)) = gtoSchemaDefinitions opts (Proxy :: Proxy g) (defs, schema)
332+ gtoSchemaDefinitions opts _ schema = do
333+ (_, gschema) <- gtoSchemaDefinitions opts (Proxy :: Proxy g) schema
334+ gtoSchemaDefinitions opts (Proxy :: Proxy f) gschema
319335
320336instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
321− gtoSchemaDefinitions opts _ (ds, s) = (schemaDefs, (name, schema))
337+ gtoSchemaDefinitions opts _ s = rename name <$> gtoSchemaDefinitions opts (Proxy :: Proxy f) s
322338 where
323− (schemaDefs, (_, schema)) = gtoSchemaDefinitions opts (Proxy :: Proxy f) (ds, s)
324339 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
325340
326341instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
327− gtoSchemaDefinitions opts _ (ds, s) = (defs, unnamed schema)
328− where
329− (defs, (_, schema)) = gtoSchemaDefinitions opts (Proxy :: Proxy f) (ds, s)
342+ gtoSchemaDefinitions opts _ = gtoSchemaDefinitions opts (Proxy :: Proxy f)
330343
331344-- | Single field constructor.
332345instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
333− gtoSchemaDefinitions opts _ (ds, s)
334− | unwrapUnaryRecords opts = (fieldDefs, fieldNamedSchema)
335− | otherwise =
346+ gtoSchemaDefinitions opts _ s
347+ | unwrapUnaryRecords opts = fieldSchema
348+ | otherwise = do
349+ (_, schema) <- recordSchema
336350 case schema ^. schemaItems of
337− Just (SchemaItemsArray [_]) -> (fieldDefs, fieldNamedSchema)
338− _ -> (defs, unnamed schema)
351+ Just (SchemaItemsArray [_]) -> fieldSchema
352+ _ -> pure (unnamed schema)
339353 where
340− (defs, (_, schema)) = schemaDefs
341− schemaDefs = gtoSchemaDefinitions opts (Proxy :: Proxy (S1 s f)) (ds, s)
342− (fieldDefs, fieldNamedSchema) = gtoSchemaDefinitions opts (Proxy :: Proxy f) (ds, s)
343−
344−gtoSchemaRef :: GToSchema f => SchemaOptions -> proxy f -> (Definitions, Referenced Schema)
345−gtoSchemaRef opts proxy = case gtoSchemaDefinitions opts proxy mempty of
346− (defs, (Just name, _))
347− | useReferences opts -> (defs, Ref (Reference ("#/definitions/" <> T.pack name)))
348− (defs, (_, schema)) -> (defs, Inline schema)
354+ recordSchema = gtoSchemaDefinitions opts (Proxy :: Proxy (S1 s f)) s
355+ fieldSchema = gtoSchemaDefinitions opts (Proxy :: Proxy f) s
356+
357+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare Definitions (Referenced Schema)
358+gdeclareSchemaRef opts proxy = do
359+ case gtoNamedSchema opts proxy of
360+ (Just name, schema) -> do
361+ known <- looks (HashMap.member (T.pack name))
362+ when (not known) $ do
363+ declare [(T.pack name, schema)]
364+ void $ gtoSchemaDefinitions opts proxy mempty
365+ return $ Ref (Reference ("#/definitions/" <> T.pack name))
366+ _ -> Inline <$> gdeclareSchema opts proxy
349367
350368appendItem :: Referenced Schema -> Maybe SchemaItems -> Maybe SchemaItems
351369appendItem x Nothing = Just (SchemaItemsArray [x])
@@ -353,22 +371,22 @@ appendItem x (Just (SchemaItemsArray xs)) = Just (SchemaItemsArray (x:xs))
353371appendItem _ _ = error "GToSchema.appendItem: cannot append to SchemaItemsObject"
354372
355373withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
356− SchemaOptions -> proxy s f -> Bool -> (Definitions, Schema) -> (Definitions, Schema)
357−withFieldSchema opts _ isRequiredField (ds, schema) = (ds <> defs, schema')
374+ SchemaOptions -> proxy s f -> Bool -> Schema -> Declare Definitions Schema
375+withFieldSchema opts _ isRequiredField schema = do
376+ ref <- gdeclareSchemaRef opts (Proxy :: Proxy f)
377+ return $
378+ if T.null fname
379+ then schema
380+ & schemaType .~ SwaggerArray
381+ & schemaItems %~ appendItem ref
382+ else schema
383+ & schemaType .~ SwaggerObject
384+ & schemaProperties . at fname ?~ ref
385+ & if isRequiredField
386+ then schemaRequired %~ (fname :)
387+ else id
358388 where
359− schema'
360− | T.null fieldName = schema
361− & schemaType .~ SwaggerArray
362− & schemaItems %~ appendItem fieldSchemaRef
363− | otherwise = schema
364− & schemaType .~ SwaggerObject
365− & schemaProperties . at fieldName ?~ fieldSchemaRef
366− & if isRequiredField
367− then schemaRequired %~ (fieldName :)
368− else id
369−
370− fieldName = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
371− (defs, fieldSchemaRef) = gtoSchemaRef opts (Proxy :: Proxy f)
389+ fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
372390
373391-- | Optional record fields.
374392instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
@@ -378,22 +396,19 @@ instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (
378396instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
379397 gtoSchemaDefinitions opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
380398
381−instance ToSchema c => GToSchema (K1 i c) where
382− gtoSchemaDefinitions _ _ (ds, _)
383− | present = (ds, (name, schema))
384− | otherwise = (ds <> defs <> def, (name, schema))
385− where
386− (present, def) = case name of
387− Nothing -> (False, mempty)
388− Just n -> (HashMap.member (T.pack n) ds, [(T.pack n, schema)])
389− (defs, (name, schema)) = toSchemaDefinitions (Proxy :: Proxy c)
399+instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
400+ gtoSchemaDefinitions _ _ _ = toSchemaDefinitions (Proxy :: Proxy c)
401+
402+instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
403+ gtoSchemaDefinitions _ _ _ = toSchemaDefinitions (Proxy :: Proxy c)
390404
391405instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
392− gtoSchemaDefinitions opts _ (ds, s)
393− | allNullaryToStringTag opts && allNullary = (ds, unnamed (toStringTag sumSchema))
394− | otherwise = (ds <> defs, unnamed sumSchema)
406+ gtoSchemaDefinitions opts _ s
407+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
408+ | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
395409 where
396− (All allNullary, (defs, sumSchema)) = gsumToSchema opts (Proxy :: Proxy (f :+: g)) (ds, s)
410+ declareSumSchema = gsumToSchema opts (Proxy :: Proxy (f :+: g)) s
411+ (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
397412
398413 toStringTag schema = mempty
399414 & schemaType .~ SwaggerString
@@ -402,40 +417,35 @@ instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
402417type AllNullary = All
403418
404419class GSumToSchema f where
405− gsumToSchema :: SchemaOptions -> proxy f -> (Definitions, Schema) -> (AllNullary, (Definitions, Schema))
420+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare Definitions) Schema
406421
407422instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
408− gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) `after` gsumToSchema opts (Proxy :: Proxy g)
409− where
410− (f `after` g) s = (a <> b, s'')
411− where
412− (a, s') = f s
413− (b, s'') = g s'
414−
415−gsumConToSchema :: forall c f proxy. Constructor c =>
416− Bool -> (Definitions, Referenced Schema) -> SchemaOptions -> proxy (C1 c f) -> (Definitions, Schema) -> (AllNullary, (Definitions, Schema))
417−gsumConToSchema isNullary (tagSchemaDefs, tagSchemaRef) opts _ (defs, schema) = (All isNullary, (defs <> tagSchemaDefs, schema
418− & schemaType .~ SwaggerObject
419− & schemaProperties . at tag ?~ tagSchemaRef
420− & schemaMaxProperties ?~ 1
421− & schemaMinProperties ?~ 1))
423+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <=< gsumToSchema opts (Proxy :: Proxy g)
424+
425+gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
426+ SchemaOptions -> proxy (C1 c f) -> Schema -> Declare Definitions Schema
427+gsumConToSchema opts _ schema = do
428+ ref <- gdeclareSchemaRef opts (Proxy :: Proxy (C1 c f))
429+ return $ schema
430+ & schemaType .~ SwaggerObject
431+ & schemaProperties . at tag ?~ ref
432+ & schemaMaxProperties ?~ 1
433+ & schemaMinProperties ?~ 1
422434 where
423435 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
424436
425437instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
426− gsumToSchema opts = gsumConToSchema False tagSchemaRef opts
427− where
428− tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c f))
429−
430−instance Constructor c => GSumToSchema (C1 c U1) where
431− gsumToSchema opts = gsumConToSchema True tagSchemaRef opts
432− where
433− tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c U1))
438+ gsumToSchema opts proxy schema = do
439+ tell (All False)
440+ lift $ gsumConToSchema opts proxy schema
434441
435442instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
436− gsumToSchema opts = gsumConToSchema False tagSchemaRef opts
437− where
438− tagSchemaRef = gtoSchemaRef opts (Proxy :: Proxy (C1 c (S1 s f)))
443+ gsumToSchema opts proxy schema = do
444+ tell (All False)
445+ lift $ gsumConToSchema opts proxy schema
446+
447+instance Constructor c => GSumToSchema (C1 c U1) where
448+ gsumToSchema opts proxy = lift . gsumConToSchema opts proxy
439449
440450data Proxy2 a b = Proxy2
441451