a6d7769 · typeable/swagger2

git.iko.soy/typeable/swagger2

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

Data type for NamedSchema

commita6d7769a8f871b17afaf8973af5ad3caa0b651bd authorNickolay Kudasov <fizruk@users.noreply.github.com> dateThu 21 Jan 2016, 18:02 (11 years ago) parenta134310 d676cd9

6 files changed+67−57

compare with master

unifiedsplit

src/Data/Swagger.hs+2 src/Data/Swagger/Internal.hs+19−9 src/Data/Swagger/Internal/Schema.hs+42−45 src/Data/Swagger/Lens.hs+3 src/Data/Swagger/Schema.hs−2 test/Data/Swagger/SchemaSpec.hs+1−1

src/Data/Swagger.hs+2

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

4545 -- ** Types and formats

4646 SwaggerType(..),

4747 Format,

48+ Definitions,

4849 CollectionFormat(..),

4950

5051 -- ** Parameters

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

6061 -- ** Schemas

6162 ParamSchema(..),

6263 Schema(..),

64+ NamedSchema(..),

6365 SwaggerItems(..),

6466 Xml(..),

6567

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

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

3333

3434import Data.Swagger.Internal.Utils

3535

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

37+type Definitions = HashMap Text

38+

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

3740data Swagger = Swagger

3841 { -- | Provides metadata about the API.

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

5760 , _consumes :: MimeList

5861

5962 -- | 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.

6164 , _produces :: MimeList

6265

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

6467 , _paths :: Paths

6568

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

67− , _definitions :: HashMap Text Schema

70+ , _definitions :: Definitions Schema

6871

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

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

71− , _parameters :: HashMap Text Param

74+ , _parameters :: Definitions Param

7275

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

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

75− , _responses :: HashMap Text Response

78+ , _responses :: Definitions Response

7679

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

78− , _securityDefinitions :: HashMap Text SecurityScheme

81+ , _securityDefinitions :: Definitions SecurityScheme

7982

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

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

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

485488 , _schemaParamSchema :: ParamSchema Schema

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

487490

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+

488498data ParamSchema t = ParamSchema

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

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

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

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

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

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

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

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

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

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

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

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

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

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

10391049 ] ) js

10401050 parseJSON _ = empty

10411051

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

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

4545import Data.Swagger.Lens

4646import Data.Swagger.SchemaOptions

4747

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−

5548unnamed :: Schema -> NamedSchema

56−unnamed schema = (Nothing, schema)

49+unnamed schema = NamedSchema Nothing schema

5750

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

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

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

6053

61−plain :: Schema -> Declare Definitions NamedSchema

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

6255plain = pure . unnamed

6356

6457unname :: NamedSchema -> NamedSchema

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

58+unname (NamedSchema _ schema) = unnamed schema

6659

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

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

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

6962

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

7164--

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

114107 -- together with all used definitions.

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

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

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

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

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

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

119112 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions

120113

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

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

123−declareSchema = fmap snd . declareNamedSchema

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

116+declareSchema = fmap _namedSchemaSchema . declareNamedSchema

124117

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

126119--

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

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

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

121+-- Nothing

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

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

129124--

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

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

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

126+-- Just "Day"

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

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

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

133130toNamedSchema = undeclare . declareNamedSchema

134131

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

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

141138-- Just "UTCTime"

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

143−schemaName = fst . toNamedSchema

140+schemaName = _namedSchemaName . toNamedSchema

144141

145142-- | Convert a type into a schema.

146143--

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

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

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

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

153−toSchema = snd . toNamedSchema

150+toSchema = _namedSchemaSchema . toNamedSchema

154151

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

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

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

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

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

172169-- 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)

174171declareSchemaRef proxy = do

175172 case toNamedSchema proxy of

176− (Just name, schema) -> do

173+ NamedSchema (Just name) schema -> do

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

178175 -- derive used definitions for recursive schemas.

179176 -- Lazy Declare monad allows toNamedSchema to ignore

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

196193--

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

198195-- 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

200197inlineSchemasWhen p defs = template %~ deref

201198 where

202199 deref r@(Ref (Reference name))

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

214211--

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

216213-- when inlining recursive schemas.

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

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

218215inlineSchemas names = inlineSchemasWhen (`elem` names)

219216

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

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

222219--

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

224221-- when inlining recursive schemas.

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

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

226223inlineAllSchemas = inlineSchemasWhen (const True)

227224

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

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

239236

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

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

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

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

243240inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

244241 where

245242 nonRecursive name =

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

259256 Inline subschema -> usedNames subschema

260257

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

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

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

263260

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

265262 declareNamedSchema _ = do

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

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

294291

295292instance ToSchema () where

296− declareNamedSchema _ = pure (Nothing, nullarySchema)

293+ declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)

297294

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

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

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

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

387384 => SchemaOptions -> proxy a -> NamedSchema

388385genericToNamedSchemaBoundedIntegral opts proxy

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

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

390387

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

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

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

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

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

394391

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

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

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

398395-- 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

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

401398

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

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

410407paramSchemaToNamedSchema :: forall a d f proxy.

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

412409 => 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)

414411

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

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

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

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

426423gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

427424

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

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

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

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

430427

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

432429 gdeclareNamedSchema opts _ schema = do

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

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

434431 gdeclareNamedSchema opts (Proxy :: Proxy f) gschema

435432

436433instance (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

455452 declare defs

456453 return (unnamed schema)

457454 where

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

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

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

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

461458

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

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

463460gdeclareSchemaRef opts proxy = do

464461 case gtoNamedSchema opts proxy of

465− (Just name, schema) -> do

462+ NamedSchema (Just name) schema -> do

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

467464 -- derive used definitions for recursive schemas.

468465 -- Lazy Declare monad allows toNamedSchema to ignore

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

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

485482

486483withFieldSchema :: 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

488485withFieldSchema opts _ isRequiredField schema = do

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

490487 return $

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

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

519516 gdeclareNamedSchema = gdeclareNamedSumSchema

520517

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

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

522519gdeclareNamedSumSchema opts proxy s

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

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

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

533530type AllNullary = All

534531

535532class 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

537534

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

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

540537

541538gsumConToSchema :: 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

543540gsumConToSchema opts _ schema = do

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

545542 return $ schema

src/Data/Swagger/Lens.hs+3

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

4343makeLenses ''Header

4444-- ** 'Schema' lenses

4545makeLenses ''Schema

46+-- ** 'NamedSchema' lenses

47+makeLenses ''NamedSchema

4648

4749-- ** 'SwaggerItems' prisms

4850

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

105107instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema

106108instance HasParamSchema Header Header where parameterSchema = headerParamSchema

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

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

108111

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

110113schemaType = parameterSchema.paramSchemaType

src/Data/Swagger/Schema.hs−2

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

99module Data.Swagger.Schema (

1010 -- * Encoding

1111 ToSchema(..),

12− Definitions,

13− NamedSchema,

1412 declareSchema,

1513 declareSchemaRef,

1614 toSchema,

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

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

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

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

347347 where

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

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

349349

350350newtype Players = Players [Inlined Player]

351351 deriving (Generic, ToSchema)