@@ -1,5 +1,4 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
4{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -15,12 +14,6 @@
15{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE TypeOperators #-}
16{-# LANGUAGE TypeSynonymInstances #-}
15{-# LANGUAGE TypeSynonymInstances #-}
17{-# LANGUAGE UndecidableInstances #-}
16{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ >= 800
19−-- Few generics related redundant constraints
20−{-# OPTIONS_GHC -Wno-redundant-constraints #-}
22−{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
24#include "overlapping-compat.h"
17#include "overlapping-compat.h"
25module Data.Swagger.Internal.Schema where
18module Data.Swagger.Internal.Schema where
@@ -30,25 +23,27 @@ import Prelude.Compat
30import Control.Lens
23import Control.Lens
31import Data.Data.Lens (template)
24import Data.Data.Lens (template)
26+import Control.Applicative
33import Control.Monad
27import Control.Monad
34import Control.Monad.Writer
28import Control.Monad.Writer
35−import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
29+import Data.Aeson
30+import qualified Data.Aeson.Types as Aeson
36import Data.Char
31import Data.Char
37import Data.Data (Data)
32import Data.Data (Data)
38import Data.Foldable (traverse_)
33import Data.Foldable (traverse_)
34+import Data.Function (on)
39import Data.HashMap.Strict (HashMap)
35import Data.HashMap.Strict (HashMap)
40import qualified Data.HashMap.Strict as HashMap
36import qualified Data.HashMap.Strict as HashMap
41import "unordered-containers" Data.HashSet (HashSet)
37import "unordered-containers" Data.HashSet (HashSet)
42import qualified "unordered-containers" Data.HashSet as HashSet
38import qualified "unordered-containers" Data.HashSet as HashSet
39+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
43import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
40import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
44import Data.Int
41import Data.Int
45import Data.IntSet (IntSet)
42import Data.IntSet (IntSet)
46import Data.IntMap (IntMap)
43import Data.IntMap (IntMap)
47−import Data.List.NonEmpty.Compat (NonEmpty)
48import Data.Map (Map)
44import Data.Map (Map)
49import Data.Proxy
45import Data.Proxy
50import Data.Scientific (Scientific)
46import Data.Scientific (Scientific)
51−import Data.Fixed (Fixed, HasResolution, Pico)
52import Data.Set (Set)
47import Data.Set (Set)
53import qualified Data.Text as T
48import qualified Data.Text as T
54import qualified Data.Text.Lazy as TL
49import qualified Data.Text.Lazy as TL
@@ -57,11 +52,8 @@ import qualified Data.Vector as V
57import qualified Data.Vector.Primitive as VP
52import qualified Data.Vector.Primitive as VP
58import qualified Data.Vector.Storable as VS
53import qualified Data.Vector.Storable as VS
59import qualified Data.Vector.Unboxed as VU
54import qualified Data.Vector.Unboxed as VU
60−import Data.Version (Version)
61−import Numeric.Natural.Compat (Natural)
62import Data.Word
55import Data.Word
63import GHC.Generics
56import GHC.Generics
64−import qualified Data.UUID.Types as UUID
66import Data.Swagger.Declare
58import Data.Swagger.Declare
67import Data.Swagger.Internal
59import Data.Swagger.Internal
@@ -69,7 +61,10 @@ import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
69import Data.Swagger.Lens hiding (name, schema)
61import Data.Swagger.Lens hiding (name, schema)
70import qualified Data.Swagger.Lens as Swagger
62import qualified Data.Swagger.Lens as Swagger
71import Data.Swagger.SchemaOptions
63import Data.Swagger.SchemaOptions
72−import Data.Swagger.Internal.TypeShape
66+import Data.Swagger.Lens (name, schema)
74#if __GLASGOW_HASKELL__ < 800
69#if __GLASGOW_HASKELL__ < 800
@@ -102,16 +97,14 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
102-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
97-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' and 'HashMap' as lists
104-- import Control.Lens
99-- import Control.Lens
106−-- import Data.Swagger
108-- data Coord = Coord { x :: Double, y :: Double }
101-- data Coord = Coord { x :: Double, y :: Double }
110-- instance ToSchema Coord where
103-- instance ToSchema Coord where
111−-- declareNamedSchema _ = do
104+-- declareNamedSchema = do
112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
105-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
113−-- return $ NamedSchema (Just \"Coord\") $ mempty
106+-- return $ NamedSchema (Just \"Coord\")) $ mempty
114−-- & type_ ?~ SwaggerObject
107+-- & type_ .~ SwaggerObject
115-- & properties .~
108-- & properties .~
116-- [ (\"x\", doubleSchema)
109-- [ (\"x\", doubleSchema)
117-- , (\"y\", doubleSchema)
110-- , (\"y\", doubleSchema)
@@ -142,17 +135,12 @@ class ToSchema a where
142 -- together with all used definitions.
135 -- together with all used definitions.
143 -- Note that the schema itself is included in definitions
136 -- Note that the schema itself is included in definitions
144 -- only if it is recursive (and thus needs its definition in scope).
137 -- only if it is recursive (and thus needs its definition in scope).
145− declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
138+ declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema
146− default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
147− Proxy a -> Declare (Definitions Schema) NamedSchema
139+ default declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare (Definitions Schema) NamedSchema
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
140 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
150−instance ToSchema TimeOfDay where
151− declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss"
152− & example ?~ toJSON (TimeOfDay 12 33 15)
154-- | Convert a type into a schema and declare all used schema definitions.
142-- | Convert a type into a schema and declare all used schema definitions.
155−declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
143+declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema
156declareSchema = fmap _namedSchemaSchema . declareNamedSchema
144declareSchema = fmap _namedSchemaSchema . declareNamedSchema
158-- | Convert a type into an optionally named schema.
146-- | Convert a type into an optionally named schema.
@@ -166,7 +154,7 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
166-- Just "Day"
154-- Just "Day"
167-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
155-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
168-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
156-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
169−toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
157+toNamedSchema :: ToSchema a => proxy a -> NamedSchema
170toNamedSchema = undeclare . declareNamedSchema
158toNamedSchema = undeclare . declareNamedSchema
172-- | Get type's schema name according to its @'ToSchema'@ instance.
160-- | Get type's schema name according to its @'ToSchema'@ instance.
@@ -176,7 +164,7 @@ toNamedSchema = undeclare . declareNamedSchema
177-- >>> schemaName (Proxy :: Proxy UTCTime)
165-- >>> schemaName (Proxy :: Proxy UTCTime)
178-- Just "UTCTime"
166-- Just "UTCTime"
179−schemaName :: ToSchema a => Proxy a -> Maybe T.Text
167+schemaName :: ToSchema a => proxy a -> Maybe T.Text
180schemaName = _namedSchemaName . toNamedSchema
168schemaName = _namedSchemaName . toNamedSchema
182-- | Convert a type into a schema.
170-- | Convert a type into a schema.
@@ -186,7 +174,7 @@ schemaName = _namedSchemaName . toNamedSchema
187-- >>> encode $ toSchema (Proxy :: Proxy [Day])
175-- >>> encode $ toSchema (Proxy :: Proxy [Day])
188-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
176-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
189−toSchema :: ToSchema a => Proxy a -> Schema
177+toSchema :: ToSchema a => proxy a -> Schema
190toSchema = _namedSchemaSchema . toNamedSchema
178toSchema = _namedSchemaSchema . toNamedSchema
192-- | Convert a type into a referenced schema if possible.
180-- | Convert a type into a referenced schema if possible.
@@ -197,7 +185,7 @@ toSchema = _namedSchemaSchema . toNamedSchema
198-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
186-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
199-- "{\"$ref\":\"#/definitions/Day\"}"
187-- "{\"$ref\":\"#/definitions/Day\"}"
200−toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
188+toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
201toSchemaRef = undeclare . declareSchemaRef
189toSchemaRef = undeclare . declareSchemaRef
203-- | Convert a type into a referenced schema if possible
191-- | Convert a type into a referenced schema if possible
@@ -207,7 +195,7 @@ toSchemaRef = undeclare . declareSchemaRef
207-- Schema definitions are typically declared for every referenced schema.
195-- Schema definitions are typically declared for every referenced schema.
208-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
196-- If @'declareSchemaRef'@ returns a reference, a corresponding schema
209-- will be declared (regardless of whether it is recusive or not).
197-- will be declared (regardless of whether it is recusive or not).
210−declareSchemaRef :: ToSchema a => Proxy a -> Declare (Definitions Schema) (Referenced Schema)
198+declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema)
211declareSchemaRef proxy = do
199declareSchemaRef proxy = do
212 case toNamedSchema proxy of
200 case toNamedSchema proxy of
213 NamedSchema (Just name) schema -> do
201 NamedSchema (Just name) schema -> do
@@ -269,7 +257,7 @@ inlineAllSchemas = inlineSchemasWhen (const True)
270-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
258-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
271-- when inlining recursive schemas.
259-- when inlining recursive schemas.
272−toInlinedSchema :: ToSchema a => Proxy a -> Schema
260+toInlinedSchema :: ToSchema a => proxy a -> Schema
273toInlinedSchema proxy = inlineAllSchemas defs schema
261toInlinedSchema proxy = inlineAllSchemas defs schema
275 (defs, schema) = runDeclare (declareSchema proxy) mempty
263 (defs, schema) = runDeclare (declareSchema proxy) mempty
@@ -298,20 +286,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
298-- | Default schema for binary data (any sequence of octets).
286-- | Default schema for binary data (any sequence of octets).
299binarySchema :: Schema
287binarySchema :: Schema
300binarySchema = mempty
288binarySchema = mempty
301− & type_ ?~ SwaggerString
289+ & type_ .~ SwaggerString
302 & format ?~ "binary"
290 & format ?~ "binary"
304-- | Default schema for binary data (base64 encoded).
292-- | Default schema for binary data (base64 encoded).
305byteSchema :: Schema
293byteSchema :: Schema
306byteSchema = mempty
294byteSchema = mempty
307− & type_ ?~ SwaggerString
295+ & type_ .~ SwaggerString
308 & format ?~ "byte"
296 & format ?~ "byte"
310-- | Default schema for password string.
298-- | Default schema for password string.
311-- @"password"@ format is used to hint UIs the input needs to be obscured.
299-- @"password"@ format is used to hint UIs the input needs to be obscured.
312passwordSchema :: Schema
300passwordSchema :: Schema
313passwordSchema = mempty
301passwordSchema = mempty
314− & type_ ?~ SwaggerString
302+ & type_ .~ SwaggerString
315 & format ?~ "password"
303 & format ?~ "password"
317-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
305-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
@@ -337,12 +325,12 @@ sketchSchema = sketch . toJSON
337 sketch js@(Bool _) = go js
325 sketch js@(Bool _) = go js
338 sketch js = go js & example ?~ js
326 sketch js = go js & example ?~ js
340− go Null = mempty & type_ ?~ SwaggerNull
328+ go Null = mempty & type_ .~ SwaggerNull
341− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
329+ go js@(Bool _) = mempty & type_ .~ SwaggerBoolean
342− go (String _) = mempty & type_ ?~ SwaggerString
330+ go js@(String s) = mempty & type_ .~ SwaggerString
343− go (Number _) = mempty & type_ ?~ SwaggerNumber
331+ go js@(Number n) = mempty & type_ .~ SwaggerNumber
344− go (Array xs) = mempty
332+ go js@(Array xs) = mempty
345− & type_ ?~ SwaggerArray
333+ & type_ .~ SwaggerArray
346 & items ?~ case ischema of
334 & items ?~ case ischema of
347 Just s -> SwaggerItemsObject (Inline s)
335 Just s -> SwaggerItemsObject (Inline s)
348 _ -> SwaggerItemsArray (map Inline ys)
336 _ -> SwaggerItemsArray (map Inline ys)
@@ -351,10 +339,10 @@ sketchSchema = sketch . toJSON
351 allSame = and ((zipWith (==)) ys (tail ys))
339 allSame = and ((zipWith (==)) ys (tail ys))
353 ischema = case ys of
341 ischema = case ys of
354− (z:_) | allSame -> Just z
342+ (z:zs) | allSame -> Just z
355− _ -> Nothing
343+ _ -> Nothing
356− go (Object o) = mempty
344+ go js@(Object o) = mempty
357− & type_ ?~ SwaggerObject
345+ & type_ .~ SwaggerObject
358 & required .~ HashMap.keys o
346 & required .~ HashMap.keys o
359 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
347 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
@@ -377,24 +365,24 @@ sketchSchema = sketch . toJSON
377sketchStrictSchema :: ToJSON a => a -> Schema
365sketchStrictSchema :: ToJSON a => a -> Schema
378sketchStrictSchema = go . toJSON
366sketchStrictSchema = go . toJSON
380− go Null = mempty & type_ ?~ SwaggerNull
368+ go Null = mempty & type_ .~ SwaggerNull
381 go js@(Bool _) = mempty
369 go js@(Bool _) = mempty
382− & type_ ?~ SwaggerBoolean
370+ & type_ .~ SwaggerBoolean
383 & enum_ ?~ [js]
371 & enum_ ?~ [js]
384 go js@(String s) = mempty
372 go js@(String s) = mempty
385− & type_ ?~ SwaggerString
373+ & type_ .~ SwaggerString
386 & maxLength ?~ fromIntegral (T.length s)
374 & maxLength ?~ fromIntegral (T.length s)
387 & minLength ?~ fromIntegral (T.length s)
375 & minLength ?~ fromIntegral (T.length s)
388 & pattern ?~ s
376 & pattern ?~ s
389 & enum_ ?~ [js]
377 & enum_ ?~ [js]
390 go js@(Number n) = mempty
378 go js@(Number n) = mempty
391− & type_ ?~ SwaggerNumber
379+ & type_ .~ SwaggerNumber
392 & maximum_ ?~ n
380 & maximum_ ?~ n
393 & minimum_ ?~ n
381 & minimum_ ?~ n
394 & multipleOf ?~ n
382 & multipleOf ?~ n
395 & enum_ ?~ [js]
383 & enum_ ?~ [js]
396 go js@(Array xs) = mempty
384 go js@(Array xs) = mempty
397− & type_ ?~ SwaggerArray
385+ & type_ .~ SwaggerArray
398 & maxItems ?~ fromIntegral sz
386 & maxItems ?~ fromIntegral sz
399 & minItems ?~ fromIntegral sz
387 & minItems ?~ fromIntegral sz
400 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
388 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
@@ -404,7 +392,7 @@ sketchStrictSchema = go . toJSON
404 sz = length xs
392 sz = length xs
405 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
393 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
406 go js@(Object o) = mempty
394 go js@(Object o) = mempty
407− & type_ ?~ SwaggerObject
395+ & type_ .~ SwaggerObject
408 & required .~ names
396 & required .~ names
409 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
397 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
410 & maxProperties ?~ fromIntegral (length names)
398 & maxProperties ?~ fromIntegral (length names)
@@ -414,19 +402,18 @@ sketchStrictSchema = go . toJSON
414 names = HashMap.keys o
402 names = HashMap.keys o
416class GToSchema (f :: * -> *) where
404class GToSchema (f :: * -> *) where
417− gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
405+ gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
419instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
407instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
420 declareNamedSchema _ = do
408 declareNamedSchema _ = do
421 ref <- declareSchemaRef (Proxy :: Proxy a)
409 ref <- declareSchemaRef (Proxy :: Proxy a)
422 return $ unnamed $ mempty
410 return $ unnamed $ mempty
423− & type_ ?~ SwaggerArray
411+ & type_ .~ SwaggerArray
424 & items ?~ SwaggerItemsObject ref
412 & items ?~ SwaggerItemsObject ref
426instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
414instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
427instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
415instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
428instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
416instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
429−instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
430instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
417instance ToSchema Int where declareNamedSchema = plain . paramSchemaToSchema
431instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
418instance ToSchema Int8 where declareNamedSchema = plain . paramSchemaToSchema
432instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
419instance ToSchema Int16 where declareNamedSchema = plain . paramSchemaToSchema
@@ -446,8 +433,6 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
446instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
433instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
447instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
434instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
449−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
451instance ToSchema a => ToSchema (Maybe a) where
436instance ToSchema a => ToSchema (Maybe a) where
452 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
437 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -456,11 +441,6 @@ instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
456instance ToSchema () where
441instance ToSchema () where
457 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
442 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
459−-- | For 'ToJSON' instance, see <http://hackage.haskell.org/package/uuid-aeson uuid-aeson> package.
460−instance ToSchema UUID.UUID where
461− declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
462− & example ?~ toJSON (UUID.toText UUID.nil)
464instance (ToSchema a, ToSchema b) => ToSchema (a, b)
444instance (ToSchema a, ToSchema b) => ToSchema (a, b)
465instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
445instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
466instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
446instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
@@ -470,7 +450,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
471timeSchema :: T.Text -> Schema
451timeSchema :: T.Text -> Schema
472timeSchema fmt = mempty
452timeSchema fmt = mempty
473− & type_ ?~ SwaggerString
453+ & type_ .~ SwaggerString
474 & format ?~ fmt
454 & format ?~ fmt
476-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
456-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -491,7 +471,7 @@ instance ToSchema ZonedTime where
491 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
471 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
493instance ToSchema NominalDiffTime where
473instance ToSchema NominalDiffTime where
494− declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Pico)
474+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)
497-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
477-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
@@ -503,8 +483,6 @@ instance ToSchema UTCTime where
503instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
483instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema
504instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
484instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
506−instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema
508#if __GLASGOW_HASKELL__ < 800
486#if __GLASGOW_HASKELL__ < 800
510type family ToSchemaByteStringError bs where
488type family ToSchemaByteStringError bs where
@@ -524,27 +502,12 @@ instance ToSchema a => ToSchema (IntMap a) where
524 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
502 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
526#if MIN_VERSION_aeson(1,0,0)
504#if MIN_VERSION_aeson(1,0,0)
527−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
528− declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
529− ToJSONKeyText _ _ -> declareObjectMapSchema
530− ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
532− declareObjectMapSchema = do
533− schema <- declareSchemaRef (Proxy :: Proxy v)
534− return $ unnamed $ mempty
535− & type_ ?~ SwaggerObject
536− & additionalProperties ?~ AdditionalPropertiesSchema schema
538−instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
539− declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
543instance ToSchema a => ToSchema (Map String a) where
506instance ToSchema a => ToSchema (Map String a) where
544 declareNamedSchema _ = do
507 declareNamedSchema _ = do
545 schema <- declareSchemaRef (Proxy :: Proxy a)
508 schema <- declareSchemaRef (Proxy :: Proxy a)
546 return $ unnamed $ mempty
509 return $ unnamed $ mempty
547− & type_ ?~ SwaggerObject
510+ & type_ .~ SwaggerObject
548 & additionalProperties ?~ schema
511 & additionalProperties ?~ schema
550instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
513instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
@@ -554,13 +517,23 @@ instance ToSchema a => ToSchema (HashMap String a) where declareNamedSchema _ =
554instance ToSchema a => ToSchema (HashMap T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
517instance ToSchema a => ToSchema (HashMap T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
555instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
518instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
522+instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
523+ declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction v of
524+ ToJSONKeyText _ _ -> declareObjectMapSchema
525+ ToJSONKeyValue _ _ -> declareNamedSchema (Proxy :: Proxy [(k, v)])
527+ declareObjectMapSchema = do
528+ schema <- declareSchemaRef (Proxy :: Proxy v)
529+ return $ unnamed $ mempty
530+ & type_ .~ SwaggerObject
531+ & additionalProperties ?~ schema
533+instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
534+ declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
559−instance OVERLAPPING_ ToSchema Object where
536+#endif
560− declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
561− & type_ ?~ SwaggerObject
562− & description ?~ "Arbitrary JSON object."
563− & additionalProperties ?~ AdditionalPropertiesAllowed True
565instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
538instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
566instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
539instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])
@@ -575,13 +548,6 @@ instance ToSchema a => ToSchema (Set a) where
576instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
549instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
579−instance ToSchema a => ToSchema (NonEmpty a) where
580− declareNamedSchema _ = do
581− schema <- declareSchema (Proxy :: Proxy [a])
582− return $ unnamed $ schema
583− & minItems .~ Just 1
585instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
551instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
586instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
552instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
@@ -591,141 +557,61 @@ instance ToSchema a => ToSchema (First a) where declareNamedSchema _ = unname
591instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
557instance ToSchema a => ToSchema (Last a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
592instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
558instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)
594−instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
596-- | Default schema for @'Bounded'@, @'Integral'@ types.
560-- | Default schema for @'Bounded'@, @'Integral'@ types.
598-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
562-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
599-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
563-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
600−toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
564+toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
601toSchemaBoundedIntegral _ = mempty
565toSchemaBoundedIntegral _ = mempty
602− & type_ ?~ SwaggerInteger
566+ & type_ .~ SwaggerInteger
603 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
567 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
604 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
568 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
606-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
570-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
607−genericToNamedSchemaBoundedIntegral :: forall a d f.
571+genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
608 ( Bounded a, Integral a
572 ( Bounded a, Integral a
609 , Generic a, Rep a ~ D1 d f, Datatype d)
573 , Generic a, Rep a ~ D1 d f, Datatype d)
610− => SchemaOptions -> Proxy a -> NamedSchema
574+ => SchemaOptions -> proxy a -> NamedSchema
611genericToNamedSchemaBoundedIntegral opts proxy
575genericToNamedSchemaBoundedIntegral opts proxy
612− = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
576+ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (toSchemaBoundedIntegral proxy)
614−-- | Declare a named schema for a @newtype@ wrapper.
615−genericDeclareNamedSchemaNewtype :: forall a d c s i inner.
616− (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
617− => SchemaOptions -- ^ How to derive the name.
618− -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.
620− -> Declare (Definitions Schema) NamedSchema
621−genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)
623−-- | Declare 'Schema' for a mapping with 'Bounded' 'Enum' keys.
624−-- This makes a much more useful schema when there aren't many options for key values.
626−-- >>> data ButtonState = Neutral | Focus | Active | Hover | Disabled deriving (Show, Bounded, Enum, Generic)
627−-- >>> instance ToJSON ButtonState
628−-- >>> instance ToSchema ButtonState
629−-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
630−-- >>> type ImageUrl = T.Text
631−-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
632−-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
634−-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
635−-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
636−declareSchemaBoundedEnumKeyMapping :: forall map key value.
637− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
638− => Proxy (map key value) -> Declare (Definitions Schema) Schema
639−declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
640− ToJSONKeyText keyToText _ -> objectSchema keyToText
641− ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
643− objectSchema keyToText = do
644− valueRef <- declareSchemaRef (Proxy :: Proxy value)
645− let allKeys = [minBound..maxBound :: key]
646− mkPair k = (keyToText k, valueRef)
648− & type_ ?~ SwaggerObject
649− & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
651−-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
652−-- This makes a much more useful schema when there aren't many options for key values.
654−-- >>> data ButtonState = Neutral | Focus | Active | Hover | Disabled deriving (Show, Bounded, Enum, Generic)
655−-- >>> instance ToJSON ButtonState
656−-- >>> instance ToSchema ButtonState
657−-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
658−-- >>> type ImageUrl = T.Text
659−-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
660−-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
662−-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
663−-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
664−toSchemaBoundedEnumKeyMapping :: forall map key value.
665− (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
666− => Proxy (map key value) -> Schema
667−toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
669-- | A configurable generic @'Schema'@ creator.
578-- | A configurable generic @'Schema'@ creator.
670−genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
671− SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
579+genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema
672−genericDeclareSchema = genericDeclareSchemaUnrestricted
580+genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
674-- | A configurable generic @'NamedSchema'@ creator.
582-- | A configurable generic @'NamedSchema'@ creator.
675-- This function applied to @'defaultSchemaOptions'@
583-- This function applied to @'defaultSchemaOptions'@
676-- is used as the default for @'declareNamedSchema'@
584-- is used as the default for @'declareNamedSchema'@
677-- when the type is an instance of @'Generic'@.
585-- when the type is an instance of @'Generic'@.
678−genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
679− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
680−genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted
682−-- | A configurable generic @'Schema'@ creator.
684−-- Unlike 'genericDeclareSchema' also works for mixed sum types.
685−-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
686−genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
687−genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
689−-- | A configurable generic @'NamedSchema'@ creator.
691−-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
692−-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
693−genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
694− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
586+genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema
695−genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
587+genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
697−-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
698−genericNameSchema :: forall a d f.
699− (Generic a, Rep a ~ D1 d f, Datatype d)
700− => SchemaOptions -> Proxy a -> Schema -> NamedSchema
701−genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))
703−gdatatypeSchemaName :: forall d. Datatype d => SchemaOptions -> Proxy d -> Maybe T.Text
589+gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text
704−gdatatypeSchemaName opts _ = case orig of
590+gdatatypeSchemaName opts _ = case name of
705 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
591 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)
706 _ -> Nothing
592 _ -> Nothing
708− orig = datatypeName (Proxy3 :: Proxy3 d f a)
594+ name = datatypeNameModifier opts (datatypeName (Proxy3 :: Proxy3 d f a))
709− name = datatypeNameModifier opts orig
711-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
596-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
597+paramSchemaToNamedSchema :: forall a d f proxy.
712−paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
598+ (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)
713− SchemaOptions -> Proxy a -> NamedSchema
599+ => SchemaOptions -> proxy a -> NamedSchema
714−paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
600+paramSchemaToNamedSchema opts proxy = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (paramSchemaToSchema proxy)
716-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
602-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
717−paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
603+paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema
718−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
604+paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)
720nullarySchema :: Schema
606nullarySchema :: Schema
721nullarySchema = mempty
607nullarySchema = mempty
722− & type_ ?~ SwaggerArray
608+ & type_ .~ SwaggerArray
723 & items ?~ SwaggerItemsArray []
609 & items ?~ SwaggerItemsArray []
725−gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
611+gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
726gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
612gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
728−gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
614+gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare (Definitions Schema) Schema
729gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
615gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
731instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
617instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
@@ -745,7 +631,7 @@ instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where
745 gdeclareNamedSchema = gdeclareNamedSumSchema
631 gdeclareNamedSchema = gdeclareNamedSumSchema
747-- | Single field constructor.
633-- | Single field constructor.
748−instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where
634+instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
749 gdeclareNamedSchema opts _ s
635 gdeclareNamedSchema opts _ s
750 | unwrapUnaryRecords opts = fieldSchema
636 | unwrapUnaryRecords opts = fieldSchema
751 | otherwise =
637 | otherwise =
@@ -759,7 +645,7 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
759 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
645 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
760 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
646 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
762−gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
648+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare (Definitions Schema) (Referenced Schema)
763gdeclareSchemaRef opts proxy = do
649gdeclareSchemaRef opts proxy = do
764 case gtoNamedSchema opts proxy of
650 case gtoNamedSchema opts proxy of
765 NamedSchema (Just name) schema -> do
651 NamedSchema (Just name) schema -> do
@@ -778,7 +664,7 @@ gdeclareSchemaRef opts proxy = do
778 return $ Ref (Reference name)
664 return $ Ref (Reference name)
779 _ -> Inline <$> gdeclareSchema opts proxy
665 _ -> Inline <$> gdeclareSchema opts proxy
781−appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
667+appendItem :: Referenced Schema -> Maybe (SwaggerItems SwaggerKindSchema) -> Maybe (SwaggerItems SwaggerKindSchema)
782appendItem x Nothing = Just (SwaggerItemsArray [x])
668appendItem x Nothing = Just (SwaggerItemsArray [x])
783appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
669appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
784appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
670appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
@@ -790,12 +676,10 @@ withFieldSchema opts _ isRequiredField schema = do
791 if T.null fname
677 if T.null fname
792 then schema
678 then schema
793− & type_ ?~ SwaggerArray
679+ & type_ .~ SwaggerArray
794 & items %~ appendItem ref
680 & items %~ appendItem ref
795− & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
796− & minItems %~ Just . maybe 1 (+1) -- increment minItems
797 else schema
681 else schema
798− & type_ ?~ SwaggerObject
682+ & type_ .~ SwaggerObject
799 & properties . at fname ?~ ref
683 & properties . at fname ?~ ref
800 & if isRequiredField
684 & if isRequiredField
801 then required %~ (++ [fname])
685 then required %~ (++ [fname])
@@ -817,13 +701,10 @@ instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where
817instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
701instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
818 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
702 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
820−instance ( GSumToSchema f
704+instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where
822− ) => GToSchema (f :+: g)
824 gdeclareNamedSchema = gdeclareNamedSumSchema
705 gdeclareNamedSchema = gdeclareNamedSumSchema
826−gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
707+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
827gdeclareNamedSumSchema opts proxy s
708gdeclareNamedSumSchema opts proxy s
828 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
709 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
829 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
710 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
@@ -832,29 +713,29 @@ gdeclareNamedSumSchema opts proxy s
832 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
713 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
834 toStringTag schema = mempty
715 toStringTag schema = mempty
835− & type_ ?~ SwaggerString
716+ & type_ .~ SwaggerString
836 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
717 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
838type AllNullary = All
719type AllNullary = All
840−class GSumToSchema (f :: * -> *) where
721+class GSumToSchema f where
841− gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
722+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
843instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
724instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
844 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
725 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
846−gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
727+gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
847− Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
728+ Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema
848gsumConToSchemaWith ref opts _ schema = schema
729gsumConToSchemaWith ref opts _ schema = schema
849− & type_ ?~ SwaggerObject
730+ & type_ .~ SwaggerObject
850 & properties . at tag ?~ ref
731 & properties . at tag ?~ ref
851 & maxProperties ?~ 1
732 & maxProperties ?~ 1
852 & minProperties ?~ 1
733 & minProperties ?~ 1
854 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
735 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
856−gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
737+gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
857− SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
738+ SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
858gsumConToSchema opts proxy schema = do
739gsumConToSchema opts proxy schema = do
859 ref <- gdeclareSchemaRef opts proxy
740 ref <- gdeclareSchemaRef opts proxy
860 return $ gsumConToSchemaWith ref opts proxy schema
741 return $ gsumConToSchemaWith ref opts proxy schema
@@ -876,7 +757,3 @@ data Proxy2 a b = Proxy2
877data Proxy3 a b c = Proxy3
758data Proxy3 a b c = Proxy3
880−-- >>> import Data.Swagger
881−-- >>> import Data.Aeson (encode)
882−-- >>> import Data.Aeson.Types (toJSONKeyText)