@@ -29,6 +29,8 @@ import GHC.Generics
29import Data.Swagger.Internal
29import Data.Swagger.Internal
30import Data.Swagger.Lens
30import Data.Swagger.Lens
32+-- | A @'Schema'@ with an optional name.
33+-- This name can be used in references.
32type NamedSchema = (Maybe String, Schema)
34type NamedSchema = (Maybe String, Schema)
34unnamed :: Schema -> NamedSchema
36unnamed :: Schema -> NamedSchema
@@ -37,17 +39,62 @@ unnamed schema = (Nothing, schema)
37named :: String -> Schema -> NamedSchema
39named :: String -> Schema -> NamedSchema
38named name schema = (Just name, schema)
40named name schema = (Just name, schema)
42+-- | Convert a type into @'Schema'@.
44+-- An example type and instance:
47+-- {-\# LANGUAGE OverloadedStrings \#-} -- allows to write 'T.Text' literals
48+-- {-\# LANGUAGE OverloadedLists \#-} -- allows to write 'Map' as list
50+-- import Control.Lens
52+-- data Coord = Coord { x :: Double, y :: Double }
54+-- instance ToSchema Coord where
55+-- toNamedSchema = (Just \"Coord\", mempty
56+-- & schemaType .~ SchemaObject
57+-- & schemaProperties .~
58+-- [ ("x", toSchemaRef (Proxy :: Proxy Double))
59+-- , ("y", toSchemaRef (Proxy :: Proxy Double))
61+-- & schemaRequired .~ [ "x", "y" ]
64+-- Instead of manually writing your @'ToSchema'@ instance you can
65+-- use a default generic implementation of @'toNamedSchema'@.
67+-- To do that, simply add @deriving 'Generic'@ clause to your datatype
68+-- and declare a @'ToSchema'@ instance for your datatype without
69+-- giving definition for @'toNamedSchema'@.
71+-- For instance, the previous example can be simplified into this:
74+-- {-\# LANGUAGE DeriveGeneric \#-}
76+-- import GHC.Generics (Generic)
78+-- data Coord = Coord { x :: Double, y :: Double } deriving Generic
80+-- instance ToSchema Coord
40class ToSchema a where
82class ToSchema a where
83+ -- | Convert a type into an optionally named schema.
41 toNamedSchema :: proxy a -> NamedSchema
84 toNamedSchema :: proxy a -> NamedSchema
42 default toNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> NamedSchema
85 default toNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> NamedSchema
43 toNamedSchema = genericToNamedSchema defaultSchemaOptions
86 toNamedSchema = genericToNamedSchema defaultSchemaOptions
88+-- | Get type's schema name according to its @'ToSchema'@ instance.
45schemaName :: ToSchema a => proxy a -> Maybe String
89schemaName :: ToSchema a => proxy a -> Maybe String
46schemaName = fst . toNamedSchema
90schemaName = fst . toNamedSchema
92+-- | Convert a type into a schema.
48toSchema :: ToSchema a => proxy a -> Schema
93toSchema :: ToSchema a => proxy a -> Schema
49toSchema = snd . toNamedSchema
94toSchema = snd . toNamedSchema
96+-- | Convert a type into a referenced schema if possible.
97+-- Only named schemas can be references, nameless schemas are inlined.
51toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
98toSchemaRef :: ToSchema a => proxy a -> Referenced Schema
52toSchemaRef proxy = case toNamedSchema proxy of
99toSchemaRef proxy = case toNamedSchema proxy of
53 (Just name, _) -> Ref (Reference ("#/definitions/" <> T.pack name))
100 (Just name, _) -> Ref (Reference ("#/definitions/" <> T.pack name))
@@ -134,15 +181,49 @@ instance ToSchema a => ToSchema (First a) where toNamedSchema _ = unnamed $ to
134instance ToSchema a => ToSchema (Last a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
181instance ToSchema a => ToSchema (Last a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
135instance ToSchema a => ToSchema (Dual a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
182instance ToSchema a => ToSchema (Dual a) where toNamedSchema _ = unnamed $ toSchema (Proxy :: Proxy a)
184+-- | Options that specify how to encode your type to Swagger schema.
137data SchemaOptions = SchemaOptions
185data SchemaOptions = SchemaOptions
186+ { -- | Function applied to field labels. Handy for removing common record prefixes for example.
138− { fieldLabelModifier :: String -> String
187+ fieldLabelModifier :: String -> String
188+ -- | Function applied to constructor tags which could be handy for lower-casing them for example.
139 , constructorTagModifier :: String -> String
189 , constructorTagModifier :: String -> String
190+ -- | Function applied to datatype name.
140 , datatypeNameModifier :: String -> String
191 , datatypeNameModifier :: String -> String
192+ -- | If @'True'@ the constructors of a datatype, with all nullary constructors,
193+ -- will be encoded to a string enumeration schema with the constructor tags as possible values.
141 , allNullaryToStringTag :: Bool
194 , allNullaryToStringTag :: Bool
195+ -- | If @'True'@ direct subschemas will be referenced if possible (rather than inlined).
196+ -- Note that this option does not influence nested schemas, e.g. for these types
199+ -- data Object = Object String deriving Generic
200+ -- instance ToSchema Object
202+ -- newtype Objects = Objects [Object] deriving Generic
203+ -- instance ToSchema Objects where
204+ -- toNamedSchema = genericToNamedSchema defaultSchemaOptions
205+ -- { useReferences = False }
208+ -- Schema for @Objects@ __will not__ inline @Object@ schema because
209+ -- it is nested in a @[]@ schema.
142 , useReferences :: Bool
210 , useReferences :: Bool
211+ -- | Hide the field name when a record constructor has only one field, like a newtype.
143 , unwrapUnaryRecords :: Bool
212 , unwrapUnaryRecords :: Bool
215+-- | Default encoding @'SchemaOptions'@.
219+-- { 'fieldLabelModifier' = id
220+-- , 'constructorTagModifier' = id
221+-- , 'datatypeNameModifier' = id
222+-- , 'allNullaryToStringTag' = True
223+-- , 'useReferences' = True
224+-- , 'unwrapUnaryRecords' = False
146defaultSchemaOptions :: SchemaOptions
227defaultSchemaOptions :: SchemaOptions
147defaultSchemaOptions = SchemaOptions
228defaultSchemaOptions = SchemaOptions
148 { fieldLabelModifier = id
229 { fieldLabelModifier = id
@@ -153,12 +234,14 @@ defaultSchemaOptions = SchemaOptions
153 , unwrapUnaryRecords = False
234 , unwrapUnaryRecords = False
237+-- | Default schema for @'Bounded'@, @'Integral'@ types.
156toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
238toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
157toSchemaBoundedIntegral _ = mempty
239toSchemaBoundedIntegral _ = mempty
158 & schemaType .~ SchemaInteger
240 & schemaType .~ SchemaInteger
159 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
241 & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
160 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
242 & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
244+-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
162genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
245genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
163 ( Bounded a, Integral a
246 ( Bounded a, Integral a
164 , Generic a, Rep a ~ D1 d f, Datatype d)
247 , Generic a, Rep a ~ D1 d f, Datatype d)
@@ -166,9 +249,14 @@ genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
166genericToNamedSchemaBoundedIntegral opts proxy
249genericToNamedSchemaBoundedIntegral opts proxy
167 = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedIntegral proxy)
250 = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedIntegral proxy)
252+-- | A configurable generic @'Schema'@ creator.
169genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
253genericToSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Schema
170genericToSchema opts = snd . genericToNamedSchema opts
254genericToSchema opts = snd . genericToNamedSchema opts
256+-- | A configurable generic @'NamedSchema'@ creator.
257+-- This function applied to @'defaultSchemaOptions'@
258+-- is used as the default for @'toNamedSchema'@
259+-- when the type is an instance of @'Generic'@.
172genericToNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> NamedSchema
260genericToNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> NamedSchema
173genericToNamedSchema opts _ = gtoNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
261genericToNamedSchema opts _ = gtoNamedSchema opts (Proxy :: Proxy (Rep a)) mempty