git.iko.soy/typeable/openapi3
on master help sign in
Merge pull request #41 from GetShopTV/make-fields-#39

Switch to classy field lenses

commit6c0a0ca503e291c94fa664be0e5cfa45e3ec3724 authorNickolay Kudasov <fizruk@users.noreply.github.com> dateFri 22 Jan 2016, 03:54 (11 years ago) parenta6d77693f5e9e3
8 files changed+378−362
compare with master
unifiedsplit
src/Data/Swagger.hs+49−22 src/Data/Swagger/Internal.hs+19−31 src/Data/Swagger/Internal/ParamSchema.hs+31−31 src/Data/Swagger/Internal/Schema.hs+36−36 src/Data/Swagger/Internal/Utils.hs+22 src/Data/Swagger/Lens.hs+93−102 swagger2.cabal+1 test/Data/SwaggerSpec.hs+127−140
src/Data/Swagger.hs+49−22
@@ -33,8 +33,7 @@ module Data.Swagger (
3333 Contact(..),
3434 License(..),
3535
36− -- ** Paths
37− Paths(..),
36+ -- ** PathItem
3837 PathItem(..),
3938
4039 -- ** Operations
@@ -160,33 +159,61 @@ import Data.Swagger.Internal
160159-- $lens
161160--
162161-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
163−-- to modify this structure. In combination with @'Monoid'@ instances, lenses
164−-- also make it fairly simple to construct/modify any part of the specification:
162+-- to work comfortly with it. In combination with @'Monoid'@ instances, lenses
163+-- make it fairly simple to construct/modify any part of the specification:
165164--
166165-- >>> :{
167−-- encode $ mempty & pathsMap .~
168−-- [ ("/user", mempty & pathItemGet ?~ (mempty
169−-- & operationProduces ?~ MimeList ["application/json"]
170−-- & operationResponses .~ (mempty
171−-- & responsesResponses . at 200 ?~ Inline (mempty & responseSchema ?~ Ref (Reference "#/definitions/User")))))]
166+-- encode $ (mempty :: Swagger)
167+-- & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]
168+-- & paths .~
169+-- [ ("/user", mempty & get ?~ (mempty
170+-- & produces ?~ MimeList ["application/json"]
171+-- & at 200 ?~ Inline (mempty & schema ?~ Ref (Reference "User")))) ]
172172-- :}
173−-- "{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/#/definitions/User\"},\"description\":\"\"}},\"produces\":[\"application/json\"]}}}"
173+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"definitions\":{\"User\":{\"type\":\"string\"}},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"\"}},\"produces\":[\"application/json\"]}}}}"
174174--
175−-- In the snippet above we declare API paths with a single path @/user@ providing method @GET@
175+-- In the snippet above we declare API with a single path @/user@ providing method @GET@
176176-- which produces @application/json@ output and should respond with code @200@ and body specified
177−-- by schema @User@ (which should be defined in @definitions@ property of swagger specification).
177+-- by schema @User@ which is defined in @'definitions'@ property of swagger specification.
178178--
179−-- Since @'ParamSchema'@ is basically the /base schema specification/, a special
180−-- @'HasParamSchema'@ class has been introduced to generalize @'ParamSchema'@ lenses
181−-- and allow them to be used by any type that has a @'ParamSchema'@:
179+-- For convenience, @swagger2@ uses /classy field lenses/. It means that
180+-- field accessor names can be overloaded for different types. One such
181+-- common field is @'description'@. Many components of Swagger specification
182+-- can have descriptions, and you can use the same name for them:
182183--
184+-- >>> encode $ (mempty :: Response) & description .~ "No content"
185+-- "{\"description\":\"No content\"}"
183186-- >>> :{
184−-- encode $ mempty
185−-- & schemaTitle ?~ "Email"
186−-- & schemaType .~ SwaggerString
187−-- & schemaFormat ?~ "email"
187+-- encode $ (mempty :: Schema)
188+-- & type_ .~ SwaggerBoolean
189+-- & description ?~ "To be or not to be"
188190-- :}
189−-- "{\"format\":\"email\",\"title\":\"Email\",\"type\":\"string\"}"
191+-- "{\"type\":\"boolean\",\"description\":\"To be or not to be\"}"
192+--
193+-- @'ParamSchema'@ is basically the /base schema specification/ and many types contain it (see @'HasParamSchema'@).
194+-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
195+-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
196+--
197+-- >>> encode $ (mempty :: Header) & type_ .~ SwaggerNumber
198+-- "{\"type\":\"number\"}"
199+--
200+-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
201+-- have direct access to it via @'at' code@. Example:
202+--
203+-- >>> :{
204+-- encode $ (mempty :: Operation)
205+-- & at 404 ?~ Inline (mempty & description .~ "Not found")
206+-- :}
207+-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
208+--
209+-- You might've noticed that @'type_'@ has an extra underscore in its name
210+-- compared to, say, @'description'@ field accessor.
211+-- This is because @type@ is a keyword in Haskell.
212+-- A few other field accessors are modified in this way:
213+--
214+-- - @'in_'@, @'type_'@, @'default_'@ (as keywords);
215+-- - @'maximum_'@ and @'minimum_'@ (as conflicting with @Prelude@);
216+-- - @'enum_'@ (as conflicting with @Control.Lens@).
190217
191218-- $schema
192219--
@@ -199,8 +226,8 @@ import Data.Swagger.Internal
199226-- with properties in addition to what @'ParamSchema'@ provides.
200227--
201228-- In most cases you will have a Haskell data type for which you would like to
202−-- define a corresponding schema. To facilitate thise use case
203−-- this library provides two classes for schema encoding.
229+-- define a corresponding schema. To facilitate this use case
230+-- @swagger2@ provides two classes for schema encoding.
204231-- Both these classes provide means to encode /types/ as Swagger /schemas/.
205232--
206233-- @'ToParamSchema'@ is intended to be used for primitive API endpoint parameters,
src/Data/Swagger/Internal.hs+19−31
@@ -40,61 +40,63 @@ type Definitions = HashMap Text
4040data Swagger = Swagger
4141 { -- | Provides metadata about the API.
4242 -- The metadata can be used by the clients if needed.
43− _info :: Info
43+ _swaggerInfo :: Info
4444
4545 -- | The host (name or ip) serving the API. It MAY include a port.
4646 -- If the host is not included, the host serving the documentation is to be used (including the port).
47− , _host :: Maybe Host
47+ , _swaggerHost :: Maybe Host
4848
4949 -- | The base path on which the API is served, which is relative to the host.
5050 -- If it is not included, the API is served directly under the host.
5151 -- The value MUST start with a leading slash (/).
52− , _basePath :: Maybe FilePath
52+ , _swaggerBasePath :: Maybe FilePath
5353
5454 -- | The transfer protocol of the API.
5555 -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
56− , _schemes :: Maybe [Scheme]
56+ , _swaggerSchemes :: Maybe [Scheme]
5757
5858 -- | A list of MIME types the APIs can consume.
5959 -- This is global to all APIs but can be overridden on specific API calls.
60− , _consumes :: MimeList
60+ , _swaggerConsumes :: MimeList
6161
6262 -- | A list of MIME types the APIs can produce.
6363 -- This is global to all APIs but can be overridden on specific API calls.
64− , _produces :: MimeList
64+ , _swaggerProduces :: MimeList
6565
6666 -- | The available paths and operations for the API.
67− , _paths :: Paths
67+ -- Holds the relative paths to the individual endpoints.
68+ -- The path is appended to the @'basePath'@ in order to construct the full URL.
69+ , _swaggerPaths :: HashMap FilePath PathItem
6870
6971 -- | An object to hold data types produced and consumed by operations.
70− , _definitions :: Definitions Schema
72+ , _swaggerDefinitions :: Definitions Schema
7173
7274 -- | An object to hold parameters that can be used across operations.
7375 -- This property does not define global parameters for all operations.
74− , _parameters :: Definitions Param
76+ , _swaggerParameters :: Definitions Param
7577
7678 -- | An object to hold responses that can be used across operations.
7779 -- This property does not define global responses for all operations.
78− , _responses :: Definitions Response
80+ , _swaggerResponses :: Definitions Response
7981
8082 -- | Security scheme definitions that can be used across the specification.
81− , _securityDefinitions :: Definitions SecurityScheme
83+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme
8284
8385 -- | A declaration of which security schemes are applied for the API as a whole.
8486 -- The list of values describes alternative security schemes that can be used
8587 -- (that is, there is a logical OR between the security requirements).
8688 -- Individual operations can override this definition.
87− , _security :: [SecurityRequirement]
89+ , _swaggerSecurity :: [SecurityRequirement]
8890
8991 -- | A list of tags used by the specification with additional metadata.
9092 -- The order of the tags can be used to reflect on their order by the parsing tools.
9193 -- Not all tags that are used by the Operation Object must be declared.
9294 -- The tags that are not declared may be organized randomly or based on the tools' logic.
9395 -- Each tag name in the list MUST be unique.
94− , _tags :: [Tag]
96+ , _swaggerTags :: [Tag]
9597
9698 -- | Additional external documentation.
97− , _externalDocs :: Maybe ExternalDocs
99+ , _swaggerExternalDocs :: Maybe ExternalDocs
98100 } deriving (Eq, Show, Generic, Data, Typeable)
99101
100102-- | The object provides metadata about the API.
@@ -170,13 +172,6 @@ data Scheme
170172 | Wss
171173 deriving (Eq, Show, Generic, Data, Typeable)
172174
173−-- | The available paths and operations for the API.
174−data Paths = Paths
175− { -- | Holds the relative paths to the individual endpoints.
176− -- The path is appended to the @'basePath'@ in order to construct the full URL.
177− _pathsMap :: HashMap FilePath PathItem
178− } deriving (Eq, Show, Generic, Data, Typeable)
179−
180175-- | Describes the operations available on a single path.
181176-- A @'PathItem'@ may be empty, due to ACL constraints.
182177-- The path itself is still exposed to the documentation viewer
@@ -719,7 +714,7 @@ instance Monoid Info where
719714 mempty = genericMempty
720715 mappend = genericMappend
721716
722−instance Monoid Paths where
717+instance Monoid Contact where
723718 mempty = genericMempty
724719 mappend = genericMappend
725720
@@ -772,7 +767,6 @@ instance Monoid Example where
772767-- =======================================================================
773768
774769instance SwaggerMonoid Info
775−instance SwaggerMonoid Paths
776770instance SwaggerMonoid PathItem
777771instance SwaggerMonoid Schema
778772instance SwaggerMonoid (ParamSchema t)
@@ -907,7 +901,7 @@ instance ToJSON SecuritySchemeType where
907901 <+> object [ "type" .= ("oauth2" :: Text) ]
908902
909903instance ToJSON Swagger where
910− toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
904+ toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "swagger")
911905 where
912906 addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
913907 addVersion _ = error "impossible"
@@ -937,9 +931,6 @@ instance ToJSON Host where
937931 Nothing -> host
938932 Just port -> host ++ ":" ++ show port
939933
940−instance ToJSON Paths where
941− toJSON (Paths m) = toJSON m
942−
943934instance ToJSON MimeList where
944935 toJSON (MimeList xs) = toJSON (map show xs)
945936
@@ -1037,7 +1028,7 @@ instance FromJSON Swagger where
10371028 parseJSON js@(Object o) = do
10381029 (version :: Text) <- o .: "swagger"
10391030 when (version /= "2.0") empty
1040− (genericParseJSON (jsonPrefix "")
1031+ (genericParseJSON (jsonPrefix "swagger")
10411032 `withDefaults` [ "consumes" .= (mempty :: MimeList)
10421033 , "produces" .= (mempty :: MimeList)
10431034 , "security" .= ([] :: [SecurityRequirement])
@@ -1080,9 +1071,6 @@ instance FromJSON Host where
10801071 [host, portStr] = map Text.unpack [hostText, portText]
10811072 parseJSON _ = empty
10821073
1083−instance FromJSON Paths where
1084− parseJSON js = Paths <$> parseJSON js
1085−
10861074instance FromJSON MimeList where
10871075 parseJSON js = (MimeList . map fromString) <$> parseJSON js
10881076
src/Data/Swagger/Internal/ParamSchema.hs+31−31
@@ -42,8 +42,8 @@ import Data.Swagger.SchemaOptions
4242--
4343-- instance ToParamSchema Direction where
4444-- toParamSchema = mempty
45−-- & schemaType .~ SwaggerString
46−-- & schemaEnum .~ [ \"Up\", \"Down\" ]
45+-- & type_ .~ SwaggerString
46+-- & enum_ .~ [ \"Up\", \"Down\" ]
4747-- @
4848--
4949-- Instead of manually writing your @'ToParamSchema'@ instance you can
@@ -74,23 +74,23 @@ class ToParamSchema a where
7474 toParamSchema = genericToParamSchema defaultSchemaOptions
7575
7676instance {-# OVERLAPPING #-} ToParamSchema String where
77− toParamSchema _ = mempty & schemaType .~ SwaggerString
77+ toParamSchema _ = mempty & type_ .~ SwaggerString
7878
7979instance ToParamSchema Bool where
80− toParamSchema _ = mempty & schemaType .~ SwaggerBoolean
80+ toParamSchema _ = mempty & type_ .~ SwaggerBoolean
8181
8282instance ToParamSchema Integer where
83− toParamSchema _ = mempty & schemaType .~ SwaggerInteger
83+ toParamSchema _ = mempty & type_ .~ SwaggerInteger
8484
8585instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
8686instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
8787instance ToParamSchema Int16 where toParamSchema = toParamSchemaBoundedIntegral
8888
8989instance ToParamSchema Int32 where
90− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int32"
90+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int32"
9191
9292instance ToParamSchema Int64 where
93− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int64"
93+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int64"
9494
9595instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
9696instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
@@ -104,52 +104,52 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
104104-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
105105toParamSchemaBoundedIntegral :: forall proxy a t. (Bounded a, Integral a) => proxy a -> ParamSchema t
106106toParamSchemaBoundedIntegral _ = mempty
107− & schemaType .~ SwaggerInteger
108− & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
109− & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
107+ & type_ .~ SwaggerInteger
108+ & minimum_ ?~ fromInteger (toInteger (minBound :: a))
109+ & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
110110
111111instance ToParamSchema Char where
112112 toParamSchema _ = mempty
113− & schemaType .~ SwaggerString
114− & schemaMaxLength ?~ 1
115− & schemaMinLength ?~ 1
113+ & type_ .~ SwaggerString
114+ & maxLength ?~ 1
115+ & minLength ?~ 1
116116
117117instance ToParamSchema Scientific where
118− toParamSchema _ = mempty & schemaType .~ SwaggerNumber
118+ toParamSchema _ = mempty & type_ .~ SwaggerNumber
119119
120120instance ToParamSchema Double where
121121 toParamSchema _ = mempty
122− & schemaType .~ SwaggerNumber
123− & schemaFormat ?~ "double"
122+ & type_ .~ SwaggerNumber
123+ & format ?~ "double"
124124
125125instance ToParamSchema Float where
126126 toParamSchema _ = mempty
127− & schemaType .~ SwaggerNumber
128− & schemaFormat ?~ "float"
127+ & type_ .~ SwaggerNumber
128+ & format ?~ "float"
129129
130130timeParamSchema :: String -> ParamSchema t
131−timeParamSchema format = mempty
132− & schemaType .~ SwaggerString
133− & schemaFormat ?~ T.pack format
131+timeParamSchema fmt = mempty
132+ & type_ .~ SwaggerString
133+ & format ?~ T.pack fmt
134134
135135-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
136136instance ToParamSchema Day where
137137 toParamSchema _ = timeParamSchema "date"
138138
139139-- |
140−-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
140+-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format
141141-- Just "yyyy-mm-ddThh:MM:ss"
142142instance ToParamSchema LocalTime where
143143 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss"
144144
145145-- |
146−-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat
146+-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
147147-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
148148instance ToParamSchema ZonedTime where
149149 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
150150
151151-- |
152−-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
152+-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
153153-- Just "yyyy-mm-ddThh:MM:ssZ"
154154instance ToParamSchema UTCTime where
155155 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ssZ"
@@ -173,12 +173,12 @@ instance ToParamSchema a => ToParamSchema (Dual a) where toParamSchema _ = to
173173
174174instance ToParamSchema a => ToParamSchema [a] where
175175 toParamSchema _ = mempty
176− & schemaType .~ SwaggerArray
177− & schemaItems ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
176+ & type_ .~ SwaggerArray
177+ & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
178178
179179instance ToParamSchema a => ToParamSchema (Set a) where
180180 toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
181− & schemaUniqueItems ?~ True
181+ & uniqueItems ?~ True
182182
183183instance ToParamSchema a => ToParamSchema (HashSet a) where
184184 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
@@ -188,8 +188,8 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
188188-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
189189instance ToParamSchema () where
190190 toParamSchema _ = mempty
191− & schemaType .~ SwaggerString
192− & schemaEnum ?~ ["_"]
191+ & type_ .~ SwaggerString
192+ & enum_ ?~ ["_"]
193193
194194-- | A configurable generic @'ParamSchema'@ creator.
195195--
@@ -226,8 +226,8 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
226226
227227instance Constructor c => GEnumParamSchema (C1 c U1) where
228228 genumParamSchema opts _ s = s
229− & schemaType .~ SwaggerString
230− & schemaEnum %~ addEnumValue tag
229+ & type_ .~ SwaggerString
230+ & enum_ %~ addEnumValue tag
231231 where
232232 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
233233
src/Data/Swagger/Internal/Schema.hs+36−36
@@ -76,12 +76,12 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
7676-- declareNamedSchema = pure (Just \"Coord\", schema)
7777-- where
7878-- schema = mempty
79−-- & schemaType .~ SwaggerObject
80−-- & schemaProperties .~
79+-- & type_ .~ SwaggerObject
80+-- & properties .~
8181-- [ (\"x\", toSchemaRef (Proxy :: Proxy Double))
8282-- , (\"y\", toSchemaRef (Proxy :: Proxy Double))
8383-- ]
84−-- & schemaRequired .~ [ \"x\", \"y\" ]
84+-- & required .~ [ \"x\", \"y\" ]
8585-- @
8686--
8787-- Instead of manually writing your @'ToSchema'@ instance you can
@@ -117,14 +117,14 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
117117
118118-- | Convert a type into an optionally named schema.
119119--
120−-- >>> toNamedSchema (Proxy :: Proxy String) ^. namedSchemaName
120+-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
121121-- Nothing
122−-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. namedSchemaSchema)
122+-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
123123-- "{\"type\":\"string\"}"
124124--
125−-- >>> toNamedSchema (Proxy :: Proxy Day) ^. namedSchemaName
125+-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
126126-- Just "Day"
127−-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. namedSchemaSchema)
127+-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
128128-- "{\"format\":\"date\",\"type\":\"string\"}"
129129toNamedSchema :: ToSchema a => proxy a -> NamedSchema
130130toNamedSchema = undeclare . declareNamedSchema
@@ -262,8 +262,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
262262 declareNamedSchema _ = do
263263 ref <- declareSchemaRef (Proxy :: Proxy a)
264264 return $ unnamed $ mempty
265− & schemaType .~ SwaggerArray
266− & schemaItems ?~ SwaggerItemsObject ref
265+ & type_ .~ SwaggerArray
266+ & items ?~ SwaggerItemsObject ref
267267
268268instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
269269instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -300,16 +300,16 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
300300instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
301301
302302timeSchema :: T.Text -> Schema
303−timeSchema format = mempty
304− & schemaType .~ SwaggerString
305− & schemaFormat ?~ format
303+timeSchema fmt = mempty
304+ & type_ .~ SwaggerString
305+ & format ?~ fmt
306306
307307-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
308308instance ToSchema Day where
309309 declareNamedSchema _ = pure $ named "Day" (timeSchema "date")
310310
311311-- |
312−-- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
312+-- >>> toSchema (Proxy :: Proxy LocalTime) ^. format
313313-- Just "yyyy-mm-ddThh:MM:ss"
314314instance ToSchema LocalTime where
315315 declareNamedSchema _ = pure $ named "LocalTime" (timeSchema "yyyy-mm-ddThh:MM:ss")
@@ -322,7 +322,7 @@ instance ToSchema NominalDiffTime where
322322 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)
323323
324324-- |
325−-- >>> toSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
325+-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
326326-- Just "yyyy-mm-ddThh:MM:ssZ"
327327instance ToSchema UTCTime where
328328 declareNamedSchema _ = pure $ named "UTCTime" (timeSchema "yyyy-mm-ddThh:MM:ssZ")
@@ -340,8 +340,8 @@ instance ToSchema a => ToSchema (Map String a) where
340340 declareNamedSchema _ = do
341341 schema <- declareSchema (Proxy :: Proxy a)
342342 return $ unnamed $ mempty
343− & schemaType .~ SwaggerObject
344− & schemaAdditionalProperties ?~ schema
343+ & type_ .~ SwaggerObject
344+ & additionalProperties ?~ schema
345345
346346instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
347347instance ToSchema a => ToSchema (Map TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
@@ -354,7 +354,7 @@ instance ToSchema a => ToSchema (Set a) where
354354 declareNamedSchema _ = do
355355 schema <- declareSchema (Proxy :: Proxy [a])
356356 return $ unnamed $ schema
357− & schemaUniqueItems ?~ True
357+ & uniqueItems ?~ True
358358
359359instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
360360
@@ -373,9 +373,9 @@ instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname
373373-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
374374toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
375375toSchemaBoundedIntegral _ = mempty
376− & schemaType .~ SwaggerInteger
377− & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))
378− & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))
376+ & type_ .~ SwaggerInteger
377+ & minimum_ ?~ fromInteger (toInteger (minBound :: a))
378+ & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
379379
380380-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
381381genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
@@ -411,13 +411,13 @@ paramSchemaToNamedSchema opts proxy = NamedSchema (gdatatypeSchemaName opts (Pro
411411
412412-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
413413paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema
414−paramSchemaToSchema _ = mempty & schemaParamSchema .~ toParamSchema (Proxy :: Proxy a)
414+paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)
415415
416416nullarySchema :: Schema
417417nullarySchema = mempty
418− & schemaType .~ SwaggerArray
419− & schemaEnum ?~ [ toJSON () ]
420− & schemaItems ?~ SwaggerItemsArray []
418+ & type_ .~ SwaggerArray
419+ & enum_ ?~ [ toJSON () ]
420+ & items ?~ SwaggerItemsArray []
421421
422422gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
423423gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -446,7 +446,7 @@ instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where
446446 gdeclareNamedSchema opts _ s
447447 | unwrapUnaryRecords opts = fieldSchema
448448 | otherwise =
449− case schema ^. schemaItems of
449+ case schema ^. items of
450450 Just (SwaggerItemsArray [_]) -> fieldSchema
451451 _ -> do
452452 declare defs
@@ -487,13 +487,13 @@ withFieldSchema opts _ isRequiredField schema = do
487487 return $
488488 if T.null fname
489489 then schema
490− & schemaType .~ SwaggerArray
491− & schemaItems %~ appendItem ref
490+ & type_ .~ SwaggerArray
491+ & items %~ appendItem ref
492492 else schema
493− & schemaType .~ SwaggerObject
494− & schemaProperties . at fname ?~ ref
493+ & type_ .~ SwaggerObject
494+ & properties . at fname ?~ ref
495495 & if isRequiredField
496− then schemaRequired %~ (fname :)
496+ then required %~ (fname :)
497497 else id
498498 where
499499 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
@@ -524,8 +524,8 @@ gdeclareNamedSumSchema opts proxy s
524524 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
525525
526526 toStringTag schema = mempty
527− & schemaType .~ SwaggerString
528− & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)
527+ & type_ .~ SwaggerString
528+ & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
529529
530530type AllNullary = All
531531
@@ -540,10 +540,10 @@ gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
540540gsumConToSchema opts _ schema = do
541541 ref <- gdeclareSchemaRef opts (Proxy :: Proxy (C1 c f))
542542 return $ schema
543− & schemaType .~ SwaggerObject
544− & schemaProperties . at tag ?~ ref
545− & schemaMaxProperties ?~ 1
546− & schemaMinProperties ?~ 1
543+ & type_ .~ SwaggerObject
544+ & properties . at tag ?~ ref
545+ & maxProperties ?~ 1
546+ & minProperties ?~ 1
547547 where
548548 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
549549
src/Data/Swagger/Internal/Utils.hs+22
@@ -8,6 +8,8 @@ module Data.Swagger.Internal.Utils where
88
99import Control.Arrow (first)
1010import Control.Applicative
11+import Control.Lens ((&), (%~))
12+import Control.Lens.TH
1113import Data.Aeson
1214import Data.Aeson.Types
1315import Data.Char
@@ -19,8 +21,28 @@ import Data.Map (Map)
1921import Data.Monoid
2022import Data.Text (Text)
2123import GHC.Generics
24+import Language.Haskell.TH (mkName)
2225import Text.Read (readMaybe)
2326
27+swaggerFieldRules :: LensRules
28+swaggerFieldRules = defaultFieldRules & lensField %~ swaggerFieldNamer
29+ where
30+ swaggerFieldNamer namer dname fnames fname =
31+ map fixDefName (namer dname fnames fname)
32+
33+ fixDefName (MethodName cname mname) = MethodName cname (fixName mname)
34+ fixDefName (TopName name) = TopName (fixName name)
35+
36+ fixName = mkName . fixName' . show
37+
38+ fixName' "in" = "in_" -- keyword
39+ fixName' "type" = "type_" -- keyword
40+ fixName' "default" = "default_" -- keyword
41+ fixName' "minimum" = "minimum_" -- Prelude conflict
42+ fixName' "maximum" = "maximum_" -- Prelude conflict
43+ fixName' "enum" = "enum_" -- Control.Lens conflict
44+ fixName' n = n
45+
2446gunfoldEnum :: String -> [a] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a
2547gunfoldEnum tname xs _k z c = case lookup (constrIndex c) (zip [1..] xs) of
2648 Just x -> z x
src/Data/Swagger/Lens.hs+93−102
@@ -1,50 +1,50 @@
1+{-# LANGUAGE FlexibleContexts #-}
12{-# LANGUAGE FlexibleInstances #-}
23{-# LANGUAGE FunctionalDependencies #-}
34{-# LANGUAGE GADTs #-}
45{-# LANGUAGE MultiParamTypeClasses #-}
56{-# LANGUAGE RankNTypes #-}
67{-# LANGUAGE TemplateHaskell #-}
8+{-# LANGUAGE TypeFamilies #-}
9+{-# LANGUAGE UndecidableInstances #-}
710module Data.Swagger.Lens where
811
912import Control.Lens
1013import Data.Aeson (Value)
1114import Data.Scientific (Scientific)
1215import Data.Swagger.Internal
16+import Data.Swagger.Internal.Utils
1317import Data.Text (Text)
1418
15−-- =======================================================================
16−-- * TH derived lenses
17−
18−-- ** 'Swagger' lenses
19−makeLenses ''Swagger
20−-- ** 'Host' lenses
21−makeLenses ''Host
22−-- ** 'Info' lenses
23−makeLenses ''Info
24−-- ** 'Contact' lenses
25−makeLenses ''Contact
26−-- ** 'License' lenses
27−makeLenses ''License
28−-- ** 'Paths' lenses
29−makeLenses ''Paths
30−-- ** 'PathItem' lenses
31−makeLenses ''PathItem
32−-- ** 'Tag' lenses
33−makeLenses ''Tag
34−-- ** 'Operation' lenses
35−makeLenses ''Operation
36−-- ** 'Param' lenses
37−makeLenses ''Param
19+-- * Classy lenses
20+
21+makeFields ''Swagger
22+makeFields ''Host
23+makeFields ''Info
24+makeFields ''Contact
25+makeFields ''License
26+makeFields ''PathItem
27+makeFields ''Tag
28+makeFields ''Operation
29+makeFields ''Param
30+makeLensesWith swaggerFieldRules ''ParamOtherSchema
31+makeFields ''Header
32+makeFields ''Schema
33+makeFields ''NamedSchema
34+makeLensesWith swaggerFieldRules ''ParamSchema
35+makeFields ''Xml
36+makeLensesWith swaggerFieldRules ''Responses
37+makeFields ''Response
38+makeLensesWith swaggerFieldRules ''SecurityScheme
39+makeFields ''ApiKeyParams
40+makeFields ''OAuth2Params
41+makeFields ''ExternalDocs
42+
43+-- * Prisms
3844-- ** 'ParamAnySchema' prisms
3945makePrisms ''ParamAnySchema
40−-- ** 'ParamOtherSchema' lenses
41−makeLenses ''ParamOtherSchema
42−-- ** 'Header' lenses
43−makeLenses ''Header
44−-- ** 'Schema' lenses
45−makeLenses ''Schema
46−-- ** 'NamedSchema' lenses
47−makeLenses ''NamedSchema
46+-- ** 'SecuritySchemeType' prisms
47+makePrisms ''SecuritySchemeType
4848
4949-- ** 'SwaggerItems' prisms
5050
@@ -65,95 +65,86 @@ _SwaggerItemsObject
6565_SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) => Optic' p f (SwaggerItems t) (Maybe (CollectionFormat t), ParamSchema t)
6666_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)
6767
68−-- ** 'ParamSchema' lenses
69−makeLenses ''ParamSchema
70−-- ** 'Xml' lenses
71−makeLenses ''Xml
72−-- ** 'Responses' lenses
73−makeLenses ''Responses
74−-- ** 'Response' lenses
75−makeLenses ''Response
76−-- ** 'SecurityScheme' lenses
77−makeLenses ''SecurityScheme
78−-- ** 'SecuritySchemeType' prisms
79−makePrisms ''SecuritySchemeType
80−-- ** 'ApiKeyParams' lenses
81−makeLenses ''ApiKeyParams
82−-- ** 'OAuth2Params' lenses
83−makeLenses ''OAuth2Params
84−-- ** 'ExternalDocs' lenses
85−makeLenses ''ExternalDocs
86−
87−-- =======================================================================
88−-- * Helper classy lenses
68+-- =============================================================
69+-- More helpful instances for easier access to schema properties
8970
90−class HasDescription s d | s -> d where
91− description :: Lens' s d
71+type instance Index Responses = HttpStatusCode
72+type instance Index Operation = HttpStatusCode
9273
93−instance HasDescription Response Text where description = responseDescription
94−instance HasDescription Info (Maybe Text) where description = infoDescription
95−instance HasDescription Tag (Maybe Text) where description = tagDescription
96−instance HasDescription Operation (Maybe Text) where description = operationDescription
97−instance HasDescription Param (Maybe Text) where description = paramDescription
98−instance HasDescription Header (Maybe Text) where description = headerDescription
99−instance HasDescription Schema (Maybe Text) where description = schemaDescription
100−instance HasDescription SecurityScheme (Maybe Text) where description = securitySchemeDescription
101−instance HasDescription ExternalDocs (Maybe Text) where description = externalDocsDescription
74+type instance IxValue Responses = Referenced Response
75+type instance IxValue Operation = Referenced Response
10276
103−class HasParamSchema s t | s -> t where
104− parameterSchema :: Lens' s (ParamSchema t)
77+instance Ixed Responses where ix n = responses . ix n
78+instance At Responses where at n = responses . at n
10579
106−instance HasParamSchema Schema Schema where parameterSchema = schemaParamSchema
107−instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema
108−instance HasParamSchema Header Header where parameterSchema = headerParamSchema
109−instance HasParamSchema (ParamSchema t) t where parameterSchema = id
110−instance HasParamSchema NamedSchema Schema where parameterSchema = namedSchemaSchema.parameterSchema
80+instance Ixed Operation where ix n = responses . ix n
81+instance At Operation where at n = responses . at n
11182
112−schemaType :: HasParamSchema s t => Lens' s (SwaggerType t)
113−schemaType = parameterSchema.paramSchemaType
83+-- HasType instances
84+instance HasType Header (SwaggerType Header) where type_ = paramSchema.type_
85+instance HasType Schema (SwaggerType Schema) where type_ = paramSchema.type_
86+instance HasType NamedSchema (SwaggerType Schema) where type_ = schema.paramSchema.type_
87+instance HasType ParamOtherSchema (SwaggerType ParamOtherSchema) where type_ = paramSchema.type_
11488
115−schemaFormat :: HasParamSchema s t => Lens' s (Maybe Format)
116−schemaFormat = parameterSchema.paramSchemaFormat
89+-- HasDefault instances
90+instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_
91+instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
92+instance HasDefault ParamOtherSchema (Maybe Value) where default_ = paramSchema.default_
11793
118−schemaItems :: HasParamSchema s t => Lens' s (Maybe (SwaggerItems t))
119−schemaItems = parameterSchema.paramSchemaItems
94+-- OVERLAPPABLE instances
12095
121−schemaDefault :: HasParamSchema s t => Lens' s (Maybe Value)
122−schemaDefault = parameterSchema.paramSchemaDefault
96+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
97+ => HasFormat s (Maybe Format) where
98+ format = paramSchema.format
12399
124−schemaMaximum :: HasParamSchema s t => Lens' s (Maybe Scientific)
125−schemaMaximum = parameterSchema.paramSchemaMaximum
100+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
101+ => HasItems s (Maybe (SwaggerItems t)) where
102+ items = paramSchema.items
126103
127−schemaExclusiveMaximum :: HasParamSchema s t => Lens' s (Maybe Bool)
128−schemaExclusiveMaximum = parameterSchema.paramSchemaExclusiveMaximum
104+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
105+ => HasMaximum s (Maybe Scientific) where
106+ maximum_ = paramSchema.maximum_
129107
130−schemaMinimum :: HasParamSchema s t => Lens' s (Maybe Scientific)
131−schemaMinimum = parameterSchema.paramSchemaMinimum
108+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
109+ => HasExclusiveMaximum s (Maybe Bool) where
110+ exclusiveMaximum = paramSchema.exclusiveMaximum
132111
133−schemaExclusiveMinimum :: HasParamSchema s t => Lens' s (Maybe Bool)
134−schemaExclusiveMinimum = parameterSchema.paramSchemaExclusiveMinimum
112+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
113+ => HasMinimum s (Maybe Scientific) where
114+ minimum_ = paramSchema.minimum_
135115
136−schemaMaxLength :: HasParamSchema s t => Lens' s (Maybe Integer)
137−schemaMaxLength = parameterSchema.paramSchemaMaxLength
116+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
117+ => HasExclusiveMinimum s (Maybe Bool) where
118+ exclusiveMinimum = paramSchema.exclusiveMinimum
138119
139−schemaMinLength :: HasParamSchema s t => Lens' s (Maybe Integer)
140−schemaMinLength = parameterSchema.paramSchemaMinLength
120+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
121+ => HasMaxLength s (Maybe Integer) where
122+ maxLength = paramSchema.maxLength
141123
142−schemaPattern :: HasParamSchema s t => Lens' s (Maybe Text)
143−schemaPattern = parameterSchema.paramSchemaPattern
124+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
125+ => HasMinLength s (Maybe Integer) where
126+ minLength = paramSchema.minLength
144127
145−schemaMaxItems :: HasParamSchema s t => Lens' s (Maybe Integer)
146−schemaMaxItems = parameterSchema.paramSchemaMaxItems
128+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
129+ => HasPattern s (Maybe Text) where
130+ pattern = paramSchema.pattern
147131
148−schemaMinItems :: HasParamSchema s t => Lens' s (Maybe Integer)
149−schemaMinItems = parameterSchema.paramSchemaMinItems
132+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
133+ => HasMaxItems s (Maybe Integer) where
134+ maxItems = paramSchema.maxItems
150135
151−schemaUniqueItems :: HasParamSchema s t => Lens' s (Maybe Bool)
152−schemaUniqueItems = parameterSchema.paramSchemaUniqueItems
136+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
137+ => HasMinItems s (Maybe Integer) where
138+ minItems = paramSchema.minItems
153139
154−schemaEnum :: HasParamSchema s t => Lens' s (Maybe [Value])
155−schemaEnum = parameterSchema.paramSchemaEnum
140+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
141+ => HasUniqueItems s (Maybe Bool) where
142+ uniqueItems = paramSchema.uniqueItems
156143
157−schemaMultipleOf :: HasParamSchema s t => Lens' s (Maybe Scientific)
158−schemaMultipleOf = parameterSchema.paramSchemaMultipleOf
144+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
145+ => HasEnum s (Maybe [Value]) where
146+ enum_ = paramSchema.enum_
159147
148+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
149+ => HasMultipleOf s (Maybe Scientific) where
150+ multipleOf = paramSchema.multipleOf
swagger2.cabal+1
@@ -40,6 +40,7 @@ library
4040 , mtl
4141 , network
4242 , text
43+ , template-haskell
4344 , time
4445 , unordered-containers
4546 , lens
test/Data/SwaggerSpec.hs+127−140
@@ -13,7 +13,7 @@ import Data.Text (Text)
1313
1414import Data.Swagger
1515import SpecCommon
16−import Test.Hspec
16+import Test.Hspec hiding (example)
1717
1818spec :: Spec
1919spec = do
@@ -44,13 +44,13 @@ main = hspec spec
4444-- =======================================================================
4545
4646infoExample :: Info
47−infoExample = Info
48− { _infoTitle = "Swagger Sample App"
49− , _infoDescription = Just "This is a sample server Petstore server."
50− , _infoTermsOfService = Just "http://swagger.io/terms/"
51− , _infoContact = Just contactExample
52− , _infoLicense = Just licenseExample
53− , _infoVersion = "1.0.1" }
47+infoExample = mempty
48+ & title .~ "Swagger Sample App"
49+ & description ?~ "This is a sample server Petstore server."
50+ & termsOfService ?~ "http://swagger.io/terms/"
51+ & contact ?~ contactExample
52+ & license ?~ licenseExample
53+ & version .~ "1.0.1"
5454
5555infoExampleJSON :: Value
5656infoExampleJSON = [aesonQQ|
@@ -76,10 +76,10 @@ infoExampleJSON = [aesonQQ|
7676-- =======================================================================
7777
7878contactExample :: Contact
79−contactExample = Contact
80− { _contactName = Just "API Support"
81− , _contactUrl = Just (URL "http://www.swagger.io/support")
82− , _contactEmail = Just "support@swagger.io" }
79+contactExample = mempty
80+ & name ?~ "API Support"
81+ & url ?~ URL "http://www.swagger.io/support"
82+ & email ?~ "support@swagger.io"
8383
8484contactExampleJSON :: Value
8585contactExampleJSON = [aesonQQ|
@@ -95,9 +95,7 @@ contactExampleJSON = [aesonQQ|
9595-- =======================================================================
9696
9797licenseExample :: License
98−licenseExample = License
99− { _licenseName = "Apache 2.0"
100− , _licenseUrl = Just (URL "http://www.apache.org/licenses/LICENSE-2.0.html") }
98+licenseExample = License "Apache 2.0" (Just (URL "http://www.apache.org/licenses/LICENSE-2.0.html"))
10199
102100licenseExampleJSON :: Value
103101licenseExampleJSON = [aesonQQ|
@@ -114,46 +112,39 @@ licenseExampleJSON = [aesonQQ|
114112
115113operationExample :: Operation
116114operationExample = mempty
117− { _operationTags = ["pet"]
118− , _operationSummary = Just "Updates a pet in the store with form data"
119− , _operationDescription = Just ""
120− , _operationOperationId = Just "updatePetWithForm"
121− , _operationConsumes = Just (MimeList ["application/x-www-form-urlencoded"])
122− , _operationProduces = Just (MimeList ["application/json", "application/xml"])
123− , _operationParameters = params
124− , _operationResponses = responses
125− , _operationSecurity = security
126− }
127− where
128− security = [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
129−
130− responses = mempty
131− { _responsesResponses =
132− [ (200, Inline mempty { _responseDescription = "Pet updated." })
133− , (405, Inline mempty { _responseDescription = "Invalid input" }) ] }
134−
135− params = map Inline
136− [ Param
137− { _paramName = "petId"
138− , _paramDescription = Just "ID of pet that needs to be updated"
139− , _paramRequired = Just True
140− , _paramSchema = ParamOther (stringSchema ParamPath) }
141− , Param
142− { _paramName = "name"
143− , _paramDescription = Just "Updated name of the pet"
144− , _paramRequired = Just False
145− , _paramSchema = ParamOther (stringSchema ParamFormData) }
146− , Param
147− { _paramName = "status"
148− , _paramDescription = Just "Updated status of the pet"
149− , _paramRequired = Just False
150− , _paramSchema = ParamOther (stringSchema ParamFormData) }
115+ & tags .~ ["pet"]
116+ & summary ?~ "Updates a pet in the store with form data"
117+ & description ?~ ""
118+ & operationId ?~ "updatePetWithForm"
119+ & consumes ?~ MimeList ["application/x-www-form-urlencoded"]
120+ & produces ?~ MimeList ["application/json", "application/xml"]
121+ & parameters .~ map Inline
122+ [ mempty
123+ & name .~ "petId"
124+ & description ?~ "ID of pet that needs to be updated"
125+ & required ?~ True
126+ & schema .~ ParamOther (stringSchema ParamPath)
127+ , mempty
128+ & name .~ "name"
129+ & description ?~ "Updated name of the pet"
130+ & required ?~ False
131+ & schema .~ ParamOther (stringSchema ParamFormData)
132+ , mempty
133+ & name .~ "status"
134+ & description ?~ "Updated status of the pet"
135+ & required ?~ False
136+ & schema .~ ParamOther (stringSchema ParamFormData)
151137 ]
152138
139+ & responses .~ (mempty & responses .~
140+ [ (200, Inline (mempty & description .~ "Pet updated."))
141+ , (405, Inline (mempty & description .~ "Invalid input")) ])
142+ & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
143+ where
153144 stringSchema :: ParamLocation -> ParamOtherSchema
154− stringSchema i = mempty
155− & paramOtherSchemaIn .~ i
156− & schemaType .~ SwaggerString
145+ stringSchema loc = mempty
146+ & in_ .~ loc
147+ & type_ .~ SwaggerString
157148
158149operationExampleJSON :: Value
159150operationExampleJSON = [aesonQQ|
@@ -219,8 +210,8 @@ operationExampleJSON = [aesonQQ|
219210
220211schemaPrimitiveExample :: Schema
221212schemaPrimitiveExample = mempty
222− & schemaType .~ SwaggerString
223− & schemaFormat ?~ "email"
213+ & type_ .~ SwaggerString
214+ & format ?~ "email"
224215
225216schemaPrimitiveExampleJSON :: Value
226217schemaPrimitiveExampleJSON = [aesonQQ|
@@ -232,15 +223,15 @@ schemaPrimitiveExampleJSON = [aesonQQ|
232223
233224schemaSimpleModelExample :: Schema
234225schemaSimpleModelExample = mempty
235− & schemaType .~ SwaggerObject
236− & schemaRequired .~ [ "name" ]
237− & schemaProperties .~
238− [ ("name", Inline (mempty & schemaType .~ SwaggerString))
226+ & type_ .~ SwaggerObject
227+ & required .~ [ "name" ]
228+ & properties .~
229+ [ ("name", Inline (mempty & type_ .~ SwaggerString))
239230 , ("address", Ref (Reference "Address"))
240231 , ("age", Inline $ mempty
241− & schemaMinimum ?~ 0
242− & schemaType .~ SwaggerInteger
243− & schemaFormat ?~ "int32" ) ]
232+ & minimum_ ?~ 0
233+ & type_ .~ SwaggerInteger
234+ & format ?~ "int32" ) ]
244235
245236schemaSimpleModelExampleJSON :: Value
246237schemaSimpleModelExampleJSON = [aesonQQ|
@@ -267,8 +258,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
267258
268259schemaModelDictExample :: Schema
269260schemaModelDictExample = mempty
270− & schemaType .~ SwaggerObject
271− & schemaAdditionalProperties ?~ (mempty & schemaType .~ SwaggerString)
261+ & type_ .~ SwaggerObject
262+ & additionalProperties ?~ (mempty & type_ .~ SwaggerString)
272263
273264schemaModelDictExampleJSON :: Value
274265schemaModelDictExampleJSON = [aesonQQ|
@@ -281,19 +272,21 @@ schemaModelDictExampleJSON = [aesonQQ|
281272|]
282273
283274schemaWithExampleExample :: Schema
284−schemaWithExampleExample = (mempty & schemaType .~ SwaggerObject)
285− { _schemaProperties =
275+schemaWithExampleExample = mempty
276+ & type_ .~ SwaggerObject
277+ & properties .~
286278 [ ("id", Inline $ mempty
287− & schemaType .~ SwaggerInteger
288− & schemaFormat ?~ "int64" )
289− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ]
290− , _schemaRequired = [ "name" ]
291− , _schemaExample = Just [aesonQQ|
292− {
293− "name": "Puma",
294− "id": 1
295− }
296− |] }
279+ & type_ .~ SwaggerInteger
280+ & format ?~ "int64" )
281+ , ("name", Inline $ mempty
282+ & type_ .~ SwaggerString) ]
283+ & required .~ [ "name" ]
284+ & example ?~ [aesonQQ|
285+ {
286+ "name": "Puma",
287+ "id": 1
288+ }
289+ |]
297290
298291schemaWithExampleExampleJSON :: Value
299292schemaWithExampleExampleJSON = [aesonQQ|
@@ -325,19 +318,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
325318definitionsExample :: HashMap Text Schema
326319definitionsExample =
327320 [ ("Category", mempty
328− & schemaType .~ SwaggerObject
329− & schemaProperties .~
321+ & type_ .~ SwaggerObject
322+ & properties .~
330323 [ ("id", Inline $ mempty
331− & schemaType .~ SwaggerInteger
332− & schemaFormat ?~ "int64")
333− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] )
324+ & type_ .~ SwaggerInteger
325+ & format ?~ "int64")
326+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] )
334327 , ("Tag", mempty
335− & schemaType .~ SwaggerObject
336− & schemaProperties .~
328+ & type_ .~ SwaggerObject
329+ & properties .~
337330 [ ("id", Inline $ mempty
338− & schemaType .~ SwaggerInteger
339− & schemaFormat ?~ "int64")
340− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] ) ]
331+ & type_ .~ SwaggerInteger
332+ & format ?~ "int64")
333+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] ) ]
341334
342335definitionsExampleJSON :: Value
343336definitionsExampleJSON = [aesonQQ|
@@ -376,21 +369,21 @@ definitionsExampleJSON = [aesonQQ|
376369paramsDefinitionExample :: HashMap Text Param
377370paramsDefinitionExample =
378371 [ ("skipParam", mempty
379− { _paramName = "skip"
380− , _paramDescription = Just "number of items to skip"
381− , _paramRequired = Just True
382− , _paramSchema = ParamOther $ mempty
383− & paramOtherSchemaIn .~ ParamQuery
384− & schemaType .~ SwaggerInteger
385− & schemaFormat ?~ "int32" })
372+ & name .~ "skip"
373+ & description ?~ "number of items to skip"
374+ & required ?~ True
375+ & schema .~ ParamOther (mempty
376+ & in_ .~ ParamQuery
377+ & type_ .~ SwaggerInteger
378+ & format ?~ "int32" ))
386379 , ("limitParam", mempty
387− { _paramName = "limit"
388− , _paramDescription = Just "max records to return"
389− , _paramRequired = Just True
390− , _paramSchema = ParamOther $ mempty
391− & paramOtherSchemaIn .~ ParamQuery
392− & schemaType .~ SwaggerInteger
393− & schemaFormat ?~ "int32" }) ]
380+ & name .~ "limit"
381+ & description ?~ "max records to return"
382+ & required ?~ True
383+ & schema .~ ParamOther (mempty
384+ & in_ .~ ParamQuery
385+ & type_ .~ SwaggerInteger
386+ & format ?~ "int32" )) ]
394387
395388paramsDefinitionExampleJSON :: Value
396389paramsDefinitionExampleJSON = [aesonQQ|
@@ -420,8 +413,8 @@ paramsDefinitionExampleJSON = [aesonQQ|
420413
421414responsesDefinitionExample :: HashMap Text Response
422415responsesDefinitionExample =
423− [ ("NotFound", mempty { _responseDescription = "Entity not found." })
424− , ("IllegalInput", mempty { _responseDescription = "Illegal input for operation." }) ]
416+ [ ("NotFound", mempty & description .~ "Entity not found.")
417+ , ("IllegalInput", mempty & description .~ "Illegal input for operation.") ]
425418
426419responsesDefinitionExampleJSON :: Value
427420responsesDefinitionExampleJSON = [aesonQQ|
@@ -478,45 +471,39 @@ securityDefinitionsExampleJSON = [aesonQQ|
478471
479472swaggerExample :: Swagger
480473swaggerExample = mempty
481− { _basePath = Just "/"
482− , _schemes = Just [Http]
483− , _info = mempty
484− { _infoVersion = "1.0"
485− , _infoTitle = "Todo API"
486− , _infoLicense = Just License
487− { _licenseName = "MIT"
488− , _licenseUrl = Just (URL "http://mit.com") }
489− , _infoDescription = Just "This is a an API that tests servant-swagger support for a Todo API" }
490− , _paths = mempty
491− { _pathsMap =
492− [ ("/todo/{id}", mempty
493− { _pathItemGet = Just mempty
494− { _operationResponses = mempty
495− { _responsesResponses =
496− [ (200, Inline mempty
497− { _responseSchema = Just $ Inline (mempty & schemaType .~ SwaggerObject)
498− { _schemaExample = Just [aesonQQ|
499− {
500− "created": 100,
501− "description": "get milk"
502− } |]
503− , _schemaDescription = Just "This is some real Todo right here"
504− , _schemaProperties =
505− [ ("created", Inline $ mempty
506− & schemaType .~ SwaggerInteger
507− & schemaFormat ?~ "int32")
508− , ("description", Inline (mempty & schemaType .~ SwaggerString)) ] }
509− , _responseDescription = "OK" }) ] }
510− , _operationProduces = Just (MimeList [ "application/json" ])
511− , _operationParameters =
512− [ Inline mempty
513− { _paramRequired = Just True
514− , _paramName = "id"
515− , _paramDescription = Just "TodoId param"
516− , _paramSchema = ParamOther $ mempty
517− & paramOtherSchemaIn .~ ParamPath
518− & schemaType .~ SwaggerString } ]
519− , _operationTags = [ "todo" ] } }) ] } }
474+ & basePath ?~ "/"
475+ & schemes ?~ [Http]
476+ & info .~ (mempty
477+ & version .~ "1.0"
478+ & title .~ "Todo API"
479+ & license ?~ License "MIT" (Just (URL "http://mit.com"))
480+ & description ?~ "This is a an API that tests servant-swagger support for a Todo API")
481+ & paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)
482+ & at 200 ?~ Inline (mempty
483+ & description .~ "OK"
484+ & schema ?~ Inline (mempty
485+ & type_ .~ SwaggerObject
486+ & example ?~ [aesonQQ|
487+ {
488+ "created": 100,
489+ "description": "get milk"
490+ } |]
491+ & description ?~ "This is some real Todo right here"
492+ & properties .~
493+ [ ("created", Inline $ mempty
494+ & type_ .~ SwaggerInteger
495+ & format ?~ "int32")
496+ , ("description", Inline (mempty & type_ .~ SwaggerString))]))
497+ & produces ?~ MimeList [ "application/json" ]
498+ & parameters .~
499+ [ Inline $ mempty
500+ & required ?~ True
501+ & name .~ "id"
502+ & description ?~ "TodoId param"
503+ & schema .~ ParamOther (mempty
504+ & in_ .~ ParamPath
505+ & type_ .~ SwaggerString ) ]
506+ & tags .~ [ "todo" ] ))
520507
521508swaggerExampleJSON :: Value
522509swaggerExampleJSON = [aesonQQ|