05e1edc · typeable/swagger2

git.iko.soy/typeable/swagger2

on master help sign in

Add ToJSON instances

05e1edcNickolay Kudasov11 years ago

src/Data/Swagger/Internal.hs+138−45

compare with master

unifiedsplit

@@ -2,13 +2,15 @@

2{-# LANGUAGE DeriveTraversable #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE RecordWildCards #-}

5{-# LANGUAGE TemplateHaskell #-}

6{-# LANGUAGE TemplateHaskell #-}

6module Data.Swagger.Internal where

7module Data.Swagger.Internal where

8−import Data.Aeson (ToJSON, FromJSON)

9+import Data.Aeson

9−import qualified Data.Aeson as JSON

10+import Data.Aeson.TH (deriveToJSON)

10import Data.Foldable (Foldable)

11import Data.Foldable (Foldable)

11import Data.HashMap.Strict (HashMap)

12import Data.HashMap.Strict (HashMap)

13+import qualified Data.HashMap.Strict as HashMap

12import Data.Text (Text)

14import Data.Text (Text)

13import Data.Traversable (Traversable)

15import Data.Traversable (Traversable)

14import Data.Hashable (Hashable)

16import Data.Hashable (Hashable)

@@ -39,28 +41,28 @@ data Swagger = Swagger

40 -- | A list of MIME types the APIs can consume.

42 -- | A list of MIME types the APIs can consume.

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

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

42− , swaggerConsumes :: [MediaType]

44+ , swaggerConsumes :: SwaggerMimeList

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

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

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

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

46− , swaggerProduces :: [MediaType]

48+ , swaggerProduces :: SwaggerMimeList

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

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

49 , swaggerPaths :: SwaggerPaths

51 , swaggerPaths :: SwaggerPaths

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

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

52− , swaggerDefinitions :: Definitions SwaggerSchema

54+ , swaggerDefinitions :: HashMap Text SwaggerSchema

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

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

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

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

56− , swaggerParameters :: Definitions SwaggerParameter

58+ , swaggerParameters :: HashMap Text SwaggerParameter

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

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

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

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

60− , swaggerResponses :: Definitions SwaggerResponse

62+ , swaggerResponses :: HashMap Text SwaggerResponse

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

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

63− , swaggerSecurityDefinitions :: Definitions SwaggerSecurityScheme

65+ , swaggerSecurityDefinitions :: HashMap Text SwaggerSecurityScheme

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

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

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

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

@@ -77,7 +79,7 @@ data Swagger = Swagger

78 -- | Additional external documentation.

80 -- | Additional external documentation.

79 , swaggerExternalDocs :: SwaggerExternalDocs

81 , swaggerExternalDocs :: SwaggerExternalDocs

80− } deriving (Show)

82+ } deriving (Show, Generic)

82-- | The object provides metadata about the API.

84-- | The object provides metadata about the API.

83-- The metadata can be used by the clients if needed,

85-- The metadata can be used by the clients if needed,

@@ -131,6 +133,12 @@ data SwaggerHost = SwaggerHost

131 , swaggerHostPort :: Maybe PortNumber -- ^ Optional port.

133 , swaggerHostPort :: Maybe PortNumber -- ^ Optional port.

132 } deriving (Show)

134 } deriving (Show)

133

135

136+instance ToJSON SwaggerHost where

137+ toJSON (SwaggerHost host mport) = toJSON $

138+ case mport of

139+ Nothing -> host

140+ Just port -> host ++ ":" ++ show port

141+

134-- | The transfer protocol of the API.

142-- | The transfer protocol of the API.

135data SwaggerScheme

143data SwaggerScheme

136 = Http

144 = Http

@@ -146,6 +154,9 @@ data SwaggerPaths = SwaggerPaths

146 swaggerPathsMap :: HashMap FilePath SwaggerPathItem

154 swaggerPathsMap :: HashMap FilePath SwaggerPathItem

147 } deriving (Show)

155 } deriving (Show)

148

156

157+instance ToJSON SwaggerPaths where

158+ toJSON (SwaggerPaths m) = toJSON m

159+

149-- | Describes the operations available on a single path.

160-- | Describes the operations available on a single path.

150-- A @'SwaggerPathItem'@ may be empty, due to ACL constraints.

161-- A @'SwaggerPathItem'@ may be empty, due to ACL constraints.

151-- The path itself is still exposed to the documentation viewer

162-- The path itself is still exposed to the documentation viewer

@@ -205,12 +216,12 @@ data SwaggerOperation = SwaggerOperation

205 -- | A list of MIME types the operation can consume.

216 -- | A list of MIME types the operation can consume.

206 -- This overrides the @'swaggerConsumes'@.

217 -- This overrides the @'swaggerConsumes'@.

207 -- @Just []@ MAY be used to clear the global definition.

218 -- @Just []@ MAY be used to clear the global definition.

208− , swaggerOperationConsumes :: Maybe [MediaType]

219+ , swaggerOperationConsumes :: Maybe SwaggerMimeList

209

220

210 -- | A list of MIME types the operation can produce.

221 -- | A list of MIME types the operation can produce.

211 -- This overrides the @'swaggerProduces'@.

222 -- This overrides the @'swaggerProduces'@.

212 -- @Just []@ MAY be used to clear the global definition.

223 -- @Just []@ MAY be used to clear the global definition.

213− , swaggerOperationProduces :: Maybe [MediaType]

224+ , swaggerOperationProduces :: Maybe SwaggerMimeList

214

225

215 -- | A list of parameters that are applicable for this operation.

226 -- | A list of parameters that are applicable for this operation.

216 -- If a parameter is already defined at the @'SwaggerPathItem'@,

227 -- If a parameter is already defined at the @'SwaggerPathItem'@,

@@ -239,6 +250,12 @@ data SwaggerOperation = SwaggerOperation

239 , swaggerOperationSecurity :: [SwaggerSecurityRequirement]

250 , swaggerOperationSecurity :: [SwaggerSecurityRequirement]

240 } deriving (Show)

251 } deriving (Show)

241

252

253+newtype SwaggerMimeList = SwaggerMimeList { getSwaggerMimeList :: [MediaType] }

254+ deriving (Show)

255+

256+instance ToJSON SwaggerMimeList where

257+ toJSON (SwaggerMimeList xs) = toJSON (map show xs)

258+

242-- | Describes a single operation parameter.

259-- | Describes a single operation parameter.

243-- A unique parameter is defined by a combination of a name and location.

260-- A unique parameter is defined by a combination of a name and location.

244data SwaggerParameter = SwaggerParameter

261data SwaggerParameter = SwaggerParameter

@@ -258,13 +275,20 @@ data SwaggerParameter = SwaggerParameter

258

275

259 -- | Parameter schema.

276 -- | Parameter schema.

260 , swaggerParameterSchema :: SwaggerParameterSchema

277 , swaggerParameterSchema :: SwaggerParameterSchema

261− } deriving (Show)

278+ } deriving (Show, Generic)

279+

280+instance ToJSON SwaggerParameter where

281+ toJSON = genericToJSONWithSub "schema" (jsonPrefix "swaggerParameter")

262

282

263data SwaggerParameterSchema

283data SwaggerParameterSchema

264 = SwaggerParameterBody SwaggerSchema

284 = SwaggerParameterBody SwaggerSchema

265 | SwaggerParameterOther SwaggerParameterOtherSchema

285 | SwaggerParameterOther SwaggerParameterOtherSchema

266 deriving (Show)

286 deriving (Show)

267

287

288+instance ToJSON SwaggerParameterSchema where

289+ toJSON (SwaggerParameterBody s) = toJSON s <+> object [ "in" .= ("body" :: Text) ]

290+ toJSON (SwaggerParameterOther s) = toJSON s

291+

268data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema

292data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema

269 { -- | The location of the parameter.

293 { -- | The location of the parameter.

270 swaggerParameterOtherSchemaIn :: SwaggerParameterLocation

294 swaggerParameterOtherSchemaIn :: SwaggerParameterLocation

@@ -294,26 +318,11 @@ data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema

294 -- Default value is csv.

318 -- Default value is csv.

295 , swaggerParameterOtherSchemaCollectionFormat :: Maybe SwaggerCollectionFormat

319 , swaggerParameterOtherSchemaCollectionFormat :: Maybe SwaggerCollectionFormat

296

320

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

321+ , swaggerParameterOtherSchemaCommon :: SwaggerSchemaCommon

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

299− -- if not supplied by the client in the request.

300− -- (Note: "default" has no meaning for required parameters.)

301− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

302− , swaggerParameterOtherSchemaDefault :: Maybe JSON.Value

303−

304− , swaggerParameterOtherSchemaMaximum :: Maybe Integer

305− , swaggerParameterOtherSchemaExclusiveMaximum :: Maybe Bool

306− , swaggerParameterOtherSchemaMinimum :: Maybe Integer

307− , swaggerParameterOtherSchemaExclusiveMinimum :: Maybe Bool

308− , swaggerParameterOtherSchemaMaxLength :: Maybe Integer

309− , swaggerParameterOtherSchemaMinLength :: Maybe Integer

310− , swaggerParameterOtherSchemaPattern :: Maybe Text

311− , swaggerParameterOtherSchemaMaxItems :: Maybe Integer

312− , swaggerParameterOtherSchemaMinItems :: Maybe Integer

313− , swaggerParameterOtherSchemaUniqueItems :: Maybe Bool

314− , swaggerParameterOtherSchemaEnum :: Maybe [JSON.Value]

315− , swaggerParameterOtherSchemaMultipleOf :: Maybe Integer

316− } deriving (Show)

322+ } deriving (Show, Generic)

323+

324+instance ToJSON SwaggerParameterOtherSchema where

325+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerParameterOtherSchema")

317

326

318data SwaggerParameterType

327data SwaggerParameterType

319 = SwaggerParamString

328 = SwaggerParamString

@@ -393,33 +402,37 @@ data SwaggerSchema = SwaggerSchema

393

402

394 , swaggerSchemaItems :: SwaggerSchemaItems

403 , swaggerSchemaItems :: SwaggerSchemaItems

395 , swaggerSchemaAllOf :: [SwaggerSchema]

404 , swaggerSchemaAllOf :: [SwaggerSchema]

396− , swaggerSchemaProperties :: Definitions SwaggerSchema

405+ , swaggerSchemaProperties :: HashMap Text SwaggerSchema

397 , swaggerSchemaAdditionalProperties :: Maybe SwaggerSchema

406 , swaggerSchemaAdditionalProperties :: Maybe SwaggerSchema

398

407

399 , swaggerSchemaDiscriminator :: Maybe Text

408 , swaggerSchemaDiscriminator :: Maybe Text

400 , swaggerSchemaReadOnly :: Maybe Bool

409 , swaggerSchemaReadOnly :: Maybe Bool

401 , swaggerSchemaXml :: Maybe SwaggerXml

410 , swaggerSchemaXml :: Maybe SwaggerXml

402 , swaggerSchemaExternalDocs :: Maybe SwaggerExternalDocs

411 , swaggerSchemaExternalDocs :: Maybe SwaggerExternalDocs

403− , swaggerSchemaExample :: Maybe JSON.Value

412+ , swaggerSchemaExample :: Maybe Value

404

413

405 , swaggerSchemaMaxProperties :: Maybe Integer

414 , swaggerSchemaMaxProperties :: Maybe Integer

406 , swaggerSchemaMinProperties :: Maybe Integer

415 , swaggerSchemaMinProperties :: Maybe Integer

407

416

408 , swaggerSchemaCommon :: SwaggerSchemaCommon

417 , swaggerSchemaCommon :: SwaggerSchemaCommon

409− } deriving (Show)

418+ } deriving (Show, Generic)

410

419

411data SwaggerSchemaItems

420data SwaggerSchemaItems

412 = SwaggerSchemaItemsObject SwaggerSchema

421 = SwaggerSchemaItemsObject SwaggerSchema

413 | SwaggerSchemaItemsArray [SwaggerSchema]

422 | SwaggerSchemaItemsArray [SwaggerSchema]

414 deriving (Show)

423 deriving (Show)

415

424

425+instance ToJSON SwaggerSchemaItems where

426+ toJSON (SwaggerSchemaItemsObject x) = toJSON x

427+ toJSON (SwaggerSchemaItemsArray xs) = toJSON xs

428+

416data SwaggerSchemaCommon = SwaggerSchemaCommon

429data SwaggerSchemaCommon = SwaggerSchemaCommon

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

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

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

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

419 -- if not supplied by the client in the request.

432 -- if not supplied by the client in the request.

420 -- (Note: "default" has no meaning for required parameters.)

433 -- (Note: "default" has no meaning for required parameters.)

421 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

434 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

422− swaggerSchemaDefault :: Maybe JSON.Value

435+ swaggerSchemaDefault :: Maybe Value

423

436

424 , swaggerSchemaMaximum :: Maybe Integer

437 , swaggerSchemaMaximum :: Maybe Integer

425 , swaggerSchemaExclusiveMaximum :: Maybe Bool

438 , swaggerSchemaExclusiveMaximum :: Maybe Bool

@@ -431,9 +444,9 @@ data SwaggerSchemaCommon = SwaggerSchemaCommon

431 , swaggerSchemaMaxItems :: Maybe Integer

444 , swaggerSchemaMaxItems :: Maybe Integer

432 , swaggerSchemaMinItems :: Maybe Integer

445 , swaggerSchemaMinItems :: Maybe Integer

433 , swaggerSchemaUniqueItems :: Maybe Bool

446 , swaggerSchemaUniqueItems :: Maybe Bool

434− , swaggerSchemaEnum :: Maybe [JSON.Value]

447+ , swaggerSchemaEnum :: Maybe [Value]

435 , swaggerSchemaMultipleOf :: Maybe Integer

448 , swaggerSchemaMultipleOf :: Maybe Integer

436− } deriving (Show)

449+ } deriving (Show, Generic)

437

450

438data SwaggerXml = SwaggerXml

451data SwaggerXml = SwaggerXml

439 { -- | Replaces the name of the element/attribute used for the described schema property.

452 { -- | Replaces the name of the element/attribute used for the described schema property.

@@ -479,7 +492,7 @@ data SwaggerItems = SwaggerItems

479 , swaggerItemsCollectionFormat :: SwaggerItemsCollectionFormat

492 , swaggerItemsCollectionFormat :: SwaggerItemsCollectionFormat

480

493

481 , swaggerItemsCommon :: SwaggerSchemaCommon

494 , swaggerItemsCommon :: SwaggerSchemaCommon

482− } deriving (Show)

495+ } deriving (Show, Generic)

483

496

484-- | A container for the expected responses of an operation.

497-- | A container for the expected responses of an operation.

485-- The container maps a HTTP response code to the expected response.

498-- The container maps a HTTP response code to the expected response.

@@ -496,6 +509,11 @@ data SwaggerResponses = SwaggerResponses

496 , swaggerResponsesResponses :: HashMap HttpStatusCode SwaggerResponse

509 , swaggerResponsesResponses :: HashMap HttpStatusCode SwaggerResponse

497 } deriving (Show)

510 } deriving (Show)

498

511

512+instance ToJSON SwaggerResponses where

513+ toJSON (SwaggerResponses def rs) = object

514+ [ "default" .= def

515+ , "responses" .= hashMapMapKeys show rs ]

516+

499type HttpStatusCode = Int

517type HttpStatusCode = Int

500

518

501-- | Describes a single response from an API Operation.

519-- | Describes a single response from an API Operation.

@@ -539,11 +557,14 @@ data SwaggerHeader = SwaggerHeader

539 , swaggerHeaderCollectionFormat :: SwaggerItemsCollectionFormat

557 , swaggerHeaderCollectionFormat :: SwaggerItemsCollectionFormat

540

558

541 , swaggerHeaderCommon :: SwaggerSchemaCommon

559 , swaggerHeaderCommon :: SwaggerSchemaCommon

542− } deriving (Show)

560+ } deriving (Show, Generic)

543

561

544−data SwaggerExample = SwaggerExample

562+data SwaggerExample = SwaggerExample { getSwaggerExample :: HashMap MediaType Value }

545 deriving (Show)

563 deriving (Show)

546

564

565+instance ToJSON SwaggerExample where

566+ toJSON = toJSON . hashMapMapKeys show . getSwaggerExample

567+

547-- | The location of the API key.

568-- | The location of the API key.

548data SwaggerApiKeyLocation

569data SwaggerApiKeyLocation

549 = SwaggerApiKeyQuery

570 = SwaggerApiKeyQuery

@@ -577,7 +598,7 @@ data SwaggerOAuth2Params = SwaggerOAuth2Params

577

598

578 -- | The available scopes for the OAuth2 security scheme.

599 -- | The available scopes for the OAuth2 security scheme.

579 , swaggerOAuth2Scopes :: HashMap Text Text

600 , swaggerOAuth2Scopes :: HashMap Text Text

580− } deriving (Show)

601+ } deriving (Show, Generic)

581

602

582data SwaggerSecuritySchemeType

603data SwaggerSecuritySchemeType

583 = SwaggerSecuritySchemeBasic

604 = SwaggerSecuritySchemeBasic

@@ -591,6 +612,11 @@ data SwaggerSecuritySchemeTypeName

591 | SwaggerSecuritySchemeTypeOAuth2

612 | SwaggerSecuritySchemeTypeOAuth2

592 deriving (Eq, Read, Show, Generic)

613 deriving (Eq, Read, Show, Generic)

593

614

615+swaggerSecuritySchemeTypeNameText :: SwaggerSecuritySchemeTypeName -> Text

616+swaggerSecuritySchemeTypeNameText SwaggerSecuritySchemeTypeBasic = "basic"

617+swaggerSecuritySchemeTypeNameText SwaggerSecuritySchemeTypeApiKey = "apiKey"

618+swaggerSecuritySchemeTypeNameText SwaggerSecuritySchemeTypeOAuth2 = "oauth2"

619+

594instance Hashable SwaggerSecuritySchemeTypeName

620instance Hashable SwaggerSecuritySchemeTypeName

595

621

596data SwaggerSecurityScheme = SwaggerSecurityScheme

622data SwaggerSecurityScheme = SwaggerSecurityScheme

@@ -599,7 +625,7 @@ data SwaggerSecurityScheme = SwaggerSecurityScheme

599

625

600 -- | A short description for security scheme.

626 -- | A short description for security scheme.

601 , swaggerSecuritySchemeDescription :: Maybe Text

627 , swaggerSecuritySchemeDescription :: Maybe Text

602− } deriving (Show)

628+ } deriving (Show, Generic)

603

629

604-- | Lists the required security schemes to execute this operation.

630-- | Lists the required security schemes to execute this operation.

605-- The object can have multiple security schemes declared in it which are all required

631-- The object can have multiple security schemes declared in it which are all required

@@ -608,6 +634,9 @@ newtype SwaggerSecurityRequirement = SwaggerSecurityRequirement

608 { getSwaggerSecurityRequirement :: HashMap SwaggerSecuritySchemeTypeName Text

634 { getSwaggerSecurityRequirement :: HashMap SwaggerSecuritySchemeTypeName Text

609 } deriving (Eq, Read, Show, Monoid)

635 } deriving (Eq, Read, Show, Monoid)

610

636

637+instance ToJSON SwaggerSecurityRequirement where

638+ toJSON (SwaggerSecurityRequirement m) = toJSON (hashMapMapKeys swaggerSecuritySchemeTypeNameText m)

639+

611-- | Allows adding meta data to a single tag that is used by @SwaggerOperation@.

640-- | Allows adding meta data to a single tag that is used by @SwaggerOperation@.

612-- It is not mandatory to have a @SwaggerTag@ per tag used there.

641-- It is not mandatory to have a @SwaggerTag@ per tag used there.

613data SwaggerTag = SwaggerTag

642data SwaggerTag = SwaggerTag

@@ -634,6 +663,70 @@ data SwaggerExternalDocs = SwaggerExternalDocs

634

663

635newtype URL = URL { getUrl :: Text } deriving (Show, ToJSON, FromJSON)

664newtype URL = URL { getUrl :: Text } deriving (Show, ToJSON, FromJSON)

636

665

637−newtype Definitions v = Definitions { getDefinitions :: HashMap Text v }

666+deriveToJSON' ''SwaggerOperation

638− deriving (Eq, Read, Show, Monoid, Functor, Foldable, Traversable)

667+deriveToJSON (jsonPrefix "SwaggerParameter") ''SwaggerParameterLocation

668+deriveToJSON (jsonPrefix "SwaggerParam") ''SwaggerParameterType

669+deriveToJSON' ''SwaggerPathItem

670+deriveToJSON' ''SwaggerInfo

671+deriveToJSON' ''SwaggerContact

672+deriveToJSON' ''SwaggerLicense

673+deriveToJSON (jsonPrefix "SwaggerSchema") ''SwaggerSchemaType

674+deriveToJSON (jsonPrefix "SwaggerItems") ''SwaggerItemsType

675+deriveToJSON (jsonPrefix "SwaggerItemsCollection") ''SwaggerItemsCollectionFormat

676+deriveToJSON (jsonPrefix "SwaggerCollection") ''SwaggerCollectionFormat

677+deriveToJSON (jsonPrefix "SwaggerSecuritySchemeType") ''SwaggerSecuritySchemeTypeName

678+deriveToJSON (jsonPrefix "SwaggerApiKey") ''SwaggerApiKeyLocation

679+deriveToJSON (jsonPrefix "swaggerApiKey") ''SwaggerApiKeyParams

680+deriveToJSON' ''SwaggerResponse

681+deriveToJSON' ''SwaggerSchemaCommon

682+deriveToJSONDefault ''SwaggerScheme

683+deriveToJSON' ''SwaggerTag

684+deriveToJSON' ''SwaggerExternalDocs

685+deriveToJSON' ''SwaggerXml

686+

687+instance ToJSON SwaggerOAuth2Flow where

688+ toJSON (SwaggerOAuth2Implicit authUrl) = object

689+ [ "flow" .= ("implicit" :: Text)

690+ , "authorizationUrl" .= authUrl ]

691+ toJSON (SwaggerOAuth2Password tokenUrl) = object

692+ [ "flow" .= ("password" :: Text)

693+ , "tokenUrl" .= tokenUrl ]

694+ toJSON (SwaggerOAuth2Application tokenUrl) = object

695+ [ "flow" .= ("application" :: Text)

696+ , "tokenUrl" .= tokenUrl ]

697+ toJSON (SwaggerOAuth2AccessCode authUrl tokenUrl) = object

698+ [ "flow" .= ("accessCode" :: Text)

699+ , "authorizationUrl" .= authUrl

700+ , "tokenUrl" .= tokenUrl ]

701+

702+instance ToJSON SwaggerOAuth2Params where

703+ toJSON = genericToJSONWithSub "flow" (jsonPrefix "swaggerOAuth2")

704+

705+instance ToJSON SwaggerSecuritySchemeType where

706+ toJSON SwaggerSecuritySchemeBasic

707+ = object [ "type" .= SwaggerSecuritySchemeTypeBasic ]

708+ toJSON (SwaggerSecuritySchemeApiKey params)

709+ = toJSON params

710+ <+> object [ "type" .= SwaggerSecuritySchemeTypeApiKey ]

711+ toJSON (SwaggerSecuritySchemeOAuth2 params)

712+ = toJSON params

713+ <+> object [ "type" .= SwaggerSecuritySchemeTypeOAuth2 ]

714+

715+instance ToJSON Swagger where

716+ toJSON = addVersion . genericToJSON (jsonPrefix "swagger")

717+ where

718+ addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)

719+ addVersion _ = error "impossible"

720+

721+instance ToJSON SwaggerSecurityScheme where

722+ toJSON = genericToJSONWithSub "type" (jsonPrefix "swaggerSecurityScheme")

723+

724+instance ToJSON SwaggerSchema where

725+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerSchema")

726+

727+instance ToJSON SwaggerHeader where

728+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerHeader")

729+

730+instance ToJSON SwaggerItems where

731+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerItems")

639

732

src/Data/Swagger/Internal/Utils.hs+40

@@ -1,9 +1,22 @@

1+{-# LANGUAGE FlexibleContexts #-}

1module Data.Swagger.Internal.Utils where

2module Data.Swagger.Internal.Utils where

4+import Control.Arrow (first)

5+import Data.Aeson

3import Data.Aeson.TH

6import Data.Aeson.TH

7+import Data.Aeson.Types (Parser)

4import Data.Char

8import Data.Char

9+import Data.Hashable (Hashable)

10+import Data.HashMap.Strict (HashMap)

11+import qualified Data.HashMap.Strict as HashMap

12+import Data.Monoid

13+import Data.Text (Text)

14+import GHC.Generics

5import Language.Haskell.TH

15import Language.Haskell.TH

17+hashMapMapKeys :: (Eq k', Hashable k') => (k -> k') -> HashMap k v -> HashMap k' v

18+hashMapMapKeys f = HashMap.fromList . map (first f) . HashMap.toList

19+

7jsonPrefix :: String -> Options

20jsonPrefix :: String -> Options

8jsonPrefix prefix = defaultOptions

21jsonPrefix prefix = defaultOptions

9 { fieldLabelModifier = modifier

22 { fieldLabelModifier = modifier

@@ -16,5 +29,32 @@ jsonPrefix prefix = defaultOptions

16 lowerFirstLetter (c:s) = toLower c : s

29 lowerFirstLetter (c:s) = toLower c : s

17 lowerFirstLetter s = s

30 lowerFirstLetter s = s

32+deriveToJSONDefault :: Name -> Q [Dec]

33+deriveToJSONDefault = deriveToJSON defaultOptions

34+

35+deriveToJSON' :: Name -> Q [Dec]

36+deriveToJSON' name = deriveToJSON (jsonPrefix (nameBase name)) name

37+

38+deriveJSONDefault :: Name -> Q [Dec]

39+deriveJSONDefault = deriveJSON defaultOptions

40+

19deriveJSON' :: Name -> Q [Dec]

41deriveJSON' :: Name -> Q [Dec]

20deriveJSON' name = deriveJSON (jsonPrefix (nameBase name)) name

42deriveJSON' name = deriveJSON (jsonPrefix (nameBase name)) name

43+

44+genericToJSONWithSub :: (Generic a, GToJSON (Rep a)) => Text -> Options -> a -> Value

45+genericToJSONWithSub sub opts x =

46+ case genericToJSON opts x of

47+ Object o ->

48+ let so = HashMap.lookupDefault (error "impossible") sub o

49+ in Object (HashMap.delete sub o) <+> so

50+ _ -> error "impossible"

51+

52+genericParseJSONWithSub :: (Generic a, GFromJSON (Rep a)) => Text -> Options -> Value -> Parser a

53+genericParseJSONWithSub sub opts (Object o) = genericParseJSON opts json

54+ where

55+ json = Object (HashMap.insert sub (Object o) o)

56+genericParseJSONWithSub _ _ _ = error "impossible"

57+

58+(<+>) :: Value -> Value -> Value

59+Object x <+> Object y = Object (x <> y)

60+_ <+> _ = error "impossible"