diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,21 +1,14 @@
-
+# servant-swagger
-
- This project converts servant APIs into Swagger 2.0 conforming JSON.
-
+[](https://travis-ci.org/haskell-servant/servant-swagger)
+[](http://hackage.haskell.org/package/servant-swagger)
+[](http://stackage.org/lts/package/servant-swagger)
+[](http://stackage.org/nightly/package/servant-swagger)
-
- 
-
+This project converts [servant](https://github.com/haskell-servant/servant) APIs into Swagger 2.0 specification.
+
+
Given the following `servant` API, `servant-swagger` generates the following json.
@@ -153,10 +146,6 @@
Many Swagger tools, including server and client code generation for many languages, can be found on
[Swagger's Tools and Integrations page](http://swagger.io/open-source-integrations/).
-
-## FAQ
-- Q: How is this project different from the `swagger` package on `hackage` ?
- - A: This package is based on the latest Swagger 2.0 API
## Contributing
diff --git a/example/example.cabal b/example/example.cabal
--- a/example/example.cabal
+++ b/example/example.cabal
@@ -40,3 +40,16 @@
, servant-swagger
, lens
default-language: Haskell2010
+
+executable readme
+ main-is: README.lhs
+ ghc-options: -Wall -pgmL markdown-unlit
+ build-depends: base >=4.7 && <4.9
+ , aeson
+ , bytestring
+ , lens
+ , markdown-unlit
+ , servant-server
+ , servant-swagger
+ , swagger2
+ default-language: Haskell2010
diff --git a/servant-swagger.cabal b/servant-swagger.cabal
--- a/servant-swagger.cabal
+++ b/servant-swagger.cabal
@@ -1,5 +1,5 @@
name: servant-swagger
-version: 0.1
+version: 0.1.1
synopsis: Generate Swagger specification for your servant API.
description: Please see README.md
homepage: https://github.com/dmjio/servant-swagger
@@ -56,4 +56,3 @@
other-modules:
Servant.SwaggerSpec
default-language: Haskell2010
-
diff --git a/src/Servant/Swagger/Internal.hs b/src/Servant/Swagger/Internal.hs
--- a/src/Servant/Swagger/Internal.hs
+++ b/src/Servant/Swagger/Internal.hs
@@ -17,6 +17,7 @@
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List (dropWhileEnd)
+import Data.Maybe (mapMaybe)
import Data.Monoid
import Data.Proxy
import qualified Data.Swagger as Swagger
@@ -24,6 +25,7 @@
import Data.Swagger.Declare
import Data.Text (Text)
import qualified Data.Text as Text
+import Data.Traversable (sequenceA)
import GHC.TypeLits
import GHC.Exts
import Network.HTTP.Media (MediaType)
@@ -38,10 +40,26 @@
-- | All operations of sub API.
subOperations :: forall sub api. (IsSubAPI sub api, HasSwagger sub) =>
Proxy sub -> Proxy api -> Traversal' Swagger Operation
-subOperations sub _ = paths.pathsMap.itraversed.indices (`elem` ps).template
+subOperations sub _ = paths.pathsMap.itraversed.withIndex.subops
where
- ps = toSwagger sub ^. paths.pathsMap.to HashMap.keys
+ -- | Traverse operations that correspond to paths and methods of the sub API.
+ subops :: Traversal' (FilePath, PathItem) Operation
+ subops f (path, item) = case HashMap.lookup path subpaths of
+ Just subitem -> (,) path <$> methodsOf subitem f item
+ Nothing -> pure (path, item)
+ -- | Paths of the sub API.
+ subpaths :: HashMap FilePath PathItem
+ subpaths = toSwagger sub ^. paths.pathsMap
+
+ -- | Traverse operations that exist in a given @'PathItem'@
+ -- This is used to traverse only the operations that exist in sub API.
+ methodsOf :: PathItem -> Traversal' PathItem Operation
+ methodsOf pathItem = partsOf template . itraversed . indices (`elem` ns) . _Just
+ where
+ ops = pathItem ^.. template :: [Maybe Operation]
+ ns = mapMaybe (fmap fst . sequenceA) $ zip [0..] ops
+
-- | Tag an operation.
addTag :: TagName -> Operation -> Operation
addTag tag = operationTags %~ (tag:)
@@ -274,7 +292,7 @@
& paramName .~ Text.pack name
& paramSchema .~ ParamOther (mempty
& paramOtherSchemaIn .~ ParamHeader
- & parameterSchema .~ toParamSchema (Proxy :: Proxy Bool))
+ & parameterSchema .~ toParamSchema (Proxy :: Proxy a))
instance (ToSchema a, AllAccept cs, HasSwagger sub) => HasSwagger (ReqBody cs a :> sub) where
toSwagger _ = toSwagger (Proxy :: Proxy sub)
diff --git a/test/Servant/SwaggerSpec.hs b/test/Servant/SwaggerSpec.hs
--- a/test/Servant/SwaggerSpec.hs
+++ b/test/Servant/SwaggerSpec.hs
@@ -31,6 +31,7 @@
spec = describe "HasSwagger" $ do
it "Todo API" $ checkAPI (Proxy :: Proxy TodoAPI) todoAPI
it "Hackage API (with tags)" $ checkSwagger hackageSwaggerWithTags hackageAPI
+ it "GetPost API (test subOperations)" $ checkSwagger getPostSwagger getPostAPI
main :: IO ()
main = hspec spec
@@ -316,6 +317,65 @@
{
"name":"packages",
"description":"Query packages"
+ }
+ ]
+}
+|]
+
+
+-- =======================================================================
+-- Get/Post API (test for subOperations)
+-- =======================================================================
+
+type GetPostAPI = Get '[JSON] String :<|> Post '[JSON] String
+
+getPostSwagger :: Swagger
+getPostSwagger = toSwagger (Proxy :: Proxy GetPostAPI)
+ & getOps %~ addTag "get"
+ & tags .~
+ [ Tag "get" (Just "GET operations") Nothing ]
+ where
+ getOps = subOperations (Proxy :: Proxy (Get '[JSON] String)) (Proxy :: Proxy GetPostAPI)
+
+getPostAPI :: Value
+getPostAPI = [aesonQQ|
+{
+ "swagger":"2.0",
+ "info":{
+ "version":"",
+ "title":""
+ },
+ "paths":{
+ "/":{
+ "post":{
+ "responses":{
+ "201":{
+ "schema":{
+ "type":"string"
+ },
+ "description":""
+ }
+ },
+ "produces":[ "application/json" ]
+ },
+ "get":{
+ "responses":{
+ "200":{
+ "schema":{
+ "type":"string"
+ },
+ "description":""
+ }
+ },
+ "produces":[ "application/json" ],
+ "tags":[ "get" ]
+ }
+ }
+ },
+ "tags":[
+ {
+ "name":"get",
+ "description":"GET operations"
}
]
}
-
-