6c0a0ca · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Merge pull request #41 from GetShopTV/make-fields-#39

6c0a0caNickolay Kudasov11 years ago

src/Data/Swagger.hs+49−22

compare with master

unifiedsplit

@@ -33,8 +33,7 @@ module Data.Swagger (

33 Contact(..),

34 License(..),

36− -- ** Paths

36+ -- ** PathItem

37− Paths(..),

38 PathItem(..),

37 PathItem(..),

40 -- ** Operations

39 -- ** Operations

@@ -160,33 +159,61 @@ import Data.Swagger.Internal

160-- $lens

159-- $lens

161--

160--

162-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used

161-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used

163−-- to modify this structure. In combination with @'Monoid'@ instances, lenses

162+-- to work comfortly with it. In combination with @'Monoid'@ instances, lenses

164−-- also make it fairly simple to construct/modify any part of the specification:

163+-- make it fairly simple to construct/modify any part of the specification:

165--

164--

166-- >>> :{

165-- >>> :{

167−-- encode $ mempty & pathsMap .~

166+-- encode $ (mempty :: Swagger)

167+-- & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]

168+-- & paths .~

168−-- [ ("/user", mempty & pathItemGet ?~ (mempty

169+-- [ ("/user", mempty & get ?~ (mempty

169−-- & operationProduces ?~ MimeList ["application/json"]

170+-- & produces ?~ MimeList ["application/json"]

170−-- & operationResponses .~ (mempty

171−-- & responsesResponses . at 200 ?~ Inline (mempty & responseSchema ?~ Ref (Reference "#/definitions/User")))))]

171+-- & at 200 ?~ Inline (mempty & schema ?~ Ref (Reference "User")))) ]

172-- :}

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\"]}}}}"

174--

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@

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

178--

179−-- Since @'ParamSchema'@ is basically the /base schema specification/, a special

179+-- For convenience, @swagger2@ uses /classy field lenses/. It means that

180−-- @'HasParamSchema'@ class has been introduced to generalize @'ParamSchema'@ lenses

180+-- field accessor names can be overloaded for different types. One such

181−-- and allow them to be used by any type that has a @'ParamSchema'@:

181+-- common field is @'description'@. Many components of Swagger specification

182+-- can have descriptions, and you can use the same name for them:

182--

183--

184+-- >>> encode $ (mempty :: Response) & description .~ "No content"

185+-- "{\"description\":\"No content\"}"

183-- >>> :{

186-- >>> :{

184−-- encode $ mempty

187+-- encode $ (mempty :: Schema)

185−-- & schemaTitle ?~ "Email"

188+-- & type_ .~ SwaggerBoolean

186−-- & schemaType .~ SwaggerString

189+-- & description ?~ "To be or not to be"

187−-- & schemaFormat ?~ "email"

188-- :}

190-- :}

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@).

190

217

191-- $schema

218-- $schema

192--

219--

@@ -199,8 +226,8 @@ import Data.Swagger.Internal

199-- with properties in addition to what @'ParamSchema'@ provides.

226-- with properties in addition to what @'ParamSchema'@ provides.

200--

227--

201-- In most cases you will have a Haskell data type for which you would like to

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

229+-- define a corresponding schema. To facilitate this use case

203−-- this library provides two classes for schema encoding.

230+-- @swagger2@ provides two classes for schema encoding.

204-- Both these classes provide means to encode /types/ as Swagger /schemas/.

231-- Both these classes provide means to encode /types/ as Swagger /schemas/.

205--

232--

206-- @'ToParamSchema'@ is intended to be used for primitive API endpoint parameters,

233-- @'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

40data Swagger = Swagger

41 { -- | Provides metadata about the API.

42 -- The metadata can be used by the clients if needed.

43− _info :: Info

43+ _swaggerInfo :: Info

45 -- | The host (name or ip) serving the API. It MAY include a port.

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

49 -- | The base path on which the API is served, which is relative to the host.

50 -- If it is not included, the API is served directly under the host.

51 -- The value MUST start with a leading slash (/).

52− , _basePath :: Maybe FilePath

52+ , _swaggerBasePath :: Maybe FilePath

54 -- | The transfer protocol of the API.

55 -- 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]

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

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

60− , _consumes :: MimeList

60+ , _swaggerConsumes :: MimeList

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

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

64− , _produces :: MimeList

64+ , _swaggerProduces :: MimeList

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

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

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

70− , _definitions :: Definitions Schema

72+ , _swaggerDefinitions :: Definitions Schema

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

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

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

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

74− , _parameters :: Definitions Param

76+ , _swaggerParameters :: Definitions Param

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

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

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

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

78− , _responses :: Definitions Response

80+ , _swaggerResponses :: Definitions Response

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

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

81− , _securityDefinitions :: Definitions SecurityScheme

83+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme

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

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

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

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

85 -- (that is, there is a logical OR between the security requirements).

87 -- (that is, there is a logical OR between the security requirements).

86 -- Individual operations can override this definition.

88 -- Individual operations can override this definition.

87− , _security :: [SecurityRequirement]

89+ , _swaggerSecurity :: [SecurityRequirement]

89 -- | A list of tags used by the specification with additional metadata.

91 -- | A list of tags used by the specification with additional metadata.

90 -- The order of the tags can be used to reflect on their order by the parsing tools.

92 -- The order of the tags can be used to reflect on their order by the parsing tools.

91 -- Not all tags that are used by the Operation Object must be declared.

93 -- Not all tags that are used by the Operation Object must be declared.

92 -- The tags that are not declared may be organized randomly or based on the tools' logic.

94 -- The tags that are not declared may be organized randomly or based on the tools' logic.

93 -- Each tag name in the list MUST be unique.

95 -- Each tag name in the list MUST be unique.

94− , _tags :: [Tag]

96+ , _swaggerTags :: [Tag]

96 -- | Additional external documentation.

98 -- | Additional external documentation.

97− , _externalDocs :: Maybe ExternalDocs

99+ , _swaggerExternalDocs :: Maybe ExternalDocs

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

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

101

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

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

@@ -170,13 +172,6 @@ data Scheme

170 | Wss

172 | Wss

171 deriving (Eq, Show, Generic, Data, Typeable)

173 deriving (Eq, Show, Generic, Data, Typeable)

172

174

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−

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

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

181-- A @'PathItem'@ may be empty, due to ACL constraints.

176-- A @'PathItem'@ may be empty, due to ACL constraints.

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

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

@@ -719,7 +714,7 @@ instance Monoid Info where

719 mempty = genericMempty

714 mempty = genericMempty

720 mappend = genericMappend

715 mappend = genericMappend

721

716

722−instance Monoid Paths where

717+instance Monoid Contact where

723 mempty = genericMempty

718 mempty = genericMempty

724 mappend = genericMappend

719 mappend = genericMappend

725

720

@@ -772,7 +767,6 @@ instance Monoid Example where

772-- =======================================================================

767-- =======================================================================

773

768

774instance SwaggerMonoid Info

769instance SwaggerMonoid Info

775−instance SwaggerMonoid Paths

776instance SwaggerMonoid PathItem

770instance SwaggerMonoid PathItem

777instance SwaggerMonoid Schema

771instance SwaggerMonoid Schema

778instance SwaggerMonoid (ParamSchema t)

772instance SwaggerMonoid (ParamSchema t)

@@ -907,7 +901,7 @@ instance ToJSON SecuritySchemeType where

907 <+> object [ "type" .= ("oauth2" :: Text) ]

901 <+> object [ "type" .= ("oauth2" :: Text) ]

908

902

909instance ToJSON Swagger where

903instance ToJSON Swagger where

910− toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")

904+ toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "swagger")

911 where

905 where

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

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

913 addVersion _ = error "impossible"

907 addVersion _ = error "impossible"

@@ -937,9 +931,6 @@ instance ToJSON Host where

937 Nothing -> host

931 Nothing -> host

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

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

939

933

940−instance ToJSON Paths where

941− toJSON (Paths m) = toJSON m

942−

943instance ToJSON MimeList where

934instance ToJSON MimeList where

944 toJSON (MimeList xs) = toJSON (map show xs)

935 toJSON (MimeList xs) = toJSON (map show xs)

945

936

@@ -1037,7 +1028,7 @@ instance FromJSON Swagger where

1037 parseJSON js@(Object o) = do

1028 parseJSON js@(Object o) = do

1038 (version :: Text) <- o .: "swagger"

1029 (version :: Text) <- o .: "swagger"

1039 when (version /= "2.0") empty

1030 when (version /= "2.0") empty

1040− (genericParseJSON (jsonPrefix "")

1031+ (genericParseJSON (jsonPrefix "swagger")

1041 `withDefaults` [ "consumes" .= (mempty :: MimeList)

1032 `withDefaults` [ "consumes" .= (mempty :: MimeList)

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

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

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

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

@@ -1080,9 +1071,6 @@ instance FromJSON Host where

1080 [host, portStr] = map Text.unpack [hostText, portText]

1071 [host, portStr] = map Text.unpack [hostText, portText]

1081 parseJSON _ = empty

1072 parseJSON _ = empty

1082

1073

1083−instance FromJSON Paths where

1084− parseJSON js = Paths <$> parseJSON js

1085−

1086instance FromJSON MimeList where

1074instance FromJSON MimeList where

1087 parseJSON js = (MimeList . map fromString) <$> parseJSON js

1075 parseJSON js = (MimeList . map fromString) <$> parseJSON js

1088

1076

src/Data/Swagger/Internal/ParamSchema.hs+31−31

@@ -42,8 +42,8 @@ import Data.Swagger.SchemaOptions

42--

43-- instance ToParamSchema Direction where

44-- toParamSchema = mempty

45−-- & schemaType .~ SwaggerString

45+-- & type_ .~ SwaggerString

46−-- & schemaEnum .~ [ \"Up\", \"Down\" ]

46+-- & enum_ .~ [ \"Up\", \"Down\" ]

47-- @

48--

49-- Instead of manually writing your @'ToParamSchema'@ instance you can

@@ -74,23 +74,23 @@ class ToParamSchema a where

74 toParamSchema = genericToParamSchema defaultSchemaOptions

76instance {-# OVERLAPPING #-} ToParamSchema String where

77− toParamSchema _ = mempty & schemaType .~ SwaggerString

77+ toParamSchema _ = mempty & type_ .~ SwaggerString

79instance ToParamSchema Bool where

80− toParamSchema _ = mempty & schemaType .~ SwaggerBoolean

80+ toParamSchema _ = mempty & type_ .~ SwaggerBoolean

82instance ToParamSchema Integer where

83− toParamSchema _ = mempty & schemaType .~ SwaggerInteger

83+ toParamSchema _ = mempty & type_ .~ SwaggerInteger

85instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral

86instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral

87instance ToParamSchema Int16 where toParamSchema = toParamSchemaBoundedIntegral

89instance ToParamSchema Int32 where

90− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int32"

90+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int32"

92instance ToParamSchema Int64 where

93− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int64"

93+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int64"

95instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral

96instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral

@@ -104,52 +104,52 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral

104-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"

105toParamSchemaBoundedIntegral :: forall proxy a t. (Bounded a, Integral a) => proxy a -> ParamSchema t

106toParamSchemaBoundedIntegral _ = mempty

107− & schemaType .~ SwaggerInteger

107+ & type_ .~ SwaggerInteger

108− & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))

108+ & minimum_ ?~ fromInteger (toInteger (minBound :: a))

109− & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))

109+ & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

110

111instance ToParamSchema Char where

112 toParamSchema _ = mempty

113− & schemaType .~ SwaggerString

113+ & type_ .~ SwaggerString

114− & schemaMaxLength ?~ 1

114+ & maxLength ?~ 1

115− & schemaMinLength ?~ 1

115+ & minLength ?~ 1

116

117instance ToParamSchema Scientific where

118− toParamSchema _ = mempty & schemaType .~ SwaggerNumber

118+ toParamSchema _ = mempty & type_ .~ SwaggerNumber

119

120instance ToParamSchema Double where

121 toParamSchema _ = mempty

122− & schemaType .~ SwaggerNumber

122+ & type_ .~ SwaggerNumber

123− & schemaFormat ?~ "double"

123+ & format ?~ "double"

124

125instance ToParamSchema Float where

126 toParamSchema _ = mempty

127− & schemaType .~ SwaggerNumber

127+ & type_ .~ SwaggerNumber

128− & schemaFormat ?~ "float"

128+ & format ?~ "float"

129

130timeParamSchema :: String -> ParamSchema t

131−timeParamSchema format = mempty

131+timeParamSchema fmt = mempty

132− & schemaType .~ SwaggerString

132+ & type_ .~ SwaggerString

133− & schemaFormat ?~ T.pack format

133+ & format ?~ T.pack fmt

134

135-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

136instance ToParamSchema Day where

137 toParamSchema _ = timeParamSchema "date"

138

139-- |

140−-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. schemaFormat

140+-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format

141-- Just "yyyy-mm-ddThh:MM:ss"

142instance ToParamSchema LocalTime where

143 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss"

144

145-- |

146−-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat

146+-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format

147-- Just "yyyy-mm-ddThh:MM:ss+hhMM"

148instance ToParamSchema ZonedTime where

149 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"

150

151-- |

152−-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. schemaFormat

152+-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format

153-- Just "yyyy-mm-ddThh:MM:ssZ"

154instance ToParamSchema UTCTime where

155 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ssZ"

@@ -173,12 +173,12 @@ instance ToParamSchema a => ToParamSchema (Dual a) where toParamSchema _ = to

173

174instance ToParamSchema a => ToParamSchema [a] where

175 toParamSchema _ = mempty

176− & schemaType .~ SwaggerArray

176+ & type_ .~ SwaggerArray

177− & schemaItems ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))

177+ & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))

178

179instance ToParamSchema a => ToParamSchema (Set a) where

180 toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

181− & schemaUniqueItems ?~ True

181+ & uniqueItems ?~ True

182

183instance ToParamSchema a => ToParamSchema (HashSet a) where

184 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))

@@ -188,8 +188,8 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where

188-- "{\"type\":\"string\",\"enum\":[\"_\"]}"

189instance ToParamSchema () where

190 toParamSchema _ = mempty

191− & schemaType .~ SwaggerString

191+ & type_ .~ SwaggerString

192− & schemaEnum ?~ ["_"]

192+ & enum_ ?~ ["_"]

193

194-- | A configurable generic @'ParamSchema'@ creator.

195--

@@ -226,8 +226,8 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)

226

227instance Constructor c => GEnumParamSchema (C1 c U1) where

228 genumParamSchema opts _ s = s

229− & schemaType .~ SwaggerString

229+ & type_ .~ SwaggerString

230− & schemaEnum %~ addEnumValue tag

230+ & enum_ %~ addEnumValue tag

231 where

232 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

233

src/Data/Swagger/Internal/Schema.hs+36−36

@@ -76,12 +76,12 @@ rename name (NamedSchema _ schema) = NamedSchema name schema

76-- declareNamedSchema = pure (Just \"Coord\", schema)

77-- where

78-- schema = mempty

79−-- & schemaType .~ SwaggerObject

79+-- & type_ .~ SwaggerObject

80−-- & schemaProperties .~

80+-- & properties .~

81-- [ (\"x\", toSchemaRef (Proxy :: Proxy Double))

82-- , (\"y\", toSchemaRef (Proxy :: Proxy Double))

83-- ]

84−-- & schemaRequired .~ [ \"x\", \"y\" ]

84+-- & required .~ [ \"x\", \"y\" ]

85-- @

86--

87-- Instead of manually writing your @'ToSchema'@ instance you can

@@ -117,14 +117,14 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema

117

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

119--

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

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

121-- Nothing

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

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

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

124--

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

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

126-- Just "Day"

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

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

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

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

130toNamedSchema = undeclare . declareNamedSchema

@@ -262,8 +262,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where

262 declareNamedSchema _ = do

263 ref <- declareSchemaRef (Proxy :: Proxy a)

264 return $ unnamed $ mempty

265− & schemaType .~ SwaggerArray

265+ & type_ .~ SwaggerArray

266− & schemaItems ?~ SwaggerItemsObject ref

266+ & items ?~ SwaggerItemsObject ref

267

268instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema

269instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema

@@ -300,16 +300,16 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f

300instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)

301

302timeSchema :: T.Text -> Schema

303−timeSchema format = mempty

303+timeSchema fmt = mempty

304− & schemaType .~ SwaggerString

304+ & type_ .~ SwaggerString

305− & schemaFormat ?~ format

305+ & format ?~ fmt

306

307-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

308instance ToSchema Day where

309 declareNamedSchema _ = pure $ named "Day" (timeSchema "date")

310

311-- |

312−-- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat

312+-- >>> toSchema (Proxy :: Proxy LocalTime) ^. format

313-- Just "yyyy-mm-ddThh:MM:ss"

314instance ToSchema LocalTime where

315 declareNamedSchema _ = pure $ named "LocalTime" (timeSchema "yyyy-mm-ddThh:MM:ss")

@@ -322,7 +322,7 @@ instance ToSchema NominalDiffTime where

322 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)

323

324-- |

325−-- >>> toSchema (Proxy :: Proxy UTCTime) ^. schemaFormat

325+-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format

326-- Just "yyyy-mm-ddThh:MM:ssZ"

327instance ToSchema UTCTime where

328 declareNamedSchema _ = pure $ named "UTCTime" (timeSchema "yyyy-mm-ddThh:MM:ssZ")

@@ -340,8 +340,8 @@ instance ToSchema a => ToSchema (Map String a) where

340 declareNamedSchema _ = do

341 schema <- declareSchema (Proxy :: Proxy a)

342 return $ unnamed $ mempty

343− & schemaType .~ SwaggerObject

343+ & type_ .~ SwaggerObject

344− & schemaAdditionalProperties ?~ schema

344+ & additionalProperties ?~ schema

345

346instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))

347instance 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

354 declareNamedSchema _ = do

355 schema <- declareSchema (Proxy :: Proxy [a])

356 return $ unnamed $ schema

357− & schemaUniqueItems ?~ True

357+ & uniqueItems ?~ True

358

359instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))

360

@@ -373,9 +373,9 @@ instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname

373-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"

374toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema

375toSchemaBoundedIntegral _ = mempty

376− & schemaType .~ SwaggerInteger

376+ & type_ .~ SwaggerInteger

377− & schemaMinimum ?~ fromInteger (toInteger (minBound :: a))

377+ & minimum_ ?~ fromInteger (toInteger (minBound :: a))

378− & schemaMaximum ?~ fromInteger (toInteger (maxBound :: a))

378+ & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

379

380-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.

381genericToNamedSchemaBoundedIntegral :: forall a d f proxy.

@@ -411,13 +411,13 @@ paramSchemaToNamedSchema opts proxy = NamedSchema (gdatatypeSchemaName opts (Pro

411

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

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

414−paramSchemaToSchema _ = mempty & schemaParamSchema .~ toParamSchema (Proxy :: Proxy a)

414+paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)

415

416nullarySchema :: Schema

417nullarySchema = mempty

418− & schemaType .~ SwaggerArray

418+ & type_ .~ SwaggerArray

419− & schemaEnum ?~ [ toJSON () ]

419+ & enum_ ?~ [ toJSON () ]

420− & schemaItems ?~ SwaggerItemsArray []

420+ & items ?~ SwaggerItemsArray []

421

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

423gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

@@ -446,7 +446,7 @@ instance (Selector s, GToSchema f) => GToSchema (C1 c (S1 s f)) where

446 gdeclareNamedSchema opts _ s

447 | unwrapUnaryRecords opts = fieldSchema

448 | otherwise =

449− case schema ^. schemaItems of

449+ case schema ^. items of

450 Just (SwaggerItemsArray [_]) -> fieldSchema

451 _ -> do

452 declare defs

@@ -487,13 +487,13 @@ withFieldSchema opts _ isRequiredField schema = do

487 return $

488 if T.null fname

489 then schema

490− & schemaType .~ SwaggerArray

490+ & type_ .~ SwaggerArray

491− & schemaItems %~ appendItem ref

491+ & items %~ appendItem ref

492 else schema

493− & schemaType .~ SwaggerObject

493+ & type_ .~ SwaggerObject

494− & schemaProperties . at fname ?~ ref

494+ & properties . at fname ?~ ref

495 & if isRequiredField

496− then schemaRequired %~ (fname :)

496+ then required %~ (fname :)

497 else id

498 where

499 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))

@@ -524,8 +524,8 @@ gdeclareNamedSumSchema opts proxy s

524 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)

525

526 toStringTag schema = mempty

527− & schemaType .~ SwaggerString

527+ & type_ .~ SwaggerString

528− & schemaEnum ?~ map toJSON (schema ^.. schemaProperties.ifolded.asIndex)

528+ & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)

529

530type AllNullary = All

531

@@ -540,10 +540,10 @@ gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>

540gsumConToSchema opts _ schema = do

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

542 return $ schema

543− & schemaType .~ SwaggerObject

543+ & type_ .~ SwaggerObject

544− & schemaProperties . at tag ?~ ref

544+ & properties . at tag ?~ ref

545− & schemaMaxProperties ?~ 1

545+ & maxProperties ?~ 1

546− & schemaMinProperties ?~ 1

546+ & minProperties ?~ 1

547 where

548 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

549

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

@@ -8,6 +8,8 @@ module Data.Swagger.Internal.Utils where

9import Control.Arrow (first)

10import Control.Applicative

11+import Control.Lens ((&), (%~))

12+import Control.Lens.TH

11import Data.Aeson

13import Data.Aeson

12import Data.Aeson.Types

14import Data.Aeson.Types

13import Data.Char

15import Data.Char

@@ -19,8 +21,28 @@ import Data.Map (Map)

19import Data.Monoid

21import Data.Monoid

20import Data.Text (Text)

22import Data.Text (Text)

21import GHC.Generics

23import GHC.Generics

24+import Language.Haskell.TH (mkName)

22import Text.Read (readMaybe)

25import Text.Read (readMaybe)

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+

24gunfoldEnum :: String -> [a] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a

46gunfoldEnum :: String -> [a] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a

25gunfoldEnum tname xs _k z c = case lookup (constrIndex c) (zip [1..] xs) of

47gunfoldEnum tname xs _k z c = case lookup (constrIndex c) (zip [1..] xs) of

26 Just x -> z x

48 Just x -> z x

src/Data/Swagger/Lens.hs+93−102

@@ -1,50 +1,50 @@

1+{-# LANGUAGE FlexibleContexts #-}

1{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE FunctionalDependencies #-}

3{-# LANGUAGE FunctionalDependencies #-}

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE GADTs #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE RankNTypes #-}

6{-# LANGUAGE RankNTypes #-}

6{-# LANGUAGE TemplateHaskell #-}

7{-# LANGUAGE TemplateHaskell #-}

8+{-# LANGUAGE TypeFamilies #-}

9+{-# LANGUAGE UndecidableInstances #-}

7module Data.Swagger.Lens where

10module Data.Swagger.Lens where

9import Control.Lens

12import Control.Lens

10import Data.Aeson (Value)

13import Data.Aeson (Value)

11import Data.Scientific (Scientific)

14import Data.Scientific (Scientific)

12import Data.Swagger.Internal

15import Data.Swagger.Internal

16+import Data.Swagger.Internal.Utils

13import Data.Text (Text)

17import Data.Text (Text)

15−-- =======================================================================

16−-- * TH derived lenses

19+-- * Classy lenses

17−

20+

18−-- ** 'Swagger' lenses

21+makeFields ''Swagger

19−makeLenses ''Swagger

22+makeFields ''Host

20−-- ** 'Host' lenses

23+makeFields ''Info

21−makeLenses ''Host

24+makeFields ''Contact

22−-- ** 'Info' lenses

25+makeFields ''License

23−makeLenses ''Info

26+makeFields ''PathItem

24−-- ** 'Contact' lenses

27+makeFields ''Tag

25−makeLenses ''Contact

28+makeFields ''Operation

26−-- ** 'License' lenses

29+makeFields ''Param

27−makeLenses ''License

30+makeLensesWith swaggerFieldRules ''ParamOtherSchema

28−-- ** 'Paths' lenses

31+makeFields ''Header

29−makeLenses ''Paths

32+makeFields ''Schema

30−-- ** 'PathItem' lenses

33+makeFields ''NamedSchema

31−makeLenses ''PathItem

34+makeLensesWith swaggerFieldRules ''ParamSchema

32−-- ** 'Tag' lenses

35+makeFields ''Xml

33−makeLenses ''Tag

36+makeLensesWith swaggerFieldRules ''Responses

34−-- ** 'Operation' lenses

37+makeFields ''Response

35−makeLenses ''Operation

38+makeLensesWith swaggerFieldRules ''SecurityScheme

36−-- ** 'Param' lenses

39+makeFields ''ApiKeyParams

37−makeLenses ''Param

40+makeFields ''OAuth2Params

41+makeFields ''ExternalDocs

42+

43+-- * Prisms

38-- ** 'ParamAnySchema' prisms

44-- ** 'ParamAnySchema' prisms

39makePrisms ''ParamAnySchema

45makePrisms ''ParamAnySchema

40−-- ** 'ParamOtherSchema' lenses

46+-- ** 'SecuritySchemeType' prisms

41−makeLenses ''ParamOtherSchema

47+makePrisms ''SecuritySchemeType

42−-- ** 'Header' lenses

43−makeLenses ''Header

44−-- ** 'Schema' lenses

45−makeLenses ''Schema

46−-- ** 'NamedSchema' lenses

47−makeLenses ''NamedSchema

49-- ** 'SwaggerItems' prisms

@@ -65,95 +65,86 @@ _SwaggerItemsObject

65_SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) => Optic' p f (SwaggerItems t) (Maybe (CollectionFormat t), ParamSchema t)

66_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)

68−-- ** 'ParamSchema' lenses

68+-- =============================================================

69−makeLenses ''ParamSchema

69+-- More helpful instances for easier access to schema properties

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

90−class HasDescription s d | s -> d where

71+type instance Index Responses = HttpStatusCode

91− description :: Lens' s d

72+type instance Index Operation = HttpStatusCode

93−instance HasDescription Response Text where description = responseDescription

74+type instance IxValue Responses = Referenced Response

94−instance HasDescription Info (Maybe Text) where description = infoDescription

75+type instance IxValue Operation = Referenced Response

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

102

103−class HasParamSchema s t | s -> t where

77+instance Ixed Responses where ix n = responses . ix n

104− parameterSchema :: Lens' s (ParamSchema t)

78+instance At Responses where at n = responses . at n

105

106−instance HasParamSchema Schema Schema where parameterSchema = schemaParamSchema

80+instance Ixed Operation where ix n = responses . ix n

107−instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema

81+instance At Operation where at n = responses . at n

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

111

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

83+-- HasType instances

113−schemaType = parameterSchema.paramSchemaType

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_

114

115−schemaFormat :: HasParamSchema s t => Lens' s (Maybe Format)

89+-- HasDefault instances

116−schemaFormat = parameterSchema.paramSchemaFormat

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_

117

118−schemaItems :: HasParamSchema s t => Lens' s (Maybe (SwaggerItems t))

94+-- OVERLAPPABLE instances

119−schemaItems = parameterSchema.paramSchemaItems

120

121−schemaDefault :: HasParamSchema s t => Lens' s (Maybe Value)

96+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

122−schemaDefault = parameterSchema.paramSchemaDefault

97+ => HasFormat s (Maybe Format) where

98+ format = paramSchema.format

123

124−schemaMaximum :: HasParamSchema s t => Lens' s (Maybe Scientific)

100+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

125−schemaMaximum = parameterSchema.paramSchemaMaximum

101+ => HasItems s (Maybe (SwaggerItems t)) where

102+ items = paramSchema.items

126

103

127−schemaExclusiveMaximum :: HasParamSchema s t => Lens' s (Maybe Bool)

104+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

128−schemaExclusiveMaximum = parameterSchema.paramSchemaExclusiveMaximum

105+ => HasMaximum s (Maybe Scientific) where

106+ maximum_ = paramSchema.maximum_

129

107

130−schemaMinimum :: HasParamSchema s t => Lens' s (Maybe Scientific)

108+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

131−schemaMinimum = parameterSchema.paramSchemaMinimum

109+ => HasExclusiveMaximum s (Maybe Bool) where

110+ exclusiveMaximum = paramSchema.exclusiveMaximum

132

111

133−schemaExclusiveMinimum :: HasParamSchema s t => Lens' s (Maybe Bool)

112+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

134−schemaExclusiveMinimum = parameterSchema.paramSchemaExclusiveMinimum

113+ => HasMinimum s (Maybe Scientific) where

114+ minimum_ = paramSchema.minimum_

135

115

136−schemaMaxLength :: HasParamSchema s t => Lens' s (Maybe Integer)

116+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

137−schemaMaxLength = parameterSchema.paramSchemaMaxLength

117+ => HasExclusiveMinimum s (Maybe Bool) where

118+ exclusiveMinimum = paramSchema.exclusiveMinimum

138

119

139−schemaMinLength :: HasParamSchema s t => Lens' s (Maybe Integer)

120+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

140−schemaMinLength = parameterSchema.paramSchemaMinLength

121+ => HasMaxLength s (Maybe Integer) where

122+ maxLength = paramSchema.maxLength

141

123

142−schemaPattern :: HasParamSchema s t => Lens' s (Maybe Text)

124+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

143−schemaPattern = parameterSchema.paramSchemaPattern

125+ => HasMinLength s (Maybe Integer) where

126+ minLength = paramSchema.minLength

144

127

145−schemaMaxItems :: HasParamSchema s t => Lens' s (Maybe Integer)

128+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

146−schemaMaxItems = parameterSchema.paramSchemaMaxItems

129+ => HasPattern s (Maybe Text) where

130+ pattern = paramSchema.pattern

147

131

148−schemaMinItems :: HasParamSchema s t => Lens' s (Maybe Integer)

132+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

149−schemaMinItems = parameterSchema.paramSchemaMinItems

133+ => HasMaxItems s (Maybe Integer) where

134+ maxItems = paramSchema.maxItems

150

135

151−schemaUniqueItems :: HasParamSchema s t => Lens' s (Maybe Bool)

136+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

152−schemaUniqueItems = parameterSchema.paramSchemaUniqueItems

137+ => HasMinItems s (Maybe Integer) where

138+ minItems = paramSchema.minItems

153

139

154−schemaEnum :: HasParamSchema s t => Lens' s (Maybe [Value])

140+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

155−schemaEnum = parameterSchema.paramSchemaEnum

141+ => HasUniqueItems s (Maybe Bool) where

142+ uniqueItems = paramSchema.uniqueItems

156

143

157−schemaMultipleOf :: HasParamSchema s t => Lens' s (Maybe Scientific)

144+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)

158−schemaMultipleOf = parameterSchema.paramSchemaMultipleOf

145+ => HasEnum s (Maybe [Value]) where

146+ enum_ = paramSchema.enum_

159

147

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

40 , mtl

41 , network

42 , text

43+ , template-haskell

43 , time

44 , time

44 , unordered-containers

45 , unordered-containers

45 , lens

46 , lens

test/Data/SwaggerSpec.hs+127−140

@@ -13,7 +13,7 @@ import Data.Text (Text)

14import Data.Swagger

15import SpecCommon

16−import Test.Hspec

16+import Test.Hspec hiding (example)

18spec :: Spec

19spec = do

@@ -44,13 +44,13 @@ main = hspec spec

44-- =======================================================================

46infoExample :: Info

47−infoExample = Info

47+infoExample = mempty

48− { _infoTitle = "Swagger Sample App"

48+ & title .~ "Swagger Sample App"

49− , _infoDescription = Just "This is a sample server Petstore server."

49+ & description ?~ "This is a sample server Petstore server."

50− , _infoTermsOfService = Just "http://swagger.io/terms/"

50+ & termsOfService ?~ "http://swagger.io/terms/"

51− , _infoContact = Just contactExample

51+ & contact ?~ contactExample

52− , _infoLicense = Just licenseExample

52+ & license ?~ licenseExample

53− , _infoVersion = "1.0.1" }

53+ & version .~ "1.0.1"

55infoExampleJSON :: Value

56infoExampleJSON = [aesonQQ|

@@ -76,10 +76,10 @@ infoExampleJSON = [aesonQQ|

76-- =======================================================================

78contactExample :: Contact

79−contactExample = Contact

79+contactExample = mempty

80− { _contactName = Just "API Support"

80+ & name ?~ "API Support"

81− , _contactUrl = Just (URL "http://www.swagger.io/support")

81+ & url ?~ URL "http://www.swagger.io/support"

82− , _contactEmail = Just "support@swagger.io" }

82+ & email ?~ "support@swagger.io"

84contactExampleJSON :: Value

85contactExampleJSON = [aesonQQ|

@@ -95,9 +95,7 @@ contactExampleJSON = [aesonQQ|

95-- =======================================================================

97licenseExample :: 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"))

101

102licenseExampleJSON :: Value

100licenseExampleJSON :: Value

103licenseExampleJSON = [aesonQQ|

101licenseExampleJSON = [aesonQQ|

@@ -114,46 +112,39 @@ licenseExampleJSON = [aesonQQ|

114

112

115operationExample :: Operation

113operationExample :: Operation

116operationExample = mempty

114operationExample = mempty

117− { _operationTags = ["pet"]

115+ & tags .~ ["pet"]

118− , _operationSummary = Just "Updates a pet in the store with form data"

116+ & summary ?~ "Updates a pet in the store with form data"

119− , _operationDescription = Just ""

117+ & description ?~ ""

120− , _operationOperationId = Just "updatePetWithForm"

118+ & operationId ?~ "updatePetWithForm"

121− , _operationConsumes = Just (MimeList ["application/x-www-form-urlencoded"])

119+ & consumes ?~ MimeList ["application/x-www-form-urlencoded"]

122− , _operationProduces = Just (MimeList ["application/json", "application/xml"])

120+ & produces ?~ 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

121+ & parameters .~ map Inline

136− [ Param

122+ [ mempty

137− { _paramName = "petId"

123+ & name .~ "petId"

138− , _paramDescription = Just "ID of pet that needs to be updated"

124+ & description ?~ "ID of pet that needs to be updated"

139− , _paramRequired = Just True

125+ & required ?~ True

140− , _paramSchema = ParamOther (stringSchema ParamPath) }

126+ & schema .~ ParamOther (stringSchema ParamPath)

141− , Param

127+ , mempty

142− { _paramName = "name"

128+ & name .~ "name"

143− , _paramDescription = Just "Updated name of the pet"

129+ & description ?~ "Updated name of the pet"

144− , _paramRequired = Just False

130+ & required ?~ False

145− , _paramSchema = ParamOther (stringSchema ParamFormData) }

131+ & schema .~ ParamOther (stringSchema ParamFormData)

146− , Param

132+ , mempty

147− { _paramName = "status"

133+ & name .~ "status"

148− , _paramDescription = Just "Updated status of the pet"

134+ & description ?~ "Updated status of the pet"

149− , _paramRequired = Just False

135+ & required ?~ False

150− , _paramSchema = ParamOther (stringSchema ParamFormData) }

136+ & schema .~ ParamOther (stringSchema ParamFormData)

151 ]

137 ]

152

138

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

153 stringSchema :: ParamLocation -> ParamOtherSchema

144 stringSchema :: ParamLocation -> ParamOtherSchema

154− stringSchema i = mempty

145+ stringSchema loc = mempty

155− & paramOtherSchemaIn .~ i

146+ & in_ .~ loc

156− & schemaType .~ SwaggerString

147+ & type_ .~ SwaggerString

157

148

158operationExampleJSON :: Value

149operationExampleJSON :: Value

159operationExampleJSON = [aesonQQ|

150operationExampleJSON = [aesonQQ|

@@ -219,8 +210,8 @@ operationExampleJSON = [aesonQQ|

219

210

220schemaPrimitiveExample :: Schema

211schemaPrimitiveExample :: Schema

221schemaPrimitiveExample = mempty

212schemaPrimitiveExample = mempty

222− & schemaType .~ SwaggerString

213+ & type_ .~ SwaggerString

223− & schemaFormat ?~ "email"

214+ & format ?~ "email"

224

215

225schemaPrimitiveExampleJSON :: Value

216schemaPrimitiveExampleJSON :: Value

226schemaPrimitiveExampleJSON = [aesonQQ|

217schemaPrimitiveExampleJSON = [aesonQQ|

@@ -232,15 +223,15 @@ schemaPrimitiveExampleJSON = [aesonQQ|

232

223

233schemaSimpleModelExample :: Schema

224schemaSimpleModelExample :: Schema

234schemaSimpleModelExample = mempty

225schemaSimpleModelExample = mempty

235− & schemaType .~ SwaggerObject

226+ & type_ .~ SwaggerObject

236− & schemaRequired .~ [ "name" ]

227+ & required .~ [ "name" ]

237− & schemaProperties .~

228+ & properties .~

238− [ ("name", Inline (mempty & schemaType .~ SwaggerString))

229+ [ ("name", Inline (mempty & type_ .~ SwaggerString))

239 , ("address", Ref (Reference "Address"))

230 , ("address", Ref (Reference "Address"))

240 , ("age", Inline $ mempty

231 , ("age", Inline $ mempty

241− & schemaMinimum ?~ 0

232+ & minimum_ ?~ 0

242− & schemaType .~ SwaggerInteger

233+ & type_ .~ SwaggerInteger

243− & schemaFormat ?~ "int32" ) ]

234+ & format ?~ "int32" ) ]

244

235

245schemaSimpleModelExampleJSON :: Value

236schemaSimpleModelExampleJSON :: Value

246schemaSimpleModelExampleJSON = [aesonQQ|

237schemaSimpleModelExampleJSON = [aesonQQ|

@@ -267,8 +258,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|

267

258

268schemaModelDictExample :: Schema

259schemaModelDictExample :: Schema

269schemaModelDictExample = mempty

260schemaModelDictExample = mempty

270− & schemaType .~ SwaggerObject

261+ & type_ .~ SwaggerObject

271− & schemaAdditionalProperties ?~ (mempty & schemaType .~ SwaggerString)

262+ & additionalProperties ?~ (mempty & type_ .~ SwaggerString)

272

263

273schemaModelDictExampleJSON :: Value

264schemaModelDictExampleJSON :: Value

274schemaModelDictExampleJSON = [aesonQQ|

265schemaModelDictExampleJSON = [aesonQQ|

@@ -281,19 +272,21 @@ schemaModelDictExampleJSON = [aesonQQ|

281|]

272|]

282

273

283schemaWithExampleExample :: Schema

274schemaWithExampleExample :: Schema

284−schemaWithExampleExample = (mempty & schemaType .~ SwaggerObject)

275+schemaWithExampleExample = mempty

285− { _schemaProperties =

276+ & type_ .~ SwaggerObject

277+ & properties .~

286 [ ("id", Inline $ mempty

278 [ ("id", Inline $ mempty

287− & schemaType .~ SwaggerInteger

279+ & type_ .~ SwaggerInteger

288− & schemaFormat ?~ "int64" )

280+ & format ?~ "int64" )

289− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ]

281+ , ("name", Inline $ mempty

290− , _schemaRequired = [ "name" ]

282+ & type_ .~ SwaggerString) ]

291− , _schemaExample = Just [aesonQQ|

283+ & required .~ [ "name" ]

284+ & example ?~ [aesonQQ|

292− {

285+ {

293− "name": "Puma",

286+ "name": "Puma",

294− "id": 1

287+ "id": 1

295− }

288+ }

296− |] }

289+ |]

297

290

298schemaWithExampleExampleJSON :: Value

291schemaWithExampleExampleJSON :: Value

299schemaWithExampleExampleJSON = [aesonQQ|

292schemaWithExampleExampleJSON = [aesonQQ|

@@ -325,19 +318,19 @@ schemaWithExampleExampleJSON = [aesonQQ|

325definitionsExample :: HashMap Text Schema

318definitionsExample :: HashMap Text Schema

326definitionsExample =

319definitionsExample =

327 [ ("Category", mempty

320 [ ("Category", mempty

328− & schemaType .~ SwaggerObject

321+ & type_ .~ SwaggerObject

329− & schemaProperties .~

322+ & properties .~

330 [ ("id", Inline $ mempty

323 [ ("id", Inline $ mempty

331− & schemaType .~ SwaggerInteger

324+ & type_ .~ SwaggerInteger

332− & schemaFormat ?~ "int64")

325+ & format ?~ "int64")

333− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] )

326+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] )

334 , ("Tag", mempty

327 , ("Tag", mempty

335− & schemaType .~ SwaggerObject

328+ & type_ .~ SwaggerObject

336− & schemaProperties .~

329+ & properties .~

337 [ ("id", Inline $ mempty

330 [ ("id", Inline $ mempty

338− & schemaType .~ SwaggerInteger

331+ & type_ .~ SwaggerInteger

339− & schemaFormat ?~ "int64")

332+ & format ?~ "int64")

340− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] ) ]

333+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] ) ]

341

334

342definitionsExampleJSON :: Value

335definitionsExampleJSON :: Value

343definitionsExampleJSON = [aesonQQ|

336definitionsExampleJSON = [aesonQQ|

@@ -376,21 +369,21 @@ definitionsExampleJSON = [aesonQQ|

376paramsDefinitionExample :: HashMap Text Param

369paramsDefinitionExample :: HashMap Text Param

377paramsDefinitionExample =

370paramsDefinitionExample =

378 [ ("skipParam", mempty

371 [ ("skipParam", mempty

379− { _paramName = "skip"

372+ & name .~ "skip"

380− , _paramDescription = Just "number of items to skip"

373+ & description ?~ "number of items to skip"

381− , _paramRequired = Just True

374+ & required ?~ True

382− , _paramSchema = ParamOther $ mempty

375+ & schema .~ ParamOther (mempty

383− & paramOtherSchemaIn .~ ParamQuery

376+ & in_ .~ ParamQuery

384− & schemaType .~ SwaggerInteger

377+ & type_ .~ SwaggerInteger

385− & schemaFormat ?~ "int32" })

378+ & format ?~ "int32" ))

386 , ("limitParam", mempty

379 , ("limitParam", mempty

387− { _paramName = "limit"

380+ & name .~ "limit"

388− , _paramDescription = Just "max records to return"

381+ & description ?~ "max records to return"

389− , _paramRequired = Just True

382+ & required ?~ True

390− , _paramSchema = ParamOther $ mempty

383+ & schema .~ ParamOther (mempty

391− & paramOtherSchemaIn .~ ParamQuery

384+ & in_ .~ ParamQuery

392− & schemaType .~ SwaggerInteger

385+ & type_ .~ SwaggerInteger

393− & schemaFormat ?~ "int32" }) ]

386+ & format ?~ "int32" )) ]

394

387

395paramsDefinitionExampleJSON :: Value

388paramsDefinitionExampleJSON :: Value

396paramsDefinitionExampleJSON = [aesonQQ|

389paramsDefinitionExampleJSON = [aesonQQ|

@@ -420,8 +413,8 @@ paramsDefinitionExampleJSON = [aesonQQ|

420

413

421responsesDefinitionExample :: HashMap Text Response

414responsesDefinitionExample :: HashMap Text Response

422responsesDefinitionExample =

415responsesDefinitionExample =

423− [ ("NotFound", mempty { _responseDescription = "Entity not found." })

416+ [ ("NotFound", mempty & description .~ "Entity not found.")

424− , ("IllegalInput", mempty { _responseDescription = "Illegal input for operation." }) ]

417+ , ("IllegalInput", mempty & description .~ "Illegal input for operation.") ]

425

418

426responsesDefinitionExampleJSON :: Value

419responsesDefinitionExampleJSON :: Value

427responsesDefinitionExampleJSON = [aesonQQ|

420responsesDefinitionExampleJSON = [aesonQQ|

@@ -478,45 +471,39 @@ securityDefinitionsExampleJSON = [aesonQQ|

478

471

479swaggerExample :: Swagger

472swaggerExample :: Swagger

480swaggerExample = mempty

473swaggerExample = mempty

481− { _basePath = Just "/"

474+ & basePath ?~ "/"

482− , _schemes = Just [Http]

475+ & schemes ?~ [Http]

483− , _info = mempty

476+ & info .~ (mempty

484− { _infoVersion = "1.0"

477+ & version .~ "1.0"

485− , _infoTitle = "Todo API"

478+ & title .~ "Todo API"

486− , _infoLicense = Just License

487− { _licenseName = "MIT"

488− , _licenseUrl = Just (URL "http://mit.com") }

479+ & license ?~ License "MIT" (Just (URL "http://mit.com"))

489− , _infoDescription = Just "This is a an API that tests servant-swagger support for a Todo API" }

480+ & description ?~ "This is a an API that tests servant-swagger support for a Todo API")

490− , _paths = mempty

491− { _pathsMap =

492− [ ("/todo/{id}", mempty

481+ & paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)

493− { _pathItemGet = Just mempty

494− { _operationResponses = mempty

495− { _responsesResponses =

496− [ (200, Inline mempty

482+ & at 200 ?~ Inline (mempty

497− { _responseSchema = Just $ Inline (mempty & schemaType .~ SwaggerObject)

483+ & description .~ "OK"

498− { _schemaExample = Just [aesonQQ|

484+ & schema ?~ Inline (mempty

485+ & type_ .~ SwaggerObject

486+ & example ?~ [aesonQQ|

499− {

487+ {

500− "created": 100,

488+ "created": 100,

501− "description": "get milk"

489+ "description": "get milk"

502− } |]

490+ } |]

503− , _schemaDescription = Just "This is some real Todo right here"

491+ & description ?~ "This is some real Todo right here"

504− , _schemaProperties =

492+ & properties .~

505− [ ("created", Inline $ mempty

493+ [ ("created", Inline $ mempty

506− & schemaType .~ SwaggerInteger

494+ & type_ .~ SwaggerInteger

507− & schemaFormat ?~ "int32")

495+ & format ?~ "int32")

508− , ("description", Inline (mempty & schemaType .~ SwaggerString)) ] }

496+ , ("description", Inline (mempty & type_ .~ SwaggerString))]))

509− , _responseDescription = "OK" }) ] }

510− , _operationProduces = Just (MimeList [ "application/json" ])

497+ & produces ?~ MimeList [ "application/json" ]

511− , _operationParameters =

498+ & parameters .~

512− [ Inline mempty

499+ [ Inline $ mempty

513− { _paramRequired = Just True

500+ & required ?~ True

514− , _paramName = "id"

501+ & name .~ "id"

515− , _paramDescription = Just "TodoId param"

502+ & description ?~ "TodoId param"

516− , _paramSchema = ParamOther $ mempty

503+ & schema .~ ParamOther (mempty

517− & paramOtherSchemaIn .~ ParamPath

504+ & in_ .~ ParamPath

518− & schemaType .~ SwaggerString } ]

505+ & type_ .~ SwaggerString ) ]

519− , _operationTags = [ "todo" ] } }) ] } }

506+ & tags .~ [ "todo" ] ))

520

507

521swaggerExampleJSON :: Value

508swaggerExampleJSON :: Value

522swaggerExampleJSON = [aesonQQ|

509swaggerExampleJSON = [aesonQQ|