Merged in 0.3

This commit is contained in:
Daniel Larsson 2015-01-06 14:29:37 +01:00
commit 330e9abcaa
6 changed files with 102 additions and 46 deletions

6
CHANGELOG.md Normal file
View file

@ -0,0 +1,6 @@
0.3
---
* Add the ability to display multiple responses, with some accompanying `Text` to describe the context in which we get the corresponding JSON.
* Expose the `headers` lens
* Represent an endpoint's path as `[String]` (previously `String`), fixing a corner case where the leading `/` would be missing.

View file

@ -4,7 +4,7 @@
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
Generate API docs for your *servant* webservice. Generate API docs for your *servant* webservice. Feel free to also take a look at [servant-pandoc](https://github.com/mpickering/servant-pandoc) which uses this package to target a broad range of output formats using the excellent **pandoc**.
## Example ## Example

View file

@ -39,6 +39,11 @@ instance ToParam (QueryParam "capital" Bool) where
instance ToSample Greet where instance ToSample Greet where
toSample = Just $ Greet "Hello, haskeller!" toSample = Just $ Greet "Hello, haskeller!"
toSamples =
[ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
, ("If you use ?capital=false", Greet "Hello, haskeller")
]
-- API specification -- API specification
type TestApi = type TestApi =
-- GET /hello/:name?capital={true, false} returns a Greet as JSON -- GET /hello/:name?capital={true, false} returns a Greet as JSON

View file

@ -1,4 +1,3 @@
POST /greet POST /greet
----------- -----------
@ -13,11 +12,19 @@ POST /greet
**Response**: **Response**:
- Status code 201 - Status code 201
- Response body as below. - If you use ?capital=true
``` javascript ``` javascript
{ {
"msg": "Hello, haskeller!" "msg": "HELLO, HASKELLER"
}
```
- If you use ?capital=false
``` javascript
{
"msg": "Hello, haskeller"
} }
``` ```
@ -38,11 +45,19 @@ GET /hello/:name
**Response**: **Response**:
- Status code 200 - Status code 200
- Response body as below. - If you use ?capital=true
``` javascript ``` javascript
{ {
"msg": "Hello, haskeller!" "msg": "HELLO, HASKELLER"
}
```
- If you use ?capital=false
``` javascript
{
"msg": "Hello, haskeller"
} }
``` ```

View file

@ -1,5 +1,5 @@
name: servant-docs name: servant-docs
version: 0.2.1 version: 0.3
synopsis: generate API docs for your servant webservice synopsis: generate API docs for your servant webservice
description: description:
Library for generating API docs from a servant API definition. Library for generating API docs from a servant API definition.
@ -9,13 +9,16 @@ license: BSD3
license-file: LICENSE license-file: LICENSE
author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni
maintainer: alpmestan@gmail.com maintainer: alpmestan@gmail.com
copyright: 2014 Zalora South East Asia Pte Ltd copyright: 2014-2015 Zalora South East Asia Pte Ltd
category: Web category: Web
build-type: Simple build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
tested-with: GHC >= 7.8 tested-with: GHC >= 7.8
homepage: http://haskell-servant.github.io/ homepage: http://haskell-servant.github.io/
Bug-reports: http://github.com/haskell-servant/servant-docs/issues Bug-reports: http://github.com/haskell-servant/servant-docs/issues
extra-source-files:
CHANGELOG.md
README.md
source-repository head source-repository head
type: git type: git
location: http://github.com/haskell-servant/servant-docs.git location: http://github.com/haskell-servant/servant-docs.git

View file

@ -1,10 +1,12 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- | This module lets you get API docs for free. It lets generate -- | This module lets you get API docs for free. It lets generate
@ -83,12 +85,10 @@ module Servant.Docs
( -- * 'HasDocs' class and key functions ( -- * 'HasDocs' class and key functions
HasDocs(..), docs, markdown HasDocs(..), docs, markdown
{- , -- * Serving the documentation
serveDocumentation -}
, -- * Classes you need to implement for your types , -- * Classes you need to implement for your types
ToSample(..) ToSample(..)
, sampleByteString , sampleByteString
, sampleByteStrings
, ToParam(..) , ToParam(..)
, ToCapture(..) , ToCapture(..)
@ -99,7 +99,7 @@ module Servant.Docs
, DocCapture(..), capSymbol, capDesc , DocCapture(..), capSymbol, capDesc
, DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
, Response, respStatus, respBody, defResponse , Response, respStatus, respBody, defResponse
, Action, captures, params, rqbody, response, defAction , Action, captures, headers, params, rqbody, response, defAction
, single , single
, -- * Useful modules when defining your doc printers , -- * Useful modules when defining your doc printers
@ -114,6 +114,7 @@ import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Hashable import Data.Hashable
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import Data.List import Data.List
import Data.Maybe (listToMaybe)
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import Data.Text (Text, pack, unpack) import Data.Text (Text, pack, unpack)
@ -123,6 +124,7 @@ import GHC.TypeLits
import Servant.API import Servant.API
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
-- | Supported HTTP request methods -- | Supported HTTP request methods
data Method = DocDELETE -- ^ the DELETE method data Method = DocDELETE -- ^ the DELETE method
@ -148,19 +150,26 @@ instance Hashable Method
-- @ -- @
-- λ> 'defEndpoint' -- λ> 'defEndpoint'
-- GET / -- GET /
-- λ> 'defEndpoint' & 'path' '<>~' "foo" -- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
-- GET /foo -- GET /foo
-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST' -- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
-- POST /foo -- POST /foo
-- @ -- @
data Endpoint = Endpoint data Endpoint = Endpoint
{ _path :: String -- type collected { _path :: [String] -- type collected
, _method :: Method -- type collected , _method :: Method -- type collected
} deriving (Eq, Generic) } deriving (Eq, Generic)
instance Show Endpoint where instance Show Endpoint where
show (Endpoint p m) = show (Endpoint p m) =
show m ++ " " ++ p show m ++ " " ++ showPath p
-- |
-- Render a path as a '/'-delimited string
--
showPath :: [String] -> String
showPath [] = "/"
showPath ps = concatMap ('/' :) ps
-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET' -- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
-- --
@ -169,13 +178,13 @@ instance Show Endpoint where
-- @ -- @
-- λ> 'defEndpoint' -- λ> 'defEndpoint'
-- GET / -- GET /
-- λ> 'defEndpoint' & 'path' '<>~' "foo" -- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
-- GET /foo -- GET /foo
-- λ> 'defEndpoint' & 'path' '<>~' "foo" & 'method' '.~' 'DocPOST' -- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
-- POST /foo -- POST /foo
-- @ -- @
defEndpoint :: Endpoint defEndpoint :: Endpoint
defEndpoint = Endpoint "/" DocGET defEndpoint = Endpoint [] DocGET
instance Hashable Endpoint instance Hashable Endpoint
@ -226,12 +235,12 @@ data ParamKind = Normal | List | Flag
-- Can be tweaked with two lenses. -- Can be tweaked with two lenses.
-- --
-- > λ> defResponse -- > λ> defResponse
-- > Response {_respStatus = 200, _respBody = Nothing} -- > Response {_respStatus = 200, _respBody = []}
-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]" -- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
-- > Response {_respStatus = 204, _respBody = Just "[]"} -- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
data Response = Response data Response = Response
{ _respStatus :: Int { _respStatus :: Int
, _respBody :: Maybe ByteString , _respBody :: [(Text, ByteString)]
} deriving (Eq, Show) } deriving (Eq, Show)
-- | Default response: status code 200, no response body. -- | Default response: status code 200, no response body.
@ -243,7 +252,7 @@ data Response = Response
-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]" -- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
-- > Response {_respStatus = 204, _respBody = Just "[]"} -- > Response {_respStatus = 204, _respBody = Just "[]"}
defResponse :: Response defResponse :: Response
defResponse = Response 200 Nothing defResponse = Response 200 []
-- | A datatype that represents everything that can happen -- | A datatype that represents everything that can happen
-- at an endpoint, with its lenses: -- at an endpoint, with its lenses:
@ -327,15 +336,29 @@ class HasDocs layout where
-- > toSample = Just g -- > toSample = Just g
-- > -- >
-- > where g = Greet "Hello, haskeller!" -- > where g = Greet "Hello, haskeller!"
--
-- You can also instantiate this class using 'toSamples' instead of
-- 'toSample': it lets you specify different responses along with
-- some context (as 'Text') that explains when you're supposed to
-- get the corresponding response.
class ToJSON a => ToSample a where class ToJSON a => ToSample a where
{-# MINIMAL (toSample | toSamples) #-}
toSample :: Maybe a toSample :: Maybe a
toSample = fmap snd $ listToMaybe samples
where samples = toSamples :: [(Text, a)]
instance ToSample () where toSamples :: [(Text, a)]
toSample = Just () toSamples = maybe [] (return . ("",)) s
where s = toSample :: Maybe a
sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString
sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a) sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a)
sampleByteStrings :: forall a. ToSample a => Proxy a -> [(Text, ByteString)]
sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty
where samples = toSamples :: [(Text, a)]
-- | The class that helps us automatically get documentation -- | The class that helps us automatically get documentation
-- for GET parameters. -- for GET parameters.
-- --
@ -376,7 +399,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
responseStr (action ^. response) ++ responseStr (action ^. response) ++
[] []
where str = show (endpoint^.method) ++ " " ++ endpoint^.path where str = show (endpoint^.method) ++ " " ++ showPath (endpoint^.path)
len = length str len = length str
capturesStr :: [DocCapture] -> [String] capturesStr :: [DocCapture] -> [String]
@ -441,9 +464,13 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
"**Response**: " : "**Response**: " :
"" : "" :
(" - Status code " ++ show (resp ^. respStatus)) : (" - Status code " ++ show (resp ^. respStatus)) :
(resp ^. respBody & bodies
maybe [" - No response body\n"]
(\b -> " - Response body as below." : jsonStr b)) where bodies = case resp ^. respBody of
[] -> [" - No response body\n"]
[("", r)] -> " - Response body as below." : jsonStr r
xs ->
concatMap (\(ctx, r) -> (" - " <> T.unpack ctx) : jsonStr r) xs
-- * Instances -- * Instances
@ -472,7 +499,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
captureP = Proxy :: Proxy (Capture sym a) captureP = Proxy :: Proxy (Capture sym a)
action' = over captures (|> toCapture captureP) action action' = over captures (|> toCapture captureP) action
endpoint' = over path (\p -> p++"/:"++symbolVal symP) endpoint endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
symP = Proxy :: Proxy sym symP = Proxy :: Proxy sym
@ -482,7 +509,7 @@ instance HasDocs Delete where
where endpoint' = endpoint & method .~ DocDELETE where endpoint' = endpoint & method .~ DocDELETE
action' = action & response.respBody .~ Nothing action' = action & response.respBody .~ []
& response.respStatus .~ 204 & response.respStatus .~ 204
instance ToSample a => HasDocs (Get a) where instance ToSample a => HasDocs (Get a) where
@ -490,7 +517,7 @@ instance ToSample a => HasDocs (Get a) where
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocGET where endpoint' = endpoint & method .~ DocGET
action' = action & response.respBody .~ sampleByteString p action' = action & response.respBody .~ sampleByteStrings p
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance (KnownSymbol sym, HasDocs sublayout) instance (KnownSymbol sym, HasDocs sublayout)
@ -508,7 +535,7 @@ instance ToSample a => HasDocs (Post a) where
where endpoint' = endpoint & method .~ DocPOST where endpoint' = endpoint & method .~ DocPOST
action' = action & response.respBody .~ sampleByteString p action' = action & response.respBody .~ sampleByteStrings p
& response.respStatus .~ 201 & response.respStatus .~ 201
p = Proxy :: Proxy a p = Proxy :: Proxy a
@ -519,7 +546,7 @@ instance ToSample a => HasDocs (Put a) where
where endpoint' = endpoint & method .~ DocPUT where endpoint' = endpoint & method .~ DocPUT
action' = action & response.respBody .~ sampleByteString p action' = action & response.respBody .~ sampleByteStrings p
& response.respStatus .~ 200 & response.respStatus .~ 200
p = Proxy :: Proxy a p = Proxy :: Proxy a
@ -614,7 +641,7 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
docsFor sublayoutP (endpoint', action) docsFor sublayoutP (endpoint', action)
where sublayoutP = Proxy :: Proxy sublayout where sublayoutP = Proxy :: Proxy sublayout
endpoint' = endpoint & path <>~ symbolVal pa endpoint' = endpoint & path <>~ [symbolVal pa]
pa = Proxy :: Proxy path pa = Proxy :: Proxy path
{- {-