Merge pull request #1071 from phadej/golden-servant-docs
Golden servant docs
This commit is contained in:
commit
05d0f7e460
6 changed files with 693 additions and 82 deletions
521
servant-docs/golden/comprehensive.md
Normal file
521
servant-docs/golden/comprehensive.md
Normal 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
|
||||
|
||||
```
|
||||
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)) ]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue