a6d7769 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Merge pull request #42 from GetShopTV/named-schema-data-#40

a6d7769Nickolay Kudasov11 years ago

src/Data/Swagger.hs+2

compare with master

unifiedsplit

@@ -45,6 +45,7 @@ module Data.Swagger (

45 -- ** Types and formats

46 SwaggerType(..),

47 Format,

48+ Definitions,

48 CollectionFormat(..),

49 CollectionFormat(..),

50 -- ** Parameters

51 -- ** Parameters

@@ -60,6 +61,7 @@ module Data.Swagger (

60 -- ** Schemas

61 -- ** Schemas

61 ParamSchema(..),

62 ParamSchema(..),

62 Schema(..),

63 Schema(..),

64+ NamedSchema(..),

63 SwaggerItems(..),

65 SwaggerItems(..),

64 Xml(..),

66 Xml(..),

src/Data/Swagger/Internal.hs+19−9

@@ -33,6 +33,9 @@ import Text.Read (readMaybe)

34import Data.Swagger.Internal.Utils

36+-- | A list of definitions that can be used in references.

37+type Definitions = HashMap Text

38+

36-- | This is the root document object for the API specification.

39-- | This is the root document object for the API specification.

37data Swagger = Swagger

40data Swagger = Swagger

38 { -- | Provides metadata about the API.

41 { -- | Provides metadata about the API.

@@ -57,25 +60,25 @@ data Swagger = Swagger

57 , _consumes :: MimeList

60 , _consumes :: MimeList

59 -- | A list of MIME types the APIs can produce.

62 -- | A list of MIME types the APIs can produce.

60− -- This is global to all APIs but can be overridden on specific API calls.

63+ -- This is global to all APIs but can be overridden on specific API calls.

61 , _produces :: MimeList

64 , _produces :: MimeList

63 -- | The available paths and operations for the API.

66 -- | The available paths and operations for the API.

64 , _paths :: Paths

67 , _paths :: Paths

66 -- | An object to hold data types produced and consumed by operations.

69 -- | An object to hold data types produced and consumed by operations.

67− , _definitions :: HashMap Text Schema

70+ , _definitions :: Definitions Schema

69 -- | An object to hold parameters that can be used across operations.

72 -- | An object to hold parameters that can be used across operations.

70 -- This property does not define global parameters for all operations.

73 -- This property does not define global parameters for all operations.

71− , _parameters :: HashMap Text Param

74+ , _parameters :: Definitions Param

73 -- | An object to hold responses that can be used across operations.

76 -- | An object to hold responses that can be used across operations.

74 -- This property does not define global responses for all operations.

77 -- This property does not define global responses for all operations.

75− , _responses :: HashMap Text Response

78+ , _responses :: Definitions Response

77 -- | Security scheme definitions that can be used across the specification.

80 -- | Security scheme definitions that can be used across the specification.

78− , _securityDefinitions :: HashMap Text SecurityScheme

81+ , _securityDefinitions :: Definitions SecurityScheme

80 -- | A declaration of which security schemes are applied for the API as a whole.

83 -- | A declaration of which security schemes are applied for the API as a whole.

81 -- The list of values describes alternative security schemes that can be used

84 -- The list of values describes alternative security schemes that can be used

@@ -485,6 +488,13 @@ data Schema = Schema

485 , _schemaParamSchema :: ParamSchema Schema

488 , _schemaParamSchema :: ParamSchema Schema

486 } deriving (Eq, Show, Generic, Data, Typeable)

489 } deriving (Eq, Show, Generic, Data, Typeable)

487

490

491+-- | A @'Schema'@ with an optional name.

492+-- This name can be used in references.

493+data NamedSchema = NamedSchema

494+ { _namedSchemaName :: Maybe Text

495+ , _namedSchemaSchema :: Schema

496+ } deriving (Eq, Show, Generic, Data, Typeable)

497+

488data ParamSchema t = ParamSchema

498data ParamSchema t = ParamSchema

489 { -- | Declares the value of the parameter that the server will use if none is provided,

499 { -- | Declares the value of the parameter that the server will use if none is provided,

490 -- for example a @"count"@ to control the number of results per page might default to @100@

500 -- for example a @"count"@ to control the number of results per page might default to @100@

@@ -1032,10 +1042,10 @@ instance FromJSON Swagger where

1032 , "produces" .= (mempty :: MimeList)

1042 , "produces" .= (mempty :: MimeList)

1033 , "security" .= ([] :: [SecurityRequirement])

1043 , "security" .= ([] :: [SecurityRequirement])

1034 , "tags" .= ([] :: [Tag])

1044 , "tags" .= ([] :: [Tag])

1035− , "definitions" .= (mempty :: HashMap Text Schema)

1045+ , "definitions" .= (mempty :: Definitions Schema)

1036− , "parameters" .= (mempty :: HashMap Text Param)

1046+ , "parameters" .= (mempty :: Definitions Param)

1037− , "responses" .= (mempty :: HashMap Text Response)

1047+ , "responses" .= (mempty :: Definitions Response)

1038− , "securityDefinitions" .= (mempty :: HashMap Text SecurityScheme)

1048+ , "securityDefinitions" .= (mempty :: Definitions SecurityScheme)

1039 ] ) js

1049 ] ) js

1040 parseJSON _ = empty

1050 parseJSON _ = empty

1041

1051

src/Data/Swagger/Internal/Schema.hs+42−45

@@ -45,27 +45,20 @@ import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))

45import Data.Swagger.Lens

46import Data.Swagger.SchemaOptions

48−-- | A @'Schema'@ with an optional name.

49−-- This name can be used in references.

50−type NamedSchema = (Maybe T.Text, Schema)

51−

52−-- | Schema definitions, a mapping from schema name to @'Schema'@.

53−type Definitions = HashMap T.Text Schema

54−

55unnamed :: Schema -> NamedSchema

48unnamed :: Schema -> NamedSchema

56−unnamed schema = (Nothing, schema)

49+unnamed schema = NamedSchema Nothing schema

58named :: T.Text -> Schema -> NamedSchema

51named :: T.Text -> Schema -> NamedSchema

59−named name schema = (Just name, schema)

52+named name schema = NamedSchema (Just name) schema

61−plain :: Schema -> Declare Definitions NamedSchema

54+plain :: Schema -> Declare (Definitions Schema) NamedSchema

62plain = pure . unnamed

55plain = pure . unnamed

64unname :: NamedSchema -> NamedSchema

57unname :: NamedSchema -> NamedSchema

65−unname (_, schema) = (Nothing, schema)

58+unname (NamedSchema _ schema) = unnamed schema

67rename :: Maybe T.Text -> NamedSchema -> NamedSchema

60rename :: Maybe T.Text -> NamedSchema -> NamedSchema

68−rename name (_, schema) = (name, schema)

61+rename name (NamedSchema _ schema) = NamedSchema name schema

70-- | Convert a type into @'Schema'@.

63-- | Convert a type into @'Schema'@.

71--

64--

@@ -114,21 +107,25 @@ class ToSchema a where

114 -- together with all used definitions.

107 -- together with all used definitions.

115 -- Note that the schema itself is included in definitions

108 -- Note that the schema itself is included in definitions

116 -- only if it is recursive (and thus needs its definition in scope).

109 -- only if it is recursive (and thus needs its definition in scope).

117− declareNamedSchema :: proxy a -> Declare Definitions NamedSchema

110+ declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema

118− default declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare Definitions NamedSchema

111+ default declareNamedSchema :: (Generic a, GToSchema (Rep a)) => proxy a -> Declare (Definitions Schema) NamedSchema

119 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions

112 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions

120

113

121-- | Convert a type into a schema and declare all used schema definitions.

114-- | Convert a type into a schema and declare all used schema definitions.

122−declareSchema :: ToSchema a => proxy a -> Declare Definitions Schema

115+declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema

123−declareSchema = fmap snd . declareNamedSchema

116+declareSchema = fmap _namedSchemaSchema . declareNamedSchema

124

117

125-- | Convert a type into an optionally named schema.

118-- | Convert a type into an optionally named schema.

126--

119--

127−-- >>> encode <$> toNamedSchema (Proxy :: Proxy String)

120+-- >>> toNamedSchema (Proxy :: Proxy String) ^. namedSchemaName

121+-- Nothing

122+-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. namedSchemaSchema)

128−-- (Nothing,"{\"type\":\"string\"}")

123+-- "{\"type\":\"string\"}"

129--

124--

125+-- >>> toNamedSchema (Proxy :: Proxy Day) ^. namedSchemaName

126+-- Just "Day"

130−-- >>> encode <$> toNamedSchema (Proxy :: Proxy Day)

127+-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. namedSchemaSchema)

131−-- (Just "Day","{\"format\":\"date\",\"type\":\"string\"}")

128+-- "{\"format\":\"date\",\"type\":\"string\"}"

132toNamedSchema :: ToSchema a => proxy a -> NamedSchema

129toNamedSchema :: ToSchema a => proxy a -> NamedSchema

133toNamedSchema = undeclare . declareNamedSchema

130toNamedSchema = undeclare . declareNamedSchema

134

131

@@ -140,7 +137,7 @@ toNamedSchema = undeclare . declareNamedSchema

140-- >>> schemaName (Proxy :: Proxy UTCTime)

137-- >>> schemaName (Proxy :: Proxy UTCTime)

141-- Just "UTCTime"

138-- Just "UTCTime"

142schemaName :: ToSchema a => proxy a -> Maybe T.Text

139schemaName :: ToSchema a => proxy a -> Maybe T.Text

143−schemaName = fst . toNamedSchema

140+schemaName = _namedSchemaName . toNamedSchema

144

141

145-- | Convert a type into a schema.

142-- | Convert a type into a schema.

146--

143--

@@ -150,7 +147,7 @@ schemaName = fst . toNamedSchema

150-- >>> encode $ toSchema (Proxy :: Proxy [Day])

147-- >>> encode $ toSchema (Proxy :: Proxy [Day])

151-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"

148-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"

152toSchema :: ToSchema a => proxy a -> Schema

149toSchema :: ToSchema a => proxy a -> Schema

153−toSchema = snd . toNamedSchema

150+toSchema = _namedSchemaSchema . toNamedSchema

154

151

155-- | Convert a type into a referenced schema if possible.

152-- | Convert a type into a referenced schema if possible.

156-- Only named schemas can be referenced, nameless schemas are inlined.

153-- Only named schemas can be referenced, nameless schemas are inlined.

@@ -170,10 +167,10 @@ toSchemaRef = undeclare . declareSchemaRef

170-- Schema definitions are typically declared for every referenced schema.

167-- Schema definitions are typically declared for every referenced schema.

171-- If @'declareSchemaRef'@ returns a reference, a corresponding schema

168-- If @'declareSchemaRef'@ returns a reference, a corresponding schema

172-- will be declared (regardless of whether it is recusive or not).

169-- will be declared (regardless of whether it is recusive or not).

173−declareSchemaRef :: ToSchema a => proxy a -> Declare Definitions (Referenced Schema)

170+declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema)

174declareSchemaRef proxy = do

171declareSchemaRef proxy = do

175 case toNamedSchema proxy of

172 case toNamedSchema proxy of

176− (Just name, schema) -> do

173+ NamedSchema (Just name) schema -> do

177 -- This check is very important as it allows generically

174 -- This check is very important as it allows generically

178 -- derive used definitions for recursive schemas.

175 -- derive used definitions for recursive schemas.

179 -- Lazy Declare monad allows toNamedSchema to ignore

176 -- Lazy Declare monad allows toNamedSchema to ignore

@@ -196,7 +193,7 @@ declareSchemaRef proxy = do

196--

193--

197-- __WARNING:__ @'inlineSchemasWhen'@ will produce infinite schemas

194-- __WARNING:__ @'inlineSchemasWhen'@ will produce infinite schemas

198-- when inlining recursive schemas.

195-- when inlining recursive schemas.

199−inlineSchemasWhen :: Data s => (T.Text -> Bool) -> Definitions -> s -> s

196+inlineSchemasWhen :: Data s => (T.Text -> Bool) -> (Definitions Schema) -> s -> s

200inlineSchemasWhen p defs = template %~ deref

197inlineSchemasWhen p defs = template %~ deref

201 where

198 where

202 deref r@(Ref (Reference name))

199 deref r@(Ref (Reference name))

@@ -214,7 +211,7 @@ inlineSchemasWhen p defs = template %~ deref

214--

211--

215-- __WARNING:__ @'inlineSchemas'@ will produce infinite schemas

212-- __WARNING:__ @'inlineSchemas'@ will produce infinite schemas

216-- when inlining recursive schemas.

213-- when inlining recursive schemas.

217−inlineSchemas :: Data s => [T.Text] -> Definitions -> s -> s

214+inlineSchemas :: Data s => [T.Text] -> (Definitions Schema) -> s -> s

218inlineSchemas names = inlineSchemasWhen (`elem` names)

215inlineSchemas names = inlineSchemasWhen (`elem` names)

219

216

220-- | Inline all schema references for which the definition

217-- | Inline all schema references for which the definition

@@ -222,7 +219,7 @@ inlineSchemas names = inlineSchemasWhen (`elem` names)

222--

219--

223-- __WARNING:__ @'inlineAllSchemas'@ will produce infinite schemas

220-- __WARNING:__ @'inlineAllSchemas'@ will produce infinite schemas

224-- when inlining recursive schemas.

221-- when inlining recursive schemas.

225−inlineAllSchemas :: Data s => Definitions -> s -> s

222+inlineAllSchemas :: Data s => (Definitions Schema) -> s -> s

226inlineAllSchemas = inlineSchemasWhen (const True)

223inlineAllSchemas = inlineSchemasWhen (const True)

227

224

228-- | Convert a type into a schema without references.

225-- | Convert a type into a schema without references.

@@ -239,7 +236,7 @@ toInlinedSchema proxy = inlineAllSchemas defs schema

239

236

240-- | Inline all /non-recursive/ schemas for which the definition

237-- | Inline all /non-recursive/ schemas for which the definition

241-- can be found in @'Definitions'@.

238-- can be found in @'Definitions'@.

242−inlineNonRecursiveSchemas :: Data s => Definitions -> s -> s

239+inlineNonRecursiveSchemas :: Data s => (Definitions Schema) -> s -> s

243inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

240inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

244 where

241 where

245 nonRecursive name =

242 nonRecursive name =

@@ -259,7 +256,7 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

259 Inline subschema -> usedNames subschema

256 Inline subschema -> usedNames subschema

260

257

261class GToSchema (f :: * -> *) where

258class GToSchema (f :: * -> *) where

262− gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema

259+ gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

263

260

264instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where

261instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where

265 declareNamedSchema _ = do

262 declareNamedSchema _ = do

@@ -293,7 +290,7 @@ instance ToSchema a => ToSchema (Maybe a) where

293instance (ToSchema a, ToSchema b) => ToSchema (Either a b)

290instance (ToSchema a, ToSchema b) => ToSchema (Either a b)

294

291

295instance ToSchema () where

292instance ToSchema () where

296− declareNamedSchema _ = pure (Nothing, nullarySchema)

293+ declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)

297

294

298instance (ToSchema a, ToSchema b) => ToSchema (a, b)

295instance (ToSchema a, ToSchema b) => ToSchema (a, b)

299instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)

296instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)

@@ -386,17 +383,17 @@ genericToNamedSchemaBoundedIntegral :: forall a d f proxy.

386 , Generic a, Rep a ~ D1 d f, Datatype d)

383 , Generic a, Rep a ~ D1 d f, Datatype d)

387 => SchemaOptions -> proxy a -> NamedSchema

384 => SchemaOptions -> proxy a -> NamedSchema

388genericToNamedSchemaBoundedIntegral opts proxy

385genericToNamedSchemaBoundedIntegral opts proxy

389− = (gdatatypeSchemaName opts (Proxy :: Proxy d), toSchemaBoundedIntegral proxy)

386+ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (toSchemaBoundedIntegral proxy)

390

387

391-- | A configurable generic @'Schema'@ creator.

388-- | A configurable generic @'Schema'@ creator.

392−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare Definitions Schema

389+genericDeclareSchema :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema

393−genericDeclareSchema opts proxy = snd <$> genericDeclareNamedSchema opts proxy

390+genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy

394

391

395-- | A configurable generic @'NamedSchema'@ creator.

392-- | A configurable generic @'NamedSchema'@ creator.

396-- This function applied to @'defaultSchemaOptions'@

393-- This function applied to @'defaultSchemaOptions'@

397-- is used as the default for @'declareNamedSchema'@

394-- is used as the default for @'declareNamedSchema'@

398-- when the type is an instance of @'Generic'@.

395-- when the type is an instance of @'Generic'@.

399−genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare Definitions NamedSchema

396+genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema

400genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

397genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

401

398

402gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text

399gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text

@@ -410,7 +407,7 @@ gdatatypeSchemaName opts _ = case name of

410paramSchemaToNamedSchema :: forall a d f proxy.

407paramSchemaToNamedSchema :: forall a d f proxy.

411 (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)

408 (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)

412 => SchemaOptions -> proxy a -> NamedSchema

409 => SchemaOptions -> proxy a -> NamedSchema

413−paramSchemaToNamedSchema opts proxy = (gdatatypeSchemaName opts (Proxy :: Proxy d), paramSchemaToSchema proxy)

410+paramSchemaToNamedSchema opts proxy = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d)) (paramSchemaToSchema proxy)

414

411

415-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.

412-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.

416paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema

413paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema

@@ -425,12 +422,12 @@ nullarySchema = mempty

425gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema

422gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema

426gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

423gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

427

424

428−gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare Definitions Schema

425+gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare (Definitions Schema) Schema

429−gdeclareSchema opts proxy = snd <$> gdeclareNamedSchema opts proxy mempty

426+gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty

430

427

431instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

428instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

432 gdeclareNamedSchema opts _ schema = do

429 gdeclareNamedSchema opts _ schema = do

433− (_, gschema) <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema

430+ NamedSchema _ gschema <- gdeclareNamedSchema opts (Proxy :: Proxy g) schema

434 gdeclareNamedSchema opts (Proxy :: Proxy f) gschema

431 gdeclareNamedSchema opts (Proxy :: Proxy f) gschema

435

432

436instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where

433instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where

@@ -455,14 +452,14 @@ instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where

455 declare defs

452 declare defs

456 return (unnamed schema)

453 return (unnamed schema)

457 where

454 where

458− (defs, (_, schema)) = runDeclare recordSchema mempty

455+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty

459 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s

456 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s

460 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s

457 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s

461

458

462−gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare Definitions (Referenced Schema)

459+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare (Definitions Schema) (Referenced Schema)

463gdeclareSchemaRef opts proxy = do

460gdeclareSchemaRef opts proxy = do

464 case gtoNamedSchema opts proxy of

461 case gtoNamedSchema opts proxy of

465− (Just name, schema) -> do

462+ NamedSchema (Just name) schema -> do

466 -- This check is very important as it allows generically

463 -- This check is very important as it allows generically

467 -- derive used definitions for recursive schemas.

464 -- derive used definitions for recursive schemas.

468 -- Lazy Declare monad allows toNamedSchema to ignore

465 -- Lazy Declare monad allows toNamedSchema to ignore

@@ -484,7 +481,7 @@ appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (x:xs))

484appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"

481appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"

485

482

486withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>

483withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>

487− SchemaOptions -> proxy s f -> Bool -> Schema -> Declare Definitions Schema

484+ SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema

488withFieldSchema opts _ isRequiredField schema = do

485withFieldSchema opts _ isRequiredField schema = do

489 ref <- gdeclareSchemaRef opts (Proxy :: Proxy f)

486 ref <- gdeclareSchemaRef opts (Proxy :: Proxy f)

490 return $

487 return $

@@ -518,7 +515,7 @@ instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where

518instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where

515instance (GSumToSchema f, GSumToSchema g) => GToSchema (f :+: g) where

519 gdeclareNamedSchema = gdeclareNamedSumSchema

516 gdeclareNamedSchema = gdeclareNamedSumSchema

520

517

521−gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare Definitions NamedSchema

518+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

522gdeclareNamedSumSchema opts proxy s

519gdeclareNamedSumSchema opts proxy s

523 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)

520 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)

524 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema

521 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema

@@ -533,13 +530,13 @@ gdeclareNamedSumSchema opts proxy s

533type AllNullary = All

530type AllNullary = All

534

531

535class GSumToSchema f where

532class GSumToSchema f where

536− gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare Definitions) Schema

533+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema

537

534

538instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where

535instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where

539 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <=< gsumToSchema opts (Proxy :: Proxy g)

536 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) <=< gsumToSchema opts (Proxy :: Proxy g)

540

537

541gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>

538gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>

542− SchemaOptions -> proxy (C1 c f) -> Schema -> Declare Definitions Schema

539+ SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema

543gsumConToSchema opts _ schema = do

540gsumConToSchema opts _ schema = do

544 ref <- gdeclareSchemaRef opts (Proxy :: Proxy (C1 c f))

541 ref <- gdeclareSchemaRef opts (Proxy :: Proxy (C1 c f))

545 return $ schema

542 return $ schema

src/Data/Swagger/Lens.hs+3

@@ -43,6 +43,8 @@ makeLenses ''ParamOtherSchema

43makeLenses ''Header

44-- ** 'Schema' lenses

45makeLenses ''Schema

46+-- ** 'NamedSchema' lenses

47+makeLenses ''NamedSchema

47-- ** 'SwaggerItems' prisms

49-- ** 'SwaggerItems' prisms

@@ -105,6 +107,7 @@ instance HasParamSchema Schema Schema where parameterSchema = schemaParamSchema

105instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema

107instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema

106instance HasParamSchema Header Header where parameterSchema = headerParamSchema

108instance HasParamSchema Header Header where parameterSchema = headerParamSchema

107instance HasParamSchema (ParamSchema t) t where parameterSchema = id

109instance HasParamSchema (ParamSchema t) t where parameterSchema = id

110+instance HasParamSchema NamedSchema Schema where parameterSchema = namedSchemaSchema.parameterSchema

108

111

109schemaType :: HasParamSchema s t => Lens' s (SwaggerType t)

112schemaType :: HasParamSchema s t => Lens' s (SwaggerType t)

110schemaType = parameterSchema.paramSchemaType

113schemaType = parameterSchema.paramSchemaType

src/Data/Swagger/Schema.hs−2

@@ -9,8 +9,6 @@

9module Data.Swagger.Schema (

10 -- * Encoding

11 ToSchema(..),

12− Definitions,

13− NamedSchema,

14 declareSchema,

12 declareSchema,

15 declareSchemaRef,

13 declareSchemaRef,

16 toSchema,

14 toSchema,

test/Data/Swagger/SchemaSpec.hs+1−1

@@ -345,7 +345,7 @@ newtype Inlined a = Inlined { getInlined :: a }

345instance ToSchema a => ToSchema (Inlined a) where

346 declareNamedSchema _ = unname <$> declareNamedSchema (Proxy :: Proxy a)

347 where

348− unname (_, schema) = (Nothing, schema)

348+ unname (NamedSchema _ schema) = NamedSchema Nothing schema

349

350newtype Players = Players [Inlined Player]

351 deriving (Generic, ToSchema)