Merge pull request #1071 from phadej/golden-servant-docs

Golden servant docs
This commit is contained in:
Oleg Grenrus 2018-11-08 17:37:19 +02:00 committed by GitHub
commit 05d0f7e460
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 693 additions and 82 deletions

View File

@ -0,0 +1,521 @@
## GET /
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /capture/:foo
### Captures:
- *foo*: Capture foo Int
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /capture-all/:foo
### Captures:
- *foo*: Capture all foo Int
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /description
### foo
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /flag
### GET Parameters:
- foo
- **Description**: QueryFlag
- This parameter is a **flag**. This means no value is expected to be associated to this parameter.
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /foo
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /get-int
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
17
```
## GET /header
### Headers:
- This endpoint is sensitive to the value of the **foo** HTTP header.
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /header-lenient
### Headers:
- This endpoint is sensitive to the value of the **bar** HTTP header.
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /http-version
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /is-secure
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /named-context
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /param
### GET Parameters:
- foo
- **Values**: *1, 2, 3*
- **Description**: QueryParams Int
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /param-lenient
### GET Parameters:
- bar
- **Values**: *1, 2, 3*
- **Description**: QueryParams Int
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /params
### GET Parameters:
- foo
- **Values**: *1, 2, 3*
- **Description**: QueryParams Int
- This parameter is a **list**. All GET parameters with the name foo[] will forward their values in a list to the handler.
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## POST /post-int
### Response:
- Status code 204
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
17
```
## POST /post-no-content
### Response:
- Status code 204
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /raw
### Response:
- Status code 200
- Headers: []
- No response body
## GET /remote-host
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /req-body
### Request:
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
17
```
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /req-body-lenient
### Request:
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
17
```
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /res-headers
### Response:
- Status code 200
- Headers: [("foo","17")]
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /streaming
### Request:
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- No response body
## GET /summary
### foo
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```
## GET /vault
### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json;charset=utf-8`
- `application/json`
- Example (`application/json;charset=utf-8`, `application/json`):
```javascript
```

View File

@ -26,6 +26,8 @@ Bug-reports: http://github.com/haskell-servant/servant/issues
extra-source-files:
CHANGELOG.md
README.md
golden/comprehensive.md
source-repository head
type: git
location: http://github.com/haskell-servant/servant.git
@ -93,6 +95,7 @@ test-suite spec
-- Dependencies inherited from the library. No need to specify bounds.
build-depends:
base
, base-compat
, aeson
, lens
, servant
@ -101,7 +104,8 @@ test-suite spec
-- Additonal dependencies
build-depends:
hspec >= 2.4.4 && < 2.6
tasty >= 1.1.0.4 && < 1.2,
tasty-golden >= 2.3.2 && < 2.4,
tasty-hunit >= 0.10.0.1 && < 0.11,
transformers >= 0.5.2.0 && < 0.6
build-tool-depends:
hspec-discover:hspec-discover >=2.4.4 && <2.6

View File

@ -32,6 +32,8 @@ import qualified Data.ByteString.Char8 as BSC
import Data.ByteString.Lazy.Char8
(ByteString)
import qualified Data.CaseInsensitive as CI
import Data.Foldable
(toList)
import Data.Foldable
(fold)
import Data.Hashable
@ -74,14 +76,15 @@ import qualified Network.HTTP.Types as HTTP
-- or any 'Endpoint' value you want using the 'path' and 'method'
-- lenses to tweak.
--
-- @
-- λ> 'defEndpoint'
-- GET /
-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
-- GET /foo
-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
-- POST /foo
-- @
-- >>> defEndpoint
-- "GET" /
--
-- >>> defEndpoint & path <>~ ["foo"]
-- "GET" /foo
--
-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
-- "POST" /foo
--
data Endpoint = Endpoint
{ _path :: [String] -- type collected
, _method :: HTTP.Method -- type collected
@ -102,14 +105,15 @@ showPath ps = concatMap ('/' :) ps
--
-- Here's how you can modify it:
--
-- @
-- λ> 'defEndpoint'
-- GET /
-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
-- GET /foo
-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
-- POST /foo
-- @
-- >>> defEndpoint
-- "GET" /
--
-- >>> defEndpoint & path <>~ ["foo"]
-- "GET" /foo
--
-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
-- "POST" /foo
--
defEndpoint :: Endpoint
defEndpoint = Endpoint [] HTTP.methodGet
@ -220,12 +224,14 @@ data ParamKind = Normal | List | Flag
-- want to write a 'ToSample' instance for the type that'll be represented
-- as encoded data in the response.
--
-- Can be tweaked with three lenses.
-- Can be tweaked with four lenses.
--
-- >>> defResponse
-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
--
-- >>> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "application/json", "{ \"status\": \"ok\" }")]
-- Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well",application/json,"{ \"status\": \"ok\" }")], _respHeaders = []}
--
-- > λ> defResponse
-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
data Response = Response
{ _respStatus :: Int
, _respTypes :: [M.MediaType]
@ -235,12 +241,14 @@ data Response = Response
-- | Default response: status code 200, no response body.
--
-- Can be tweaked with two lenses.
-- Can be tweaked with four lenses.
--
-- >>> defResponse
-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
--
-- >>> defResponse & respStatus .~ 204
-- Response {_respStatus = 204, _respTypes = [], _respBody = [], _respHeaders = []}
--
-- > λ> defResponse
-- > Response {_respStatus = 200, _respBody = Nothing}
-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
-- > Response {_respStatus = 204, _respBody = Just "[]"}
defResponse :: Response
defResponse = Response
{ _respStatus = 200
@ -286,10 +294,12 @@ Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
--
-- Tweakable with lenses.
--
-- > λ> defAction
-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
-- > λ> defAction & response.respStatus .~ 201
-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
-- >>> defAction
-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
--
-- >>> defAction & response.respStatus .~ 201
-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
--
defAction :: Action
defAction =
Action []
@ -357,7 +367,8 @@ makeLenses ''RenderingOptions
-- | Generate the docs for a given API that implements 'HasDocs'. This is the
-- default way to create documentation.
--
-- prop> docs == docsWithOptions defaultDocOptions
-- > docs == docsWithOptions defaultDocOptions
--
docs :: HasDocs api => Proxy api -> API
docs p = docsWithOptions p defaultDocOptions
@ -958,7 +969,6 @@ instance (KnownSymbol desc, HasDocs api)
-- both are even defined) for any particular type.
instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
=> HasDocs (ReqBody' mods (ct ': cts) a :> api) where
docsFor Proxy (endpoint, action) opts@DocOptions{..} =
docsFor subApiP (endpoint, action') opts
@ -969,8 +979,17 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
t = Proxy :: Proxy (ct ': cts)
p = Proxy :: Proxy a
instance HasDocs api => HasDocs (StreamBody framing ctype a :> api) where
docsFor Proxy _ _ = error "HasDocs @StreamBody"
-- | TODO: this instance is incomplete.
instance (HasDocs api, Accept ctype) => HasDocs (StreamBody framing ctype a :> api) where
docsFor Proxy (endpoint, action) opts =
docsFor subApiP (endpoint, action') opts
where
subApiP = Proxy :: Proxy api
action' :: Action
action' = action & rqtypes .~ toList (contentTypes t)
t = Proxy :: Proxy ctype
instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
@ -1036,3 +1055,6 @@ instance ToSample a => ToSample (Product a)
instance ToSample a => ToSample (First a)
instance ToSample a => ToSample (Last a)
instance ToSample a => ToSample (Dual a)
-- $setup
-- >>> :set -XOverloadedStrings

View File

@ -1,51 +1,69 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -freduction-depth=100 #-}
module Servant.DocsSpec where
import Control.Lens
((&), (<>~))
import Control.Monad
(unless)
import Control.Monad.Trans.Writer
(Writer, runWriter, tell)
import Data.Aeson
import Data.Monoid
import Data.List
(isInfixOf)
import Data.Proxy
import Data.String.Conversions
(cs)
import GHC.Generics
import Test.Hspec
import Prelude ()
import Prelude.Compat
import Test.Tasty
(TestName, TestTree, testGroup)
import Test.Tasty.Golden
(goldenVsString)
import Test.Tasty.HUnit
(Assertion, HasCallStack, assertFailure, testCase, (@?=))
import Servant.API
import Servant.Test.ComprehensiveAPI
import Servant.Docs.Internal
import Servant.Test.ComprehensiveAPI
-- * comprehensive api
-- This declaration simply checks that all instances are in place.
_ = docs comprehensiveAPI
comprehensiveDocs :: API
comprehensiveDocs = docs comprehensiveAPI
instance ToParam (QueryParam' mods "foo" Int) where
toParam = error "unused"
toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" Normal
instance ToParam (QueryParam' mods "bar" Int) where
toParam = error "unused"
toParam _ = DocQueryParam "bar" ["1","2","3"] "QueryParams Int" Normal
instance ToParam (QueryParams "foo" Int) where
toParam = error "unused"
toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" List
instance ToParam (QueryFlag "foo") where
toParam = error "unused"
toParam _ = DocQueryParam "foo" [] "QueryFlag" Flag
instance ToCapture (Capture "foo" Int) where
toCapture = error "unused"
toCapture _ = DocCapture "foo" "Capture foo Int"
instance ToCapture (CaptureAll "foo" Int) where
toCapture = error "unused"
toCapture _ = DocCapture "foo" "Capture all foo Int"
-- * specs
spec :: Spec
spec :: TestTree
spec = describe "Servant.Docs" $ do
golden "comprehensive API" "golden/comprehensive.md" (markdown comprehensiveDocs)
describe "markdown" $ do
let md = markdown (docs (Proxy :: Proxy TestApi1))
@ -146,3 +164,42 @@ instance ToSample TT where
instance ToSample UT where
toSamples _ = [("yks", UT1), ("kaks", UT2)]
-------------------------------------------------------------------------------
-- HSpec like DSL for tasty
-------------------------------------------------------------------------------
newtype TestTreeM a = TestTreeM (Writer [TestTree] a)
deriving (Functor, Applicative, Monad)
runTestTreeM :: TestTreeM () -> [TestTree]
runTestTreeM (TestTreeM m) = snd (runWriter m)
class Describe r where
describe :: TestName -> TestTreeM () -> r
instance a ~ () => Describe (TestTreeM a) where
describe n t = TestTreeM $ tell [ describe n t ]
instance Describe TestTree where
describe n t = testGroup n $ runTestTreeM t
it :: TestName -> Assertion -> TestTreeM ()
it n assertion = TestTreeM $ tell [ testCase n assertion ]
shouldBe :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion
shouldBe = (@?=)
shouldContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
shouldContain = compareWith (flip isInfixOf) "does not contain"
shouldNotContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
shouldNotContain = compareWith (\x y -> not (isInfixOf y x)) "contains"
compareWith :: (Show a, Show b, HasCallStack) => (a -> b -> Bool) -> String -> a -> b -> Assertion
compareWith f msg x y = unless (f x y) $ assertFailure $
show x ++ " " ++ msg ++ " " ++ show y
golden :: TestName -> FilePath -> String -> TestTreeM ()
golden n fp contents = TestTreeM $ tell
[ goldenVsString n fp (return (cs contents)) ]

View File

@ -1 +1,8 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
module Main (main) where
import Test.Tasty
(defaultMain)
import qualified Servant.DocsSpec
main :: IO ()
main = defaultMain Servant.DocsSpec.spec

View File

@ -16,37 +16,37 @@ type GET = Get '[JSON] NoContent
type ComprehensiveAPI =
ComprehensiveAPIWithoutRaw :<|>
Raw
"raw" :> Raw
comprehensiveAPI :: Proxy ComprehensiveAPI
comprehensiveAPI = Proxy
type ComprehensiveAPIWithoutRaw =
GET :<|>
Get '[JSON] Int :<|>
Capture' '[Description "example description"] "foo" Int :> GET :<|>
Header "foo" Int :> GET :<|>
Header' '[Required, Lenient] "bar" Int :> GET :<|>
HttpVersion :> GET :<|>
IsSecure :> GET :<|>
QueryParam "foo" Int :> GET :<|>
QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
QueryParams "foo" Int :> GET :<|>
QueryFlag "foo" :> GET :<|>
RemoteHost :> GET :<|>
ReqBody '[JSON] Int :> GET :<|>
ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
"foo" :> GET :<|>
Vault :> GET :<|>
Verb 'POST 204 '[JSON] NoContent :<|>
Verb 'POST 204 '[JSON] Int :<|>
StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
WithNamedContext "foo" '[] GET :<|>
CaptureAll "foo" Int :> GET :<|>
Summary "foo" :> GET :<|>
Description "foo" :> GET :<|>
EmptyAPI
"get-int" :> Get '[JSON] Int :<|>
"capture" :> Capture' '[Description "example description"] "foo" Int :> GET :<|>
"header" :> Header "foo" Int :> GET :<|>
"header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET :<|>
"http-version" :> HttpVersion :> GET :<|>
"is-secure" :> IsSecure :> GET :<|>
"param" :> QueryParam "foo" Int :> GET :<|>
"param-lenient" :> QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
"params" :> QueryParams "foo" Int :> GET :<|>
"flag" :> QueryFlag "foo" :> GET :<|>
"remote-host" :> RemoteHost :> GET :<|>
"req-body" :> ReqBody '[JSON] Int :> GET :<|>
"req-body-lenient" :> ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
"res-headers" :> Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
"foo" :> GET :<|>
"vault" :> Vault :> GET :<|>
"post-no-content" :> Verb 'POST 204 '[JSON] NoContent :<|>
"post-int" :> Verb 'POST 204 '[JSON] Int :<|>
"streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
"named-context" :> WithNamedContext "foo" '[] GET :<|>
"capture-all" :> CaptureAll "foo" Int :> GET :<|>
"summary" :> Summary "foo" :> GET :<|>
"description" :> Description "foo" :> GET :<|>
"empty-api" :> EmptyAPI
comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
comprehensiveAPIWithoutRaw = Proxy