git.iko.soy/typeable/swagger2
on master help sign in
Add Data and Typeable instances for Data.Swagger types
commit4f8ddea72f44ca2877bb77d5dff2d8eff3cb44bf authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateSun 13 Dec 2015, 00:40 (11 years ago) parent40953e0
2 files changed+184−35
src/Data/Swagger/Internal.hs+177−35 src/Data/Swagger/Internal/Utils.hs+7
src/Data/Swagger/Internal.hs+177−35
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
12{-# LANGUAGE DeriveGeneric #-}
23{-# LANGUAGE DeriveTraversable #-}
34{-# LANGUAGE FlexibleContexts #-}
@@ -16,6 +17,7 @@ import Control.Monad
1617import Data.Aeson
1718import Data.Aeson.TH (deriveJSON)
1819import qualified Data.Aeson.Types as JSON
20+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
1921import Data.HashMap.Strict (HashMap)
2022import qualified Data.HashMap.Strict as HashMap
2123import Data.Map (Map)
@@ -91,7 +93,7 @@ data Swagger = Swagger
9193
9294 -- | Additional external documentation.
9395 , _externalDocs :: Maybe ExternalDocs
94− } deriving (Eq, Show, Generic)
96+ } deriving (Eq, Show, Generic, Data, Typeable)
9597
9698-- | The object provides metadata about the API.
9799-- The metadata can be used by the clients if needed,
@@ -116,7 +118,7 @@ data Info = Info
116118 -- | Provides the version of the application API
117119 -- (not to be confused with the specification version).
118120 , _infoVersion :: Text
119− } deriving (Eq, Show, Generic)
121+ } deriving (Eq, Show, Generic, Data, Typeable)
120122
121123-- | Contact information for the exposed API.
122124data Contact = Contact
@@ -128,7 +130,7 @@ data Contact = Contact
128130
129131 -- | The email address of the contact person/organization.
130132 , _contactEmail :: Maybe Text
131− } deriving (Eq, Show)
133+ } deriving (Eq, Show, Generic, Data, Typeable)
132134
133135-- | License information for the exposed API.
134136data License = License
@@ -137,13 +139,26 @@ data License = License
137139
138140 -- | A URL to the license used for the API.
139141 , _licenseUrl :: Maybe URL
140− } deriving (Eq, Show)
142+ } deriving (Eq, Show, Generic, Data, Typeable)
141143
142144-- | The host (name or ip) serving the API. It MAY include a port.
143145data Host = Host
144146 { _hostName :: HostName -- ^ Host name.
145147 , _hostPort :: Maybe PortNumber -- ^ Optional port.
146− } deriving (Eq, Show)
148+ } deriving (Eq, Show, Generic, Typeable)
149+
150+hostConstr :: Constr
151+hostConstr = mkConstr hostDataType "Host" [] Prefix
152+
153+hostDataType :: DataType
154+hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
155+
156+instance Data Host where
157+ gunfold k z c = case constrIndex c of
158+ 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
159+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
160+ toConstr (Host _ _) = hostConstr
161+ dataTypeOf _ = hostDataType
147162
148163-- | The transfer protocol of the API.
149164data Scheme
@@ -151,14 +166,14 @@ data Scheme
151166 | Https
152167 | Ws
153168 | Wss
154− deriving (Eq, Show)
169+ deriving (Eq, Show, Generic, Data, Typeable)
155170
156171-- | The available paths and operations for the API.
157172data Paths = Paths
158173 { -- | Holds the relative paths to the individual endpoints.
159174 -- The path is appended to the @'basePath'@ in order to construct the full URL.
160175 _pathsMap :: HashMap FilePath PathItem
161− } deriving (Eq, Show, Generic)
176+ } deriving (Eq, Show, Generic, Data, Typeable)
162177
163178-- | Describes the operations available on a single path.
164179-- A @'PathItem'@ may be empty, due to ACL constraints.
@@ -191,7 +206,7 @@ data PathItem = PathItem
191206 -- The list MUST NOT include duplicated parameters.
192207 -- A unique parameter is defined by a combination of a name and location.
193208 , _pathItemParameters :: [Referenced Param]
194− } deriving (Eq, Show, Generic)
209+ } deriving (Eq, Show, Generic, Data, Typeable)
195210
196211-- | Describes a single API operation on a path.
197212data Operation = Operation
@@ -251,10 +266,23 @@ data Operation = Operation
251266 -- This definition overrides any declared top-level security.
252267 -- To remove a top-level security declaration, @Just []@ can be used.
253268 , _operationSecurity :: [SecurityRequirement]
254− } deriving (Eq, Show, Generic)
269+ } deriving (Eq, Show, Generic, Data, Typeable)
255270
256271newtype MimeList = MimeList { getMimeList :: [MediaType] }
257− deriving (Eq, Show, Monoid)
272+ deriving (Eq, Show, Monoid, Typeable)
273+
274+mimeListConstr :: Constr
275+mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
276+
277+mimeListDataType :: DataType
278+mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
279+
280+instance Data MimeList where
281+ gunfold k z c = case constrIndex c of
282+ 1 -> k (z (\xs -> MimeList (map fromString xs)))
283+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
284+ toConstr (MimeList _) = mimeListConstr
285+ dataTypeOf _ = mimeListDataType
258286
259287-- | Describes a single operation parameter.
260288-- A unique parameter is defined by a combination of a name and location.
@@ -275,12 +303,12 @@ data Param = Param
275303
276304 -- | Parameter schema.
277305 , _paramSchema :: ParamAnySchema
278− } deriving (Eq, Show, Generic)
306+ } deriving (Eq, Show, Generic, Data, Typeable)
279307
280308data ParamAnySchema
281309 = ParamBody (Referenced Schema)
282310 | ParamOther ParamOtherSchema
283− deriving (Eq, Show)
311+ deriving (Eq, Show, Generic, Data, Typeable)
284312
285313data ParamOtherSchema = ParamOtherSchema
286314 { -- | The location of the parameter.
@@ -297,7 +325,7 @@ data ParamOtherSchema = ParamOtherSchema
297325 , _paramOtherSchemaCollectionFormat :: Maybe (CollectionFormat Param)
298326
299327 , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema Items
300− } deriving (Eq, Show, Generic)
328+ } deriving (Eq, Show, Generic, Data, Typeable)
301329
302330data SwaggerType t where
303331 SwaggerString :: SwaggerType t
@@ -311,6 +339,75 @@ data SwaggerType t where
311339
312340deriving instance Eq (SwaggerType t)
313341deriving instance Show (SwaggerType t)
342+deriving instance Typeable (SwaggerType t)
343+
344+swaggerStringConstr :: DataType -> Constr
345+swaggerStringConstr dt = mkConstr dt "SwaggerString" [] Prefix
346+
347+swaggerNumberConstr :: DataType -> Constr
348+swaggerNumberConstr dt = mkConstr dt "SwaggerNumber" [] Prefix
349+
350+swaggerIntegerConstr :: DataType -> Constr
351+swaggerIntegerConstr dt = mkConstr dt "SwaggerInteger" [] Prefix
352+
353+swaggerBooleanConstr :: DataType -> Constr
354+swaggerBooleanConstr dt = mkConstr dt "SwaggerBoolean" [] Prefix
355+
356+swaggerArrayConstr :: DataType -> Constr
357+swaggerArrayConstr dt = mkConstr dt "SwaggerArray" [] Prefix
358+
359+swaggerFileConstr :: DataType -> Constr
360+swaggerFileConstr dt = mkConstr dt "SwaggerFile" [] Prefix
361+
362+swaggerNullConstr :: DataType -> Constr
363+swaggerNullConstr dt = mkConstr dt "SwaggerNull" [] Prefix
364+
365+swaggerObjectConstr :: DataType -> Constr
366+swaggerObjectConstr dt = mkConstr dt "SwaggerObject" [] Prefix
367+
368+swaggerTypeDataType :: [DataType -> Constr] -> DataType
369+swaggerTypeDataType extra = dt
370+ where
371+ dt = mkDataType "Data.Swagger.SwaggerType" $ map ($ dt) $
372+ [ swaggerStringConstr, swaggerNumberConstr, swaggerIntegerConstr, swaggerBooleanConstr , swaggerArrayConstr ]
373+ ++ extra
374+
375+swaggerTypeToConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
376+swaggerTypeToConstr t = case t of
377+ SwaggerString -> swaggerStringConstr dt
378+ SwaggerNumber -> swaggerNumberConstr dt
379+ SwaggerInteger -> swaggerIntegerConstr dt
380+ SwaggerBoolean -> swaggerBooleanConstr dt
381+ SwaggerArray -> swaggerArrayConstr dt
382+ SwaggerFile -> swaggerFileConstr dt
383+ SwaggerNull -> swaggerNullConstr dt
384+ SwaggerObject -> swaggerObjectConstr dt
385+ where
386+ dt = dataTypeOf t
387+
388+instance Data (SwaggerType Items) where
389+ gunfold = gunfoldEnum "SwaggerType Items" $ zip [1..]
390+ [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
391+ toConstr = swaggerTypeToConstr
392+ dataTypeOf _ = swaggerTypeDataType []
393+
394+instance Data (SwaggerType Header) where
395+ gunfold = gunfoldEnum "SwaggerType Header" $ zip [1..]
396+ [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
397+ toConstr = swaggerTypeToConstr
398+ dataTypeOf _ = swaggerTypeDataType []
399+
400+instance Data (SwaggerType ParamOtherSchema) where
401+ gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" $ zip [1..]
402+ [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray, SwaggerFile]
403+ toConstr = swaggerTypeToConstr
404+ dataTypeOf _ = swaggerTypeDataType [swaggerFileConstr]
405+
406+instance Data (SwaggerType Schema) where
407+ gunfold = gunfoldEnum "SwaggerType Schema" $ zip [1, 2, 3, 4, 5, 7, 8]
408+ [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
409+ toConstr = swaggerTypeToConstr
410+ dataTypeOf _ = swaggerTypeDataType [swaggerNullConstr, swaggerObjectConstr]
314411
315412data ParamLocation
316413 = -- | Parameters that are appended to the URL.
@@ -330,7 +427,7 @@ data ParamLocation
330427 -- Form parameters have a different format based on the content-type used
331428 -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
332429 | ParamFormData
333− deriving (Eq, Show)
430+ deriving (Eq, Show, Generic, Data, Typeable)
334431
335432type Format = Text
336433
@@ -351,6 +448,36 @@ data CollectionFormat t where
351448
352449deriving instance Eq (CollectionFormat t)
353450deriving instance Show (CollectionFormat t)
451+deriving instance Typeable (CollectionFormat t)
452+
453+collectionCsvConstr :: Constr
454+collectionCsvConstr = mkConstr collectionFormatDataType "CollectionCSV" [] Prefix
455+
456+collectionSsvConstr :: Constr
457+collectionSsvConstr = mkConstr collectionFormatDataType "CollectionSSV" [] Prefix
458+
459+collectionTsvConstr :: Constr
460+collectionTsvConstr = mkConstr collectionFormatDataType "CollectionTSV" [] Prefix
461+
462+collectionPipesConstr :: Constr
463+collectionPipesConstr = mkConstr collectionFormatDataType "CollectionPipes" [] Prefix
464+
465+collectionFormatDataType :: DataType
466+collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat"
467+ [ collectionCsvConstr, collectionSsvConstr, collectionTsvConstr, collectionPipesConstr ]
468+
469+instance {-# OVERLAPPABLE #-} Data t => Data (CollectionFormat t) where
470+ gunfold = gunfoldEnum "CollectionFormat" $ zip [1..]
471+ [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
472+
473+ toConstr CollectionCSV = collectionCsvConstr
474+ toConstr CollectionSSV = collectionSsvConstr
475+ toConstr CollectionTSV = collectionTsvConstr
476+ toConstr CollectionPipes = collectionPipesConstr
477+
478+ dataTypeOf _ = collectionFormatDataType
479+
480+deriving instance {-# OVERLAPPING #-} Data (CollectionFormat Param)
354481
355482type ParamName = Text
356483
@@ -373,12 +500,12 @@ data Schema = Schema
373500 , _schemaMinProperties :: Maybe Integer
374501
375502 , _schemaParamSchema :: ParamSchema Schema SchemaItems
376− } deriving (Eq, Show, Generic)
503+ } deriving (Eq, Show, Generic, Data, Typeable)
377504
378505data SchemaItems
379506 = SchemaItemsObject (Referenced Schema)
380507 | SchemaItemsArray [Referenced Schema]
381− deriving (Eq, Show)
508+ deriving (Eq, Show, Generic, Data, Typeable)
382509
383510data ParamSchema t items = ParamSchema
384511 { -- | Declares the value of the parameter that the server will use if none is provided,
@@ -403,7 +530,9 @@ data ParamSchema t items = ParamSchema
403530 , _paramSchemaUniqueItems :: Maybe Bool
404531 , _paramSchemaEnum :: Maybe [Value]
405532 , _paramSchemaMultipleOf :: Maybe Scientific
406− } deriving (Eq, Show, Generic)
533+ } deriving (Eq, Show, Generic, Typeable)
534+
535+deriving instance (Data t, Data (SwaggerType t), Data i) => Data (ParamSchema t i)
407536
408537data Xml = Xml
409538 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -431,7 +560,7 @@ data Xml = Xml
431560 -- Default value is @False@.
432561 -- The definition takes effect only when defined alongside type being array (outside the items).
433562 , _xmlWrapped :: Maybe Bool
434− } deriving (Eq, Show, Generic)
563+ } deriving (Eq, Show, Generic, Data, Typeable)
435564
436565data Items = Items
437566 { -- | Determines the format of the array if type array is used.
@@ -439,7 +568,7 @@ data Items = Items
439568 _itemsCollectionFormat :: Maybe (CollectionFormat Items)
440569
441570 , _itemsParamSchema :: ParamSchema Items Items
442− } deriving (Eq, Show, Generic)
571+ } deriving (Eq, Show, Generic, Data, Typeable)
443572
444573-- | A container for the expected responses of an operation.
445574-- The container maps a HTTP response code to the expected response.
@@ -454,7 +583,7 @@ data Responses = Responses
454583 -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
455584 -- Describes the expected response for those HTTP status codes.
456585 , _responsesResponses :: HashMap HttpStatusCode (Referenced Response)
457− } deriving (Eq, Show, Generic)
586+ } deriving (Eq, Show, Generic, Data, Typeable)
458587
459588type HttpStatusCode = Int
460589
@@ -476,7 +605,7 @@ data Response = Response
476605
477606 -- | An example of the response message.
478607 , _responseExamples :: Maybe Example
479− } deriving (Eq, Show, Generic)
608+ } deriving (Eq, Show, Generic, Data, Typeable)
480609
481610type HeaderName = Text
482611
@@ -489,16 +618,29 @@ data Header = Header
489618 , _headerCollectionFormat :: Maybe (CollectionFormat Items)
490619
491620 , _headerParamSchema :: ParamSchema Header Items
492− } deriving (Eq, Show, Generic)
621+ } deriving (Eq, Show, Generic, Data, Typeable)
493622
494623data Example = Example { getExample :: Map MediaType Value }
495− deriving (Eq, Show)
624+ deriving (Eq, Show, Generic, Typeable)
625+
626+exampleConstr :: Constr
627+exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
628+
629+exampleDataType :: DataType
630+exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
631+
632+instance Data Example where
633+ gunfold k z c = case constrIndex c of
634+ 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
635+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
636+ toConstr (Example _) = exampleConstr
637+ dataTypeOf _ = exampleDataType
496638
497639-- | The location of the API key.
498640data ApiKeyLocation
499641 = ApiKeyQuery
500642 | ApiKeyHeader
501− deriving (Eq, Show)
643+ deriving (Eq, Show, Generic, Data, Typeable)
502644
503645data ApiKeyParams = ApiKeyParams
504646 { -- | The name of the header or query parameter to be used.
@@ -506,7 +648,7 @@ data ApiKeyParams = ApiKeyParams
506648
507649 -- | The location of the API key.
508650 , _apiKeyIn :: ApiKeyLocation
509− } deriving (Eq, Show)
651+ } deriving (Eq, Show, Generic, Data, Typeable)
510652
511653-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
512654type AuthorizationURL = Text
@@ -519,7 +661,7 @@ data OAuth2Flow
519661 | OAuth2Password TokenURL
520662 | OAuth2Application TokenURL
521663 | OAuth2AccessCode AuthorizationURL TokenURL
522− deriving (Eq, Show)
664+ deriving (Eq, Show, Generic, Data, Typeable)
523665
524666data OAuth2Params = OAuth2Params
525667 { -- | The flow used by the OAuth2 security scheme.
@@ -527,13 +669,13 @@ data OAuth2Params = OAuth2Params
527669
528670 -- | The available scopes for the OAuth2 security scheme.
529671 , _oauth2Scopes :: HashMap Text Text
530− } deriving (Eq, Show, Generic)
672+ } deriving (Eq, Show, Generic, Data, Typeable)
531673
532674data SecuritySchemeType
533675 = SecuritySchemeBasic
534676 | SecuritySchemeApiKey ApiKeyParams
535677 | SecuritySchemeOAuth2 OAuth2Params
536− deriving (Eq, Show)
678+ deriving (Eq, Show, Generic, Data, Typeable)
537679
538680data SecurityScheme = SecurityScheme
539681 { -- | The type of the security scheme.
@@ -541,14 +683,14 @@ data SecurityScheme = SecurityScheme
541683
542684 -- | A short description for security scheme.
543685 , _securitySchemeDescription :: Maybe Text
544− } deriving (Eq, Show, Generic)
686+ } deriving (Eq, Show, Generic, Data, Typeable)
545687
546688-- | Lists the required security schemes to execute this operation.
547689-- The object can have multiple security schemes declared in it which are all required
548690-- (that is, there is a logical AND between the schemes).
549691newtype SecurityRequirement = SecurityRequirement
550692 { getSecurityRequirement :: HashMap Text [Text]
551− } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON)
693+ } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable)
552694
553695-- | Allows adding meta data to a single tag that is used by @Operation@.
554696-- It is not mandatory to have a @Tag@ per tag used there.
@@ -562,7 +704,7 @@ data Tag = Tag
562704
563705 -- | Additional external documentation for this tag.
564706 , _tagExternalDocs :: Maybe ExternalDocs
565− } deriving (Eq, Show)
707+ } deriving (Eq, Show, Generic, Data, Typeable)
566708
567709-- | Allows referencing an external resource for extended documentation.
568710data ExternalDocs = ExternalDocs
@@ -572,19 +714,19 @@ data ExternalDocs = ExternalDocs
572714
573715 -- | The URL for the target documentation.
574716 , _externalDocsUrl :: URL
575− } deriving (Eq, Show, Generic)
717+ } deriving (Eq, Show, Generic, Data, Typeable)
576718
577719-- | A simple object to allow referencing other definitions in the specification.
578720-- It can be used to reference parameters and responses that are defined at the top level for reuse.
579721newtype Reference = Reference { getReference :: Text }
580− deriving (Eq, Show)
722+ deriving (Eq, Show, Data, Typeable)
581723
582724data Referenced a
583725 = Ref Reference
584726 | Inline a
585− deriving (Eq, Show)
727+ deriving (Eq, Show, Data, Typeable)
586728
587−newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON)
729+newtype URL = URL { getUrl :: Text } deriving (Eq, Show, ToJSON, FromJSON, Data, Typeable)
588730
589731-- =======================================================================
590732-- Monoid instances
src/Data/Swagger/Internal/Utils.hs+7
@@ -1,6 +1,7 @@
11{-# LANGUAGE DefaultSignatures #-}
22{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE RankNTypes #-}
45{-# LANGUAGE TypeOperators #-}
56module Data.Swagger.Internal.Utils where
67
@@ -10,6 +11,7 @@ import Data.Aeson
1011import Data.Aeson.TH
1112import Data.Aeson.Types (Parser, Pair)
1213import Data.Char
14+import Data.Data
1315import Data.Hashable (Hashable)
1416import Data.HashMap.Strict (HashMap)
1517import qualified Data.HashMap.Strict as HashMap
@@ -19,6 +21,11 @@ import GHC.Generics
1921import Language.Haskell.TH
2022import Text.Read (readMaybe)
2123
24+gunfoldEnum :: String -> [(ConIndex, a)] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a
25+gunfoldEnum tname xs _k z c = case lookup (constrIndex c) xs of
26+ Just x -> z x
27+ Nothing -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type " ++ tname ++ "."
28+
2229hashMapMapKeys :: (Eq k', Hashable k') => (k -> k') -> HashMap k v -> HashMap k' v
2330hashMapMapKeys f = HashMap.fromList . map (first f) . HashMap.toList
2431