git.iko.soy/typeable/openapi3
on master help sign in
Switch to classy field lenses
40e2208Nickolay Kudasov
src/Data/Swagger.hs+11−12
compare with master
unifiedsplit
@@ -33,8 +33,7 @@ module Data.Swagger (
33 Contact(..),
33 Contact(..),
34 License(..),
34 License(..),
35
35
36− -- ** Paths
36+ -- ** PathItem
37− Paths(..),
38 PathItem(..),
37 PathItem(..),
39
38
40 -- ** Operations
39 -- ** Operations
@@ -164,13 +163,13 @@ import Data.Swagger.Internal
164-- also make it fairly simple to construct/modify any part of the specification:
163-- also make it fairly simple to construct/modify any part of the specification:
165--
164--
166-- >>> :{
165-- >>> :{
167−-- encode $ mempty & pathsMap .~
166+-- encode $ (mempty :: Swagger) & paths .~
168−-- [ ("/user", mempty & pathItemGet ?~ (mempty
167+-- [ ("/user", mempty & get ?~ (mempty
169−-- & operationProduces ?~ MimeList ["application/json"]
168+-- & produces ?~ MimeList ["application/json"]
170−-- & operationResponses .~ (mempty
169+-- & responses .~ (mempty
171−-- & responsesResponses . at 200 ?~ Inline (mempty & responseSchema ?~ Ref (Reference "#/definitions/User")))))]
170+-- & responses . at 200 ?~ Inline (mempty & schema ?~ Ref (Reference "#/definitions/User")))))]
172-- :}
171-- :}
173−-- "{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/#/definitions/User\"},\"description\":\"\"}},\"produces\":[\"application/json\"]}}}"
172+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/#/definitions/User\"},\"description\":\"\"}},\"produces\":[\"application/json\"]}}}}"
174--
173--
175-- In the snippet above we declare API paths with a single path @/user@ providing method @GET@
174-- In the snippet above we declare API paths with a single path @/user@ providing method @GET@
176-- which produces @application/json@ output and should respond with code @200@ and body specified
175-- which produces @application/json@ output and should respond with code @200@ and body specified
@@ -181,10 +180,10 @@ import Data.Swagger.Internal
181-- and allow them to be used by any type that has a @'ParamSchema'@:
180-- and allow them to be used by any type that has a @'ParamSchema'@:
182--
181--
183-- >>> :{
182-- >>> :{
184−-- encode $ mempty
183+-- encode $ (mempty :: Schema)
185−-- & schemaTitle ?~ "Email"
184+-- & title ?~ "Email"
186−-- & schemaType .~ SwaggerString
185+-- & type_ .~ SwaggerString
187−-- & schemaFormat ?~ "email"
186+-- & format ?~ "email"
188-- :}
187-- :}
189-- "{\"format\":\"email\",\"title\":\"Email\",\"type\":\"string\"}"
188-- "{\"format\":\"email\",\"title\":\"Email\",\"type\":\"string\"}"
190
189
src/Data/Swagger/Internal.hs+18−34
@@ -40,61 +40,63 @@ type Definitions = HashMap Text
40data Swagger = Swagger
40data Swagger = Swagger
41 { -- | Provides metadata about the API.
41 { -- | Provides metadata about the API.
42 -- The metadata can be used by the clients if needed.
42 -- The metadata can be used by the clients if needed.
43− _info :: Info
43+ _swaggerInfo :: Info
44
44
45 -- | The host (name or ip) serving the API. It MAY include a port.
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).
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
48
48
49 -- | The base path on which the API is served, which is relative to the 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.
50 -- If it is not included, the API is served directly under the host.
51 -- The value MUST start with a leading slash (/).
51 -- The value MUST start with a leading slash (/).
52− , _basePath :: Maybe FilePath
52+ , _swaggerBasePath :: Maybe FilePath
53
53
54 -- | The transfer protocol of the API.
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.
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]
57
57
58 -- | A list of MIME types the APIs can consume.
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.
59 -- This is global to all APIs but can be overridden on specific API calls.
60− , _consumes :: MimeList
60+ , _swaggerConsumes :: MimeList
61
61
62 -- | A list of MIME types the APIs can produce.
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.
63 -- This is global to all APIs but can be overridden on specific API calls.
64− , _produces :: MimeList
64+ , _swaggerProduces :: MimeList
65
65
66 -- | The available paths and operations for the API.
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
68
70
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
71
73
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
75
77
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
79
81
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
82
84
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]
88
90
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]
95
97
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)
99
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,10 +714,6 @@ instance Monoid Info where
719 mempty = genericMempty
714 mempty = genericMempty
720 mappend = genericMappend
715 mappend = genericMappend
721
716
722−instance Monoid Paths where
723− mempty = genericMempty
724− mappend = genericMappend
725−
726instance Monoid PathItem where
717instance Monoid PathItem where
727 mempty = genericMempty
718 mempty = genericMempty
728 mappend = genericMappend
719 mappend = genericMappend
@@ -772,7 +763,6 @@ instance Monoid Example where
772-- =======================================================================
763-- =======================================================================
773
764
774instance SwaggerMonoid Info
765instance SwaggerMonoid Info
775−instance SwaggerMonoid Paths
776instance SwaggerMonoid PathItem
766instance SwaggerMonoid PathItem
777instance SwaggerMonoid Schema
767instance SwaggerMonoid Schema
778instance SwaggerMonoid (ParamSchema t)
768instance SwaggerMonoid (ParamSchema t)
@@ -907,7 +897,7 @@ instance ToJSON SecuritySchemeType where
907 <+> object [ "type" .= ("oauth2" :: Text) ]
897 <+> object [ "type" .= ("oauth2" :: Text) ]
908
898
909instance ToJSON Swagger where
899instance ToJSON Swagger where
910− toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "")
900+ toJSON = omitEmpties . addVersion . genericToJSON (jsonPrefix "swagger")
911 where
901 where
912 addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
902 addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
913 addVersion _ = error "impossible"
903 addVersion _ = error "impossible"
@@ -937,9 +927,6 @@ instance ToJSON Host where
937 Nothing -> host
927 Nothing -> host
938 Just port -> host ++ ":" ++ show port
928 Just port -> host ++ ":" ++ show port
939
929
940−instance ToJSON Paths where
941− toJSON (Paths m) = toJSON m
942−
943instance ToJSON MimeList where
930instance ToJSON MimeList where
944 toJSON (MimeList xs) = toJSON (map show xs)
931 toJSON (MimeList xs) = toJSON (map show xs)
945
932
@@ -1037,7 +1024,7 @@ instance FromJSON Swagger where
1037 parseJSON js@(Object o) = do
1024 parseJSON js@(Object o) = do
1038 (version :: Text) <- o .: "swagger"
1025 (version :: Text) <- o .: "swagger"
1039 when (version /= "2.0") empty
1026 when (version /= "2.0") empty
1040− (genericParseJSON (jsonPrefix "")
1027+ (genericParseJSON (jsonPrefix "swagger")
1041 `withDefaults` [ "consumes" .= (mempty :: MimeList)
1028 `withDefaults` [ "consumes" .= (mempty :: MimeList)
1042 , "produces" .= (mempty :: MimeList)
1029 , "produces" .= (mempty :: MimeList)
1043 , "security" .= ([] :: [SecurityRequirement])
1030 , "security" .= ([] :: [SecurityRequirement])
@@ -1080,9 +1067,6 @@ instance FromJSON Host where
1080 [host, portStr] = map Text.unpack [hostText, portText]
1067 [host, portStr] = map Text.unpack [hostText, portText]
1081 parseJSON _ = empty
1068 parseJSON _ = empty
1082
1069
1083−instance FromJSON Paths where
1084− parseJSON js = Paths <$> parseJSON js
1085−
1086instance FromJSON MimeList where
1070instance FromJSON MimeList where
1087 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1071 parseJSON js = (MimeList . map fromString) <$> parseJSON js
1088
1072
src/Data/Swagger/Internal/ParamSchema.hs+31−31
@@ -42,8 +42,8 @@ import Data.Swagger.SchemaOptions
42--
42--
43-- instance ToParamSchema Direction where
43-- instance ToParamSchema Direction where
44-- toParamSchema = mempty
44-- toParamSchema = mempty
45−-- & schemaType .~ SwaggerString
45+-- & type_ .~ SwaggerString
46−-- & schemaEnum .~ [ \"Up\", \"Down\" ]
46+-- & enum_ .~ [ \"Up\", \"Down\" ]
47-- @
47-- @
48--
48--
49-- Instead of manually writing your @'ToParamSchema'@ instance you can
49-- Instead of manually writing your @'ToParamSchema'@ instance you can
@@ -74,23 +74,23 @@ class ToParamSchema a where
74 toParamSchema = genericToParamSchema defaultSchemaOptions
74 toParamSchema = genericToParamSchema defaultSchemaOptions
75
75
76instance {-# OVERLAPPING #-} ToParamSchema String where
76instance {-# OVERLAPPING #-} ToParamSchema String where
77− toParamSchema _ = mempty & schemaType .~ SwaggerString
77+ toParamSchema _ = mempty & type_ .~ SwaggerString
78
78
79instance ToParamSchema Bool where
79instance ToParamSchema Bool where
80− toParamSchema _ = mempty & schemaType .~ SwaggerBoolean
80+ toParamSchema _ = mempty & type_ .~ SwaggerBoolean
81
81
82instance ToParamSchema Integer where
82instance ToParamSchema Integer where
83− toParamSchema _ = mempty & schemaType .~ SwaggerInteger
83+ toParamSchema _ = mempty & type_ .~ SwaggerInteger
84
84
85instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
85instance ToParamSchema Int where toParamSchema = toParamSchemaBoundedIntegral
86instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
86instance ToParamSchema Int8 where toParamSchema = toParamSchemaBoundedIntegral
87instance ToParamSchema Int16 where toParamSchema = toParamSchemaBoundedIntegral
87instance ToParamSchema Int16 where toParamSchema = toParamSchemaBoundedIntegral
88
88
89instance ToParamSchema Int32 where
89instance ToParamSchema Int32 where
90− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int32"
90+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int32"
91
91
92instance ToParamSchema Int64 where
92instance ToParamSchema Int64 where
93− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int64"
93+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int64"
94
94
95instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
95instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
96instance ToParamSchema Word8 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\"}"
104-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
105toParamSchemaBoundedIntegral :: forall proxy a t. (Bounded a, Integral a) => proxy a -> ParamSchema t
105toParamSchemaBoundedIntegral :: forall proxy a t. (Bounded a, Integral a) => proxy a -> ParamSchema t
106toParamSchemaBoundedIntegral _ = mempty
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
110
111instance ToParamSchema Char where
111instance ToParamSchema Char where
112 toParamSchema _ = mempty
112 toParamSchema _ = mempty
113− & schemaType .~ SwaggerString
113+ & type_ .~ SwaggerString
114− & schemaMaxLength ?~ 1
114+ & maxLength ?~ 1
115− & schemaMinLength ?~ 1
115+ & minLength ?~ 1
116
116
117instance ToParamSchema Scientific where
117instance ToParamSchema Scientific where
118− toParamSchema _ = mempty & schemaType .~ SwaggerNumber
118+ toParamSchema _ = mempty & type_ .~ SwaggerNumber
119
119
120instance ToParamSchema Double where
120instance ToParamSchema Double where
121 toParamSchema _ = mempty
121 toParamSchema _ = mempty
122− & schemaType .~ SwaggerNumber
122+ & type_ .~ SwaggerNumber
123− & schemaFormat ?~ "double"
123+ & format ?~ "double"
124
124
125instance ToParamSchema Float where
125instance ToParamSchema Float where
126 toParamSchema _ = mempty
126 toParamSchema _ = mempty
127− & schemaType .~ SwaggerNumber
127+ & type_ .~ SwaggerNumber
128− & schemaFormat ?~ "float"
128+ & format ?~ "float"
129
129
130timeParamSchema :: String -> ParamSchema t
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
134
135-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
135-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
136instance ToParamSchema Day where
136instance ToParamSchema Day where
137 toParamSchema _ = timeParamSchema "date"
137 toParamSchema _ = timeParamSchema "date"
138
138
139-- |
139-- |
140−-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
140+-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format
141-- Just "yyyy-mm-ddThh:MM:ss"
141-- Just "yyyy-mm-ddThh:MM:ss"
142instance ToParamSchema LocalTime where
142instance ToParamSchema LocalTime where
143 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss"
143 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss"
144
144
145-- |
145-- |
146−-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat
146+-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
147-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
147-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
148instance ToParamSchema ZonedTime where
148instance ToParamSchema ZonedTime where
149 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
149 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
150
150
151-- |
151-- |
152−-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
152+-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
153-- Just "yyyy-mm-ddThh:MM:ssZ"
153-- Just "yyyy-mm-ddThh:MM:ssZ"
154instance ToParamSchema UTCTime where
154instance ToParamSchema UTCTime where
155 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ssZ"
155 toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ssZ"
@@ -173,12 +173,12 @@ instance ToParamSchema a => ToParamSchema (Dual a) where toParamSchema _ = to
173
173
174instance ToParamSchema a => ToParamSchema [a] where
174instance ToParamSchema a => ToParamSchema [a] where
175 toParamSchema _ = mempty
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
178
179instance ToParamSchema a => ToParamSchema (Set a) where
179instance ToParamSchema a => ToParamSchema (Set a) where
180 toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
180 toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
181− & schemaUniqueItems ?~ True
181+ & uniqueItems ?~ True
182
182
183instance ToParamSchema a => ToParamSchema (HashSet a) where
183instance ToParamSchema a => ToParamSchema (HashSet a) where
184 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
184 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
@@ -188,8 +188,8 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
188-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
188-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
189instance ToParamSchema () where
189instance ToParamSchema () where
190 toParamSchema _ = mempty
190 toParamSchema _ = mempty
191− & schemaType .~ SwaggerString
191+ & type_ .~ SwaggerString
192− & schemaEnum ?~ ["_"]
192+ & enum_ ?~ ["_"]
193
193
194-- | A configurable generic @'ParamSchema'@ creator.
194-- | A configurable generic @'ParamSchema'@ creator.
195--
195--
@@ -226,8 +226,8 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
226
226
227instance Constructor c => GEnumParamSchema (C1 c U1) where
227instance Constructor c => GEnumParamSchema (C1 c U1) where
228 genumParamSchema opts _ s = s
228 genumParamSchema opts _ s = s
229− & schemaType .~ SwaggerString
229+ & type_ .~ SwaggerString
230− & schemaEnum %~ addEnumValue tag
230+ & enum_ %~ addEnumValue tag
231 where
231 where
232 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
232 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
233
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)
76-- declareNamedSchema = pure (Just \"Coord\", schema)
77-- where
77-- where
78-- schema = mempty
78-- schema = mempty
79−-- & schemaType .~ SwaggerObject
79+-- & type_ .~ SwaggerObject
80−-- & schemaProperties .~
80+-- & properties .~
81-- [ (\"x\", toSchemaRef (Proxy :: Proxy Double))
81-- [ (\"x\", toSchemaRef (Proxy :: Proxy Double))
82-- , (\"y\", toSchemaRef (Proxy :: Proxy Double))
82-- , (\"y\", toSchemaRef (Proxy :: Proxy Double))
83-- ]
83-- ]
84−-- & schemaRequired .~ [ \"x\", \"y\" ]
84+-- & required .~ [ \"x\", \"y\" ]
85-- @
85-- @
86--
86--
87-- Instead of manually writing your @'ToSchema'@ instance you can
87-- Instead of manually writing your @'ToSchema'@ instance you can
@@ -117,14 +117,14 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
117
117
118-- | Convert a type into an optionally named schema.
118-- | Convert a type into an optionally named schema.
119--
119--
120−-- >>> toNamedSchema (Proxy :: Proxy String) ^. namedSchemaName
120+-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
121-- Nothing
121-- Nothing
122−-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. namedSchemaSchema)
122+-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
123-- "{\"type\":\"string\"}"
123-- "{\"type\":\"string\"}"
124--
124--
125−-- >>> toNamedSchema (Proxy :: Proxy Day) ^. namedSchemaName
125+-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
126-- Just "Day"
126-- Just "Day"
127−-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. namedSchemaSchema)
127+-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
128-- "{\"format\":\"date\",\"type\":\"string\"}"
128-- "{\"format\":\"date\",\"type\":\"string\"}"
129toNamedSchema :: ToSchema a => proxy a -> NamedSchema
129toNamedSchema :: ToSchema a => proxy a -> NamedSchema
130toNamedSchema = undeclare . declareNamedSchema
130toNamedSchema = undeclare . declareNamedSchema
@@ -262,8 +262,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
262 declareNamedSchema _ = do
262 declareNamedSchema _ = do
263 ref <- declareSchemaRef (Proxy :: Proxy a)
263 ref <- declareSchemaRef (Proxy :: Proxy a)
264 return $ unnamed $ mempty
264 return $ unnamed $ mempty
265− & schemaType .~ SwaggerArray
265+ & type_ .~ SwaggerArray
266− & schemaItems ?~ SwaggerItemsObject ref
266+ & items ?~ SwaggerItemsObject ref
267
267
268instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
268instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
269instance ToSchema Bool 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)
300instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
301
301
302timeSchema :: T.Text -> Schema
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
306
307-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
307-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
308instance ToSchema Day where
308instance ToSchema Day where
309 declareNamedSchema _ = pure $ named "Day" (timeSchema "date")
309 declareNamedSchema _ = pure $ named "Day" (timeSchema "date")
310
310
311-- |
311-- |
312−-- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat
312+-- >>> toSchema (Proxy :: Proxy LocalTime) ^. format
313-- Just "yyyy-mm-ddThh:MM:ss"
313-- Just "yyyy-mm-ddThh:MM:ss"
314instance ToSchema LocalTime where
314instance ToSchema LocalTime where
315 declareNamedSchema _ = pure $ named "LocalTime" (timeSchema "yyyy-mm-ddThh:MM:ss")
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)
322 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)
323
323
324-- |
324-- |
325−-- >>> toSchema (Proxy :: Proxy UTCTime) ^. schemaFormat
325+-- >>> toSchema (Proxy :: Proxy UTCTime) ^. format
326-- Just "yyyy-mm-ddThh:MM:ssZ"
326-- Just "yyyy-mm-ddThh:MM:ssZ"
327instance ToSchema UTCTime where
327instance ToSchema UTCTime where
328 declareNamedSchema _ = pure $ named "UTCTime" (timeSchema "yyyy-mm-ddThh:MM:ssZ")
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
340 declareNamedSchema _ = do
341 schema <- declareSchema (Proxy :: Proxy a)
341 schema <- declareSchema (Proxy :: Proxy a)
342 return $ unnamed $ mempty
342 return $ unnamed $ mempty
343− & schemaType .~ SwaggerObject
343+ & type_ .~ SwaggerObject
344− & schemaAdditionalProperties ?~ schema
344+ & additionalProperties ?~ schema
345
345
346instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
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))
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
354 declareNamedSchema _ = do
355 schema <- declareSchema (Proxy :: Proxy [a])
355 schema <- declareSchema (Proxy :: Proxy [a])
356 return $ unnamed $ schema
356 return $ unnamed $ schema
357− & schemaUniqueItems ?~ True
357+ & uniqueItems ?~ True
358
358
359instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
359instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
360
360
@@ -373,9 +373,9 @@ instance ToSchema a => ToSchema (Dual a) where declareNamedSchema _ = unname
373-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
373-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
374toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
374toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema
375toSchemaBoundedIntegral _ = mempty
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
379
380-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
380-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
381genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
381genericToNamedSchemaBoundedIntegral :: forall a d f proxy.
@@ -411,13 +411,13 @@ paramSchemaToNamedSchema opts proxy = NamedSchema (gdatatypeSchemaName opts (Pro
411
411
412-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
412-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
413paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> 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
415
416nullarySchema :: Schema
416nullarySchema :: Schema
417nullarySchema = mempty
417nullarySchema = mempty
418− & schemaType .~ SwaggerArray
418+ & type_ .~ SwaggerArray
419− & schemaEnum ?~ [ toJSON () ]
419+ & enum_ ?~ [ toJSON () ]
420− & schemaItems ?~ SwaggerItemsArray []
420+ & items ?~ SwaggerItemsArray []
421
421
422gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
422gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema
423gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
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
446 gdeclareNamedSchema opts _ s
447 | unwrapUnaryRecords opts = fieldSchema
447 | unwrapUnaryRecords opts = fieldSchema
448 | otherwise =
448 | otherwise =
449− case schema ^. schemaItems of
449+ case schema ^. items of
450 Just (SwaggerItemsArray [_]) -> fieldSchema
450 Just (SwaggerItemsArray [_]) -> fieldSchema
451 _ -> do
451 _ -> do
452 declare defs
452 declare defs
@@ -487,13 +487,13 @@ withFieldSchema opts _ isRequiredField schema = do
487 return $
487 return $
488 if T.null fname
488 if T.null fname
489 then schema
489 then schema
490− & schemaType .~ SwaggerArray
490+ & type_ .~ SwaggerArray
491− & schemaItems %~ appendItem ref
491+ & items %~ appendItem ref
492 else schema
492 else schema
493− & schemaType .~ SwaggerObject
493+ & type_ .~ SwaggerObject
494− & schemaProperties . at fname ?~ ref
494+ & properties . at fname ?~ ref
495 & if isRequiredField
495 & if isRequiredField
496− then schemaRequired %~ (fname :)
496+ then required %~ (fname :)
497 else id
497 else id
498 where
498 where
499 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
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)
524 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
525
525
526 toStringTag schema = mempty
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
529
530type AllNullary = All
530type AllNullary = All
531
531
@@ -540,10 +540,10 @@ gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>
540gsumConToSchema opts _ schema = do
540gsumConToSchema opts _ schema = do
541 ref <- gdeclareSchemaRef opts (Proxy :: Proxy (C1 c f))
541 ref <- gdeclareSchemaRef opts (Proxy :: Proxy (C1 c f))
542 return $ schema
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
547 where
548 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
548 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
549
549
src/Data/Swagger/Internal/Utils.hs+22
@@ -8,6 +8,8 @@ module Data.Swagger.Internal.Utils where
8
8
9import Control.Arrow (first)
9import Control.Arrow (first)
10import Control.Applicative
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)
23
26
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+78−79
@@ -1,50 +1,51 @@
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 UndecidableInstances #-}
7module Data.Swagger.Lens where
9module Data.Swagger.Lens where
8
10
9import Control.Lens
11import Control.Lens
10import Data.Aeson (Value)
12import Data.Aeson (Value)
11import Data.Scientific (Scientific)
13import Data.Scientific (Scientific)
12import Data.Swagger.Internal
14import Data.Swagger.Internal
15+import Data.Swagger.Internal.Utils
13import Data.Text (Text)
16import Data.Text (Text)
14
17
15-- =======================================================================
18-- =======================================================================
16-- * TH derived lenses
19-- * TH derived lenses
17
20
18-- ** 'Swagger' lenses
21-- ** 'Swagger' lenses
19−makeLenses ''Swagger
22+makeFields ''Swagger
20-- ** 'Host' lenses
23-- ** 'Host' lenses
21−makeLenses ''Host
24+makeFields ''Host
22-- ** 'Info' lenses
25-- ** 'Info' lenses
23−makeLenses ''Info
26+makeFields ''Info
24-- ** 'Contact' lenses
27-- ** 'Contact' lenses
25−makeLenses ''Contact
28+makeFields ''Contact
26-- ** 'License' lenses
29-- ** 'License' lenses
27−makeLenses ''License
30+makeFields ''License
28−-- ** 'Paths' lenses
29−makeLenses ''Paths
30-- ** 'PathItem' lenses
31-- ** 'PathItem' lenses
31−makeLenses ''PathItem
32+makeFields ''PathItem
32-- ** 'Tag' lenses
33-- ** 'Tag' lenses
33−makeLenses ''Tag
34+makeFields ''Tag
34-- ** 'Operation' lenses
35-- ** 'Operation' lenses
35−makeLenses ''Operation
36+makeFields ''Operation
36-- ** 'Param' lenses
37-- ** 'Param' lenses
37−makeLenses ''Param
38+makeFields ''Param
38-- ** 'ParamAnySchema' prisms
39-- ** 'ParamAnySchema' prisms
39makePrisms ''ParamAnySchema
40makePrisms ''ParamAnySchema
40-- ** 'ParamOtherSchema' lenses
41-- ** 'ParamOtherSchema' lenses
41−makeLenses ''ParamOtherSchema
42+makeLensesWith swaggerFieldRules ''ParamOtherSchema
42-- ** 'Header' lenses
43-- ** 'Header' lenses
43−makeLenses ''Header
44+makeFields ''Header
44-- ** 'Schema' lenses
45-- ** 'Schema' lenses
45−makeLenses ''Schema
46+makeFields ''Schema
46-- ** 'NamedSchema' lenses
47-- ** 'NamedSchema' lenses
47−makeLenses ''NamedSchema
48+makeFields ''NamedSchema
48
49
49-- ** 'SwaggerItems' prisms
50-- ** 'SwaggerItems' prisms
50
51
@@ -66,94 +67,92 @@ _SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) =
66_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)
67_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)
67
68
68-- ** 'ParamSchema' lenses
69-- ** 'ParamSchema' lenses
69−makeLenses ''ParamSchema
70+makeLensesWith swaggerFieldRules ''ParamSchema
70-- ** 'Xml' lenses
71-- ** 'Xml' lenses
71−makeLenses ''Xml
72+makeFields ''Xml
72-- ** 'Responses' lenses
73-- ** 'Responses' lenses
73−makeLenses ''Responses
74+makeLensesWith swaggerFieldRules ''Responses
74-- ** 'Response' lenses
75-- ** 'Response' lenses
75−makeLenses ''Response
76+makeFields ''Response
76-- ** 'SecurityScheme' lenses
77-- ** 'SecurityScheme' lenses
77−makeLenses ''SecurityScheme
78+makeLensesWith swaggerFieldRules ''SecurityScheme
78-- ** 'SecuritySchemeType' prisms
79-- ** 'SecuritySchemeType' prisms
79makePrisms ''SecuritySchemeType
80makePrisms ''SecuritySchemeType
80-- ** 'ApiKeyParams' lenses
81-- ** 'ApiKeyParams' lenses
81−makeLenses ''ApiKeyParams
82+makeFields ''ApiKeyParams
82-- ** 'OAuth2Params' lenses
83-- ** 'OAuth2Params' lenses
83−makeLenses ''OAuth2Params
84+makeFields ''OAuth2Params
84-- ** 'ExternalDocs' lenses
85-- ** 'ExternalDocs' lenses
85−makeLenses ''ExternalDocs
86+makeFields ''ExternalDocs
86
87
87−-- =======================================================================
88+-- =============================================================
88−-- * Helper classy lenses
89+-- More helpful instances for easier access to schema properties
89−
90−class HasDescription s d | s -> d where
91− description :: Lens' s d
92−
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
102−
103−class HasParamSchema s t | s -> t where
104− parameterSchema :: Lens' s (ParamSchema t)
105−
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
111
90
112−schemaType :: HasParamSchema s t => Lens' s (SwaggerType t)
91+-- HasType instances
113−schemaType = parameterSchema.paramSchemaType
92+instance HasType Header (SwaggerType Header) where type_ = paramSchema.type_
93+instance HasType Schema (SwaggerType Schema) where type_ = paramSchema.type_
94+instance HasType NamedSchema (SwaggerType Schema) where type_ = schema.paramSchema.type_
95+instance HasType ParamOtherSchema (SwaggerType ParamOtherSchema) where type_ = paramSchema.type_
114
96
115−schemaFormat :: HasParamSchema s t => Lens' s (Maybe Format)
97+-- HasDefault instances
116−schemaFormat = parameterSchema.paramSchemaFormat
98+instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_
99+instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
100+instance HasDefault ParamOtherSchema (Maybe Value) where default_ = paramSchema.default_
117
101
118−schemaItems :: HasParamSchema s t => Lens' s (Maybe (SwaggerItems t))
102+-- OVERLAPPABLE instances
119−schemaItems = parameterSchema.paramSchemaItems
120
103
121−schemaDefault :: HasParamSchema s t => Lens' s (Maybe Value)
104+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
122−schemaDefault = parameterSchema.paramSchemaDefault
105+ => HasFormat s (Maybe Format) where
106+ format = paramSchema.format
123
107
124−schemaMaximum :: HasParamSchema s t => Lens' s (Maybe Scientific)
108+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
125−schemaMaximum = parameterSchema.paramSchemaMaximum
109+ => HasItems s (Maybe (SwaggerItems t)) where
110+ items = paramSchema.items
126
111
127−schemaExclusiveMaximum :: HasParamSchema s t => Lens' s (Maybe Bool)
112+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
128−schemaExclusiveMaximum = parameterSchema.paramSchemaExclusiveMaximum
113+ => HasMaximum s (Maybe Scientific) where
114+ maximum_ = paramSchema.maximum_
129
115
130−schemaMinimum :: HasParamSchema s t => Lens' s (Maybe Scientific)
116+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
131−schemaMinimum = parameterSchema.paramSchemaMinimum
117+ => HasExclusiveMaximum s (Maybe Bool) where
118+ exclusiveMaximum = paramSchema.exclusiveMaximum
132
119
133−schemaExclusiveMinimum :: HasParamSchema s t => Lens' s (Maybe Bool)
120+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
134−schemaExclusiveMinimum = parameterSchema.paramSchemaExclusiveMinimum
121+ => HasMinimum s (Maybe Scientific) where
122+ minimum_ = paramSchema.minimum_
135
123
136−schemaMaxLength :: HasParamSchema s t => Lens' s (Maybe Integer)
124+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
137−schemaMaxLength = parameterSchema.paramSchemaMaxLength
125+ => HasExclusiveMinimum s (Maybe Bool) where
126+ exclusiveMinimum = paramSchema.exclusiveMinimum
138
127
139−schemaMinLength :: HasParamSchema s t => Lens' s (Maybe Integer)
128+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
140−schemaMinLength = parameterSchema.paramSchemaMinLength
129+ => HasMaxLength s (Maybe Integer) where
130+ maxLength = paramSchema.maxLength
141
131
142−schemaPattern :: HasParamSchema s t => Lens' s (Maybe Text)
132+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
143−schemaPattern = parameterSchema.paramSchemaPattern
133+ => HasMinLength s (Maybe Integer) where
134+ minLength = paramSchema.minLength
144
135
145−schemaMaxItems :: HasParamSchema s t => Lens' s (Maybe Integer)
136+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
146−schemaMaxItems = parameterSchema.paramSchemaMaxItems
137+ => HasPattern s (Maybe Text) where
138+ pattern = paramSchema.pattern
147
139
148−schemaMinItems :: HasParamSchema s t => Lens' s (Maybe Integer)
140+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
149−schemaMinItems = parameterSchema.paramSchemaMinItems
141+ => HasMaxItems s (Maybe Integer) where
142+ maxItems = paramSchema.maxItems
150
143
151−schemaUniqueItems :: HasParamSchema s t => Lens' s (Maybe Bool)
144+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
152−schemaUniqueItems = parameterSchema.paramSchemaUniqueItems
145+ => HasMinItems s (Maybe Integer) where
146+ minItems = paramSchema.minItems
153
147
154−schemaEnum :: HasParamSchema s t => Lens' s (Maybe [Value])
148+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
155−schemaEnum = parameterSchema.paramSchemaEnum
149+ => HasUniqueItems s (Maybe Bool) where
150+ uniqueItems = paramSchema.uniqueItems
156
151
157−schemaMultipleOf :: HasParamSchema s t => Lens' s (Maybe Scientific)
152+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
158−schemaMultipleOf = parameterSchema.paramSchemaMultipleOf
153+ => HasEnum s (Maybe [Value]) where
154+ enum_ = paramSchema.enum_
159
155
156+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
157+ => HasMultipleOf s (Maybe Scientific) where
158+ multipleOf = paramSchema.multipleOf
swagger2.cabal+1
@@ -40,6 +40,7 @@ library
40 , mtl
40 , mtl
41 , network
41 , network
42 , text
42 , text
43+ , template-haskell
43 , time
44 , time
44 , unordered-containers
45 , unordered-containers
45 , lens
46 , lens
test/Data/SwaggerSpec.hs+66−67
@@ -151,9 +151,9 @@ operationExample = mempty
151 ]
151 ]
152
152
153 stringSchema :: ParamLocation -> ParamOtherSchema
153 stringSchema :: ParamLocation -> ParamOtherSchema
154− stringSchema i = mempty
154+ stringSchema loc = mempty
155− & paramOtherSchemaIn .~ i
155+ & in_ .~ loc
156− & schemaType .~ SwaggerString
156+ & type_ .~ SwaggerString
157
157
158operationExampleJSON :: Value
158operationExampleJSON :: Value
159operationExampleJSON = [aesonQQ|
159operationExampleJSON = [aesonQQ|
@@ -219,8 +219,8 @@ operationExampleJSON = [aesonQQ|
219
219
220schemaPrimitiveExample :: Schema
220schemaPrimitiveExample :: Schema
221schemaPrimitiveExample = mempty
221schemaPrimitiveExample = mempty
222− & schemaType .~ SwaggerString
222+ & type_ .~ SwaggerString
223− & schemaFormat ?~ "email"
223+ & format ?~ "email"
224
224
225schemaPrimitiveExampleJSON :: Value
225schemaPrimitiveExampleJSON :: Value
226schemaPrimitiveExampleJSON = [aesonQQ|
226schemaPrimitiveExampleJSON = [aesonQQ|
@@ -232,15 +232,15 @@ schemaPrimitiveExampleJSON = [aesonQQ|
232
232
233schemaSimpleModelExample :: Schema
233schemaSimpleModelExample :: Schema
234schemaSimpleModelExample = mempty
234schemaSimpleModelExample = mempty
235− & schemaType .~ SwaggerObject
235+ & type_ .~ SwaggerObject
236− & schemaRequired .~ [ "name" ]
236+ & required .~ [ "name" ]
237− & schemaProperties .~
237+ & properties .~
238− [ ("name", Inline (mempty & schemaType .~ SwaggerString))
238+ [ ("name", Inline (mempty & type_ .~ SwaggerString))
239 , ("address", Ref (Reference "Address"))
239 , ("address", Ref (Reference "Address"))
240 , ("age", Inline $ mempty
240 , ("age", Inline $ mempty
241− & schemaMinimum ?~ 0
241+ & minimum_ ?~ 0
242− & schemaType .~ SwaggerInteger
242+ & type_ .~ SwaggerInteger
243− & schemaFormat ?~ "int32" ) ]
243+ & format ?~ "int32" ) ]
244
244
245schemaSimpleModelExampleJSON :: Value
245schemaSimpleModelExampleJSON :: Value
246schemaSimpleModelExampleJSON = [aesonQQ|
246schemaSimpleModelExampleJSON = [aesonQQ|
@@ -267,8 +267,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
267
267
268schemaModelDictExample :: Schema
268schemaModelDictExample :: Schema
269schemaModelDictExample = mempty
269schemaModelDictExample = mempty
270− & schemaType .~ SwaggerObject
270+ & type_ .~ SwaggerObject
271− & schemaAdditionalProperties ?~ (mempty & schemaType .~ SwaggerString)
271+ & additionalProperties ?~ (mempty & type_ .~ SwaggerString)
272
272
273schemaModelDictExampleJSON :: Value
273schemaModelDictExampleJSON :: Value
274schemaModelDictExampleJSON = [aesonQQ|
274schemaModelDictExampleJSON = [aesonQQ|
@@ -281,12 +281,12 @@ schemaModelDictExampleJSON = [aesonQQ|
281|]
281|]
282
282
283schemaWithExampleExample :: Schema
283schemaWithExampleExample :: Schema
284−schemaWithExampleExample = (mempty & schemaType .~ SwaggerObject)
284+schemaWithExampleExample = (mempty & type_ .~ SwaggerObject)
285 { _schemaProperties =
285 { _schemaProperties =
286 [ ("id", Inline $ mempty
286 [ ("id", Inline $ mempty
287− & schemaType .~ SwaggerInteger
287+ & type_ .~ SwaggerInteger
288− & schemaFormat ?~ "int64" )
288+ & format ?~ "int64" )
289− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ]
289+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ]
290 , _schemaRequired = [ "name" ]
290 , _schemaRequired = [ "name" ]
291 , _schemaExample = Just [aesonQQ|
291 , _schemaExample = Just [aesonQQ|
292 {
292 {
@@ -325,19 +325,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
325definitionsExample :: HashMap Text Schema
325definitionsExample :: HashMap Text Schema
326definitionsExample =
326definitionsExample =
327 [ ("Category", mempty
327 [ ("Category", mempty
328− & schemaType .~ SwaggerObject
328+ & type_ .~ SwaggerObject
329− & schemaProperties .~
329+ & properties .~
330 [ ("id", Inline $ mempty
330 [ ("id", Inline $ mempty
331− & schemaType .~ SwaggerInteger
331+ & type_ .~ SwaggerInteger
332− & schemaFormat ?~ "int64")
332+ & format ?~ "int64")
333− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] )
333+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] )
334 , ("Tag", mempty
334 , ("Tag", mempty
335− & schemaType .~ SwaggerObject
335+ & type_ .~ SwaggerObject
336− & schemaProperties .~
336+ & properties .~
337 [ ("id", Inline $ mempty
337 [ ("id", Inline $ mempty
338− & schemaType .~ SwaggerInteger
338+ & type_ .~ SwaggerInteger
339− & schemaFormat ?~ "int64")
339+ & format ?~ "int64")
340− , ("name", Inline (mempty & schemaType .~ SwaggerString)) ] ) ]
340+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] ) ]
341
341
342definitionsExampleJSON :: Value
342definitionsExampleJSON :: Value
343definitionsExampleJSON = [aesonQQ|
343definitionsExampleJSON = [aesonQQ|
@@ -380,17 +380,17 @@ paramsDefinitionExample =
380 , _paramDescription = Just "number of items to skip"
380 , _paramDescription = Just "number of items to skip"
381 , _paramRequired = Just True
381 , _paramRequired = Just True
382 , _paramSchema = ParamOther $ mempty
382 , _paramSchema = ParamOther $ mempty
383− & paramOtherSchemaIn .~ ParamQuery
383+ & in_ .~ ParamQuery
384− & schemaType .~ SwaggerInteger
384+ & type_ .~ SwaggerInteger
385− & schemaFormat ?~ "int32" })
385+ & format ?~ "int32" })
386 , ("limitParam", mempty
386 , ("limitParam", mempty
387 { _paramName = "limit"
387 { _paramName = "limit"
388 , _paramDescription = Just "max records to return"
388 , _paramDescription = Just "max records to return"
389 , _paramRequired = Just True
389 , _paramRequired = Just True
390 , _paramSchema = ParamOther $ mempty
390 , _paramSchema = ParamOther $ mempty
391− & paramOtherSchemaIn .~ ParamQuery
391+ & in_ .~ ParamQuery
392− & schemaType .~ SwaggerInteger
392+ & type_ .~ SwaggerInteger
393− & schemaFormat ?~ "int32" }) ]
393+ & format ?~ "int32" }) ]
394
394
395paramsDefinitionExampleJSON :: Value
395paramsDefinitionExampleJSON :: Value
396paramsDefinitionExampleJSON = [aesonQQ|
396paramsDefinitionExampleJSON = [aesonQQ|
@@ -478,45 +478,44 @@ securityDefinitionsExampleJSON = [aesonQQ|
478
478
479swaggerExample :: Swagger
479swaggerExample :: Swagger
480swaggerExample = mempty
480swaggerExample = mempty
481− { _basePath = Just "/"
481+ { _swaggerBasePath = Just "/"
482− , _schemes = Just [Http]
482+ , _swaggerSchemes = Just [Http]
483− , _info = mempty
483+ , _swaggerInfo = mempty
484 { _infoVersion = "1.0"
484 { _infoVersion = "1.0"
485 , _infoTitle = "Todo API"
485 , _infoTitle = "Todo API"
486 , _infoLicense = Just License
486 , _infoLicense = Just License
487 { _licenseName = "MIT"
487 { _licenseName = "MIT"
488 , _licenseUrl = Just (URL "http://mit.com") }
488 , _licenseUrl = Just (URL "http://mit.com") }
489 , _infoDescription = Just "This is a an API that tests servant-swagger support for a Todo API" }
489 , _infoDescription = Just "This is a an API that tests servant-swagger support for a Todo API" }
490− , _paths = mempty
490+ , _swaggerPaths =
491− { _pathsMap =
491+ [ ("/todo/{id}", mempty
492− [ ("/todo/{id}", mempty
493− { _pathItemGet = Just mempty
492+ { _pathItemGet = Just mempty
494− { _operationResponses = mempty
493+ { _operationResponses = mempty
495− { _responsesResponses =
494+ { _responsesResponses =
496− [ (200, Inline mempty
495+ [ (200, Inline mempty
497− { _responseSchema = Just $ Inline (mempty & schemaType .~ SwaggerObject)
496+ { _responseSchema = Just $ Inline (mempty & type_ .~ SwaggerObject)
498− { _schemaExample = Just [aesonQQ|
497+ { _schemaExample = Just [aesonQQ|
499− {
498+ {
500− "created": 100,
499+ "created": 100,
501− "description": "get milk"
500+ "description": "get milk"
502− } |]
501+ } |]
503− , _schemaDescription = Just "This is some real Todo right here"
502+ , _schemaDescription = Just "This is some real Todo right here"
504− , _schemaProperties =
503+ , _schemaProperties =
505− [ ("created", Inline $ mempty
504+ [ ("created", Inline $ mempty
506− & schemaType .~ SwaggerInteger
505+ & type_ .~ SwaggerInteger
507− & schemaFormat ?~ "int32")
506+ & format ?~ "int32")
508− , ("description", Inline (mempty & schemaType .~ SwaggerString)) ] }
507+ , ("description", Inline (mempty & type_ .~ SwaggerString)) ] }
509− , _responseDescription = "OK" }) ] }
508+ , _responseDescription = "OK" }) ] }
510− , _operationProduces = Just (MimeList [ "application/json" ])
509+ , _operationProduces = Just (MimeList [ "application/json" ])
511− , _operationParameters =
510+ , _operationParameters =
512− [ Inline mempty
511+ [ Inline mempty
513− { _paramRequired = Just True
512+ { _paramRequired = Just True
514− , _paramName = "id"
513+ , _paramName = "id"
515− , _paramDescription = Just "TodoId param"
514+ , _paramDescription = Just "TodoId param"
516− , _paramSchema = ParamOther $ mempty
515+ , _paramSchema = ParamOther $ mempty
517− & paramOtherSchemaIn .~ ParamPath
516+ & in_ .~ ParamPath
518− & schemaType .~ SwaggerString } ]
517+ & type_ .~ SwaggerString } ]
519− , _operationTags = [ "todo" ] } }) ] } }
518+ , _operationTags = [ "todo" ] } }) ] }
520
519
521swaggerExampleJSON :: Value
520swaggerExampleJSON :: Value
522swaggerExampleJSON = [aesonQQ|
521swaggerExampleJSON = [aesonQQ|