git.iko.soy/servant
on master help sign in
Merge pull request #1071 from phadej/golden-servant-docs
05d0f7eOleg Grenrus
servant-docs/golden/comprehensive.mdnew file+521
compare with master
unifiedsplit
@@ -0,0 +1,521 @@
1+## GET /
2+
3+### Response:
4+
5+- Status code 200
6+- Headers: []
7+
8+- Supported content types are:
9+
10+ - `application/json;charset=utf-8`
11+ - `application/json`
12+
13+- Example (`application/json;charset=utf-8`, `application/json`):
14+
15+```javascript
16+
17+```
18+
19+## GET /capture/:foo
20+
21+### Captures:
22+
23+- *foo*: Capture foo Int
24+
25+### Response:
26+
27+- Status code 200
28+- Headers: []
29+
30+- Supported content types are:
31+
32+ - `application/json;charset=utf-8`
33+ - `application/json`
34+
35+- Example (`application/json;charset=utf-8`, `application/json`):
36+
37+```javascript
38+
39+```
40+
41+## GET /capture-all/:foo
42+
43+### Captures:
44+
45+- *foo*: Capture all foo Int
46+
47+### Response:
48+
49+- Status code 200
50+- Headers: []
51+
52+- Supported content types are:
53+
54+ - `application/json;charset=utf-8`
55+ - `application/json`
56+
57+- Example (`application/json;charset=utf-8`, `application/json`):
58+
59+```javascript
60+
61+```
62+
63+## GET /description
64+
65+### foo
66+
67+
68+### Response:
69+
70+- Status code 200
71+- Headers: []
72+
73+- Supported content types are:
74+
75+ - `application/json;charset=utf-8`
76+ - `application/json`
77+
78+- Example (`application/json;charset=utf-8`, `application/json`):
79+
80+```javascript
81+
82+```
83+
84+## GET /flag
85+
86+### GET Parameters:
87+
88+- foo
89+ - **Description**: QueryFlag
90+ - This parameter is a **flag**. This means no value is expected to be associated to this parameter.
91+
92+
93+### Response:
94+
95+- Status code 200
96+- Headers: []
97+
98+- Supported content types are:
99+
100+ - `application/json;charset=utf-8`
101+ - `application/json`
102+
103+- Example (`application/json;charset=utf-8`, `application/json`):
104+
105+```javascript
106+
107+```
108+
109+## GET /foo
110+
111+### Response:
112+
113+- Status code 200
114+- Headers: []
115+
116+- Supported content types are:
117+
118+ - `application/json;charset=utf-8`
119+ - `application/json`
120+
121+- Example (`application/json;charset=utf-8`, `application/json`):
122+
123+```javascript
124+
125+```
126+
127+## GET /get-int
128+
129+### Response:
130+
131+- Status code 200
132+- Headers: []
133+
134+- Supported content types are:
135+
136+ - `application/json;charset=utf-8`
137+ - `application/json`
138+
139+- Example (`application/json;charset=utf-8`, `application/json`):
140+
141+```javascript
142+17
143+```
144+
145+## GET /header
146+
147+### Headers:
148+
149+- This endpoint is sensitive to the value of the **foo** HTTP header.
150+
151+### Response:
152+
153+- Status code 200
154+- Headers: []
155+
156+- Supported content types are:
157+
158+ - `application/json;charset=utf-8`
159+ - `application/json`
160+
161+- Example (`application/json;charset=utf-8`, `application/json`):
162+
163+```javascript
164+
165+```
166+
167+## GET /header-lenient
168+
169+### Headers:
170+
171+- This endpoint is sensitive to the value of the **bar** HTTP header.
172+
173+### Response:
174+
175+- Status code 200
176+- Headers: []
177+
178+- Supported content types are:
179+
180+ - `application/json;charset=utf-8`
181+ - `application/json`
182+
183+- Example (`application/json;charset=utf-8`, `application/json`):
184+
185+```javascript
186+
187+```
188+
189+## GET /http-version
190+
191+### Response:
192+
193+- Status code 200
194+- Headers: []
195+
196+- Supported content types are:
197+
198+ - `application/json;charset=utf-8`
199+ - `application/json`
200+
201+- Example (`application/json;charset=utf-8`, `application/json`):
202+
203+```javascript
204+
205+```
206+
207+## GET /is-secure
208+
209+### Response:
210+
211+- Status code 200
212+- Headers: []
213+
214+- Supported content types are:
215+
216+ - `application/json;charset=utf-8`
217+ - `application/json`
218+
219+- Example (`application/json;charset=utf-8`, `application/json`):
220+
221+```javascript
222+
223+```
224+
225+## GET /named-context
226+
227+### Response:
228+
229+- Status code 200
230+- Headers: []
231+
232+- Supported content types are:
233+
234+ - `application/json;charset=utf-8`
235+ - `application/json`
236+
237+- Example (`application/json;charset=utf-8`, `application/json`):
238+
239+```javascript
240+
241+```
242+
243+## GET /param
244+
245+### GET Parameters:
246+
247+- foo
248+ - **Values**: *1, 2, 3*
249+ - **Description**: QueryParams Int
250+
251+
252+### Response:
253+
254+- Status code 200
255+- Headers: []
256+
257+- Supported content types are:
258+
259+ - `application/json;charset=utf-8`
260+ - `application/json`
261+
262+- Example (`application/json;charset=utf-8`, `application/json`):
263+
264+```javascript
265+
266+```
267+
268+## GET /param-lenient
269+
270+### GET Parameters:
271+
272+- bar
273+ - **Values**: *1, 2, 3*
274+ - **Description**: QueryParams Int
275+
276+
277+### Response:
278+
279+- Status code 200
280+- Headers: []
281+
282+- Supported content types are:
283+
284+ - `application/json;charset=utf-8`
285+ - `application/json`
286+
287+- Example (`application/json;charset=utf-8`, `application/json`):
288+
289+```javascript
290+
291+```
292+
293+## GET /params
294+
295+### GET Parameters:
296+
297+- foo
298+ - **Values**: *1, 2, 3*
299+ - **Description**: QueryParams Int
300+ - This parameter is a **list**. All GET parameters with the name foo[] will forward their values in a list to the handler.
301+
302+
303+### Response:
304+
305+- Status code 200
306+- Headers: []
307+
308+- Supported content types are:
309+
310+ - `application/json;charset=utf-8`
311+ - `application/json`
312+
313+- Example (`application/json;charset=utf-8`, `application/json`):
314+
315+```javascript
316+
317+```
318+
319+## POST /post-int
320+
321+### Response:
322+
323+- Status code 204
324+- Headers: []
325+
326+- Supported content types are:
327+
328+ - `application/json;charset=utf-8`
329+ - `application/json`
330+
331+- Example (`application/json;charset=utf-8`, `application/json`):
332+
333+```javascript
334+17
335+```
336+
337+## POST /post-no-content
338+
339+### Response:
340+
341+- Status code 204
342+- Headers: []
343+
344+- Supported content types are:
345+
346+ - `application/json;charset=utf-8`
347+ - `application/json`
348+
349+- Example (`application/json;charset=utf-8`, `application/json`):
350+
351+```javascript
352+
353+```
354+
355+## GET /raw
356+
357+### Response:
358+
359+- Status code 200
360+- Headers: []
361+
362+- No response body
363+
364+## GET /remote-host
365+
366+### Response:
367+
368+- Status code 200
369+- Headers: []
370+
371+- Supported content types are:
372+
373+ - `application/json;charset=utf-8`
374+ - `application/json`
375+
376+- Example (`application/json;charset=utf-8`, `application/json`):
377+
378+```javascript
379+
380+```
381+
382+## GET /req-body
383+
384+### Request:
385+
386+- Supported content types are:
387+
388+ - `application/json;charset=utf-8`
389+ - `application/json`
390+
391+- Example (`application/json;charset=utf-8`, `application/json`):
392+
393+```javascript
394+17
395+```
396+
397+### Response:
398+
399+- Status code 200
400+- Headers: []
401+
402+- Supported content types are:
403+
404+ - `application/json;charset=utf-8`
405+ - `application/json`
406+
407+- Example (`application/json;charset=utf-8`, `application/json`):
408+
409+```javascript
410+
411+```
412+
413+## GET /req-body-lenient
414+
415+### Request:
416+
417+- Supported content types are:
418+
419+ - `application/json;charset=utf-8`
420+ - `application/json`
421+
422+- Example (`application/json;charset=utf-8`, `application/json`):
423+
424+```javascript
425+17
426+```
427+
428+### Response:
429+
430+- Status code 200
431+- Headers: []
432+
433+- Supported content types are:
434+
435+ - `application/json;charset=utf-8`
436+ - `application/json`
437+
438+- Example (`application/json;charset=utf-8`, `application/json`):
439+
440+```javascript
441+
442+```
443+
444+## GET /res-headers
445+
446+### Response:
447+
448+- Status code 200
449+- Headers: [("foo","17")]
450+
451+- Supported content types are:
452+
453+ - `application/json;charset=utf-8`
454+ - `application/json`
455+
456+- Example (`application/json;charset=utf-8`, `application/json`):
457+
458+```javascript
459+
460+```
461+
462+## GET /streaming
463+
464+### Request:
465+
466+- Supported content types are:
467+
468+ - `application/json;charset=utf-8`
469+ - `application/json`
470+
471+### Response:
472+
473+- Status code 200
474+- Headers: []
475+
476+- Supported content types are:
477+
478+ - `application/json;charset=utf-8`
479+ - `application/json`
480+
481+- No response body
482+
483+## GET /summary
484+
485+### foo
486+
487+
488+### Response:
489+
490+- Status code 200
491+- Headers: []
492+
493+- Supported content types are:
494+
495+ - `application/json;charset=utf-8`
496+ - `application/json`
497+
498+- Example (`application/json;charset=utf-8`, `application/json`):
499+
500+```javascript
501+
502+```
503+
504+## GET /vault
505+
506+### Response:
507+
508+- Status code 200
509+- Headers: []
510+
511+- Supported content types are:
512+
513+ - `application/json;charset=utf-8`
514+ - `application/json`
515+
516+- Example (`application/json;charset=utf-8`, `application/json`):
517+
518+```javascript
519+
520+```
521+
servant-docs/servant-docs.cabal+7−3
@@ -26,6 +26,8 @@ Bug-reports: http://github.com/haskell-servant/servant/issues
26extra-source-files:
26extra-source-files:
27 CHANGELOG.md
27 CHANGELOG.md
28 README.md
28 README.md
29+ golden/comprehensive.md
30+
29source-repository head
31source-repository head
30 type: git
32 type: git
31 location: http://github.com/haskell-servant/servant.git
33 location: http://github.com/haskell-servant/servant.git
@@ -93,6 +95,7 @@ test-suite spec
93 -- Dependencies inherited from the library. No need to specify bounds.
95 -- Dependencies inherited from the library. No need to specify bounds.
94 build-depends:
96 build-depends:
95 base
97 base
98+ , base-compat
96 , aeson
99 , aeson
97 , lens
100 , lens
98 , servant
101 , servant
@@ -101,7 +104,8 @@ test-suite spec
101
104
102 -- Additonal dependencies
105 -- Additonal dependencies
103 build-depends:
106 build-depends:
104− hspec >= 2.4.4 && < 2.6
107+ tasty >= 1.1.0.4 && < 1.2,
108+ tasty-golden >= 2.3.2 && < 2.4,
109+ tasty-hunit >= 0.10.0.1 && < 0.11,
110+ transformers >= 0.5.2.0 && < 0.6
105
111
106− build-tool-depends:
107− hspec-discover:hspec-discover >=2.4.4 && <2.6
servant-docs/src/Servant/Docs/Internal.hs+56−34
@@ -32,6 +32,8 @@ import qualified Data.ByteString.Char8 as BSC
32import Data.ByteString.Lazy.Char8
32import Data.ByteString.Lazy.Char8
33 (ByteString)
33 (ByteString)
34import qualified Data.CaseInsensitive as CI
34import qualified Data.CaseInsensitive as CI
35+import Data.Foldable
36+ (toList)
35import Data.Foldable
37import Data.Foldable
36 (fold)
38 (fold)
37import Data.Hashable
39import Data.Hashable
@@ -74,14 +76,15 @@ import qualified Network.HTTP.Types as HTTP
74-- or any 'Endpoint' value you want using the 'path' and 'method'
76-- or any 'Endpoint' value you want using the 'path' and 'method'
75-- lenses to tweak.
77-- lenses to tweak.
76--
78--
77−-- @
78−-- λ> 'defEndpoint'
79+-- >>> defEndpoint
79−-- GET /
80+-- "GET" /
81+--
80−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
82+-- >>> defEndpoint & path <>~ ["foo"]
81−-- GET /foo
83+-- "GET" /foo
84+--
82−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
85+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
83−-- POST /foo
86+-- "POST" /foo
84−-- @
87+--
85data Endpoint = Endpoint
88data Endpoint = Endpoint
86 { _path :: [String] -- type collected
89 { _path :: [String] -- type collected
87 , _method :: HTTP.Method -- type collected
90 , _method :: HTTP.Method -- type collected
@@ -102,14 +105,15 @@ showPath ps = concatMap ('/' :) ps
102--
105--
103-- Here's how you can modify it:
106-- Here's how you can modify it:
104--
107--
105−-- @
106−-- λ> 'defEndpoint'
108+-- >>> defEndpoint
107−-- GET /
109+-- "GET" /
110+--
108−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
111+-- >>> defEndpoint & path <>~ ["foo"]
109−-- GET /foo
112+-- "GET" /foo
113+--
110−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
114+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
111−-- POST /foo
115+-- "POST" /foo
112−-- @
116+--
113defEndpoint :: Endpoint
117defEndpoint :: Endpoint
114defEndpoint = Endpoint [] HTTP.methodGet
118defEndpoint = Endpoint [] HTTP.methodGet
115
119
@@ -220,12 +224,14 @@ data ParamKind = Normal | List | Flag
220-- want to write a 'ToSample' instance for the type that'll be represented
224-- want to write a 'ToSample' instance for the type that'll be represented
221-- as encoded data in the response.
225-- as encoded data in the response.
222--
226--
223−-- Can be tweaked with three lenses.
227+-- Can be tweaked with four lenses.
228+--
229+-- >>> defResponse
230+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
231+--
232+-- >>> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "application/json", "{ \"status\": \"ok\" }")]
233+-- Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well",application/json,"{ \"status\": \"ok\" }")], _respHeaders = []}
224--
234--
225−-- > λ> defResponse
226−-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
227−-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
228−-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
229data Response = Response
235data Response = Response
230 { _respStatus :: Int
236 { _respStatus :: Int
231 , _respTypes :: [M.MediaType]
237 , _respTypes :: [M.MediaType]
@@ -235,12 +241,14 @@ data Response = Response
235
241
236-- | Default response: status code 200, no response body.
242-- | Default response: status code 200, no response body.
237--
243--
238−-- Can be tweaked with two lenses.
244+-- Can be tweaked with four lenses.
245+--
246+-- >>> defResponse
247+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
248+--
249+-- >>> defResponse & respStatus .~ 204
250+-- Response {_respStatus = 204, _respTypes = [], _respBody = [], _respHeaders = []}
239--
251--
240−-- > λ> defResponse
241−-- > Response {_respStatus = 200, _respBody = Nothing}
242−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
243−-- > Response {_respStatus = 204, _respBody = Just "[]"}
244defResponse :: Response
252defResponse :: Response
245defResponse = Response
253defResponse = Response
246 { _respStatus = 200
254 { _respStatus = 200
@@ -286,10 +294,12 @@ Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
286--
294--
287-- Tweakable with lenses.
295-- Tweakable with lenses.
288--
296--
289−-- > λ> defAction
297+-- >>> defAction
290−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
298+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
299+--
291−-- > λ> defAction & response.respStatus .~ 201
300+-- >>> defAction & response.respStatus .~ 201
292−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
301+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
302+--
293defAction :: Action
303defAction :: Action
294defAction =
304defAction =
295 Action []
305 Action []
@@ -357,7 +367,8 @@ makeLenses ''RenderingOptions
357-- | Generate the docs for a given API that implements 'HasDocs'. This is the
367-- | Generate the docs for a given API that implements 'HasDocs'. This is the
358-- default way to create documentation.
368-- default way to create documentation.
359--
369--
360−-- prop> docs == docsWithOptions defaultDocOptions
370+-- > docs == docsWithOptions defaultDocOptions
371+--
361docs :: HasDocs api => Proxy api -> API
372docs :: HasDocs api => Proxy api -> API
362docs p = docsWithOptions p defaultDocOptions
373docs p = docsWithOptions p defaultDocOptions
363
374
@@ -958,7 +969,6 @@ instance (KnownSymbol desc, HasDocs api)
958-- both are even defined) for any particular type.
969-- both are even defined) for any particular type.
959instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
970instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
960 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
971 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
961−
962 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
972 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
963 docsFor subApiP (endpoint, action') opts
973 docsFor subApiP (endpoint, action') opts
964
974
@@ -969,8 +979,17 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
969 t = Proxy :: Proxy (ct ': cts)
979 t = Proxy :: Proxy (ct ': cts)
970 p = Proxy :: Proxy a
980 p = Proxy :: Proxy a
971
981
982+-- | TODO: this instance is incomplete.
972−instance HasDocs api => HasDocs (StreamBody framing ctype a :> api) where
983+instance (HasDocs api, Accept ctype) => HasDocs (StreamBody framing ctype a :> api) where
973− docsFor Proxy _ _ = error "HasDocs @StreamBody"
984+ docsFor Proxy (endpoint, action) opts =
985+ docsFor subApiP (endpoint, action') opts
986+ where
987+ subApiP = Proxy :: Proxy api
988+
989+ action' :: Action
990+ action' = action & rqtypes .~ toList (contentTypes t)
991+
992+ t = Proxy :: Proxy ctype
974
993
975instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
994instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
976
995
@@ -1036,3 +1055,6 @@ instance ToSample a => ToSample (Product a)
1036instance ToSample a => ToSample (First a)
1055instance ToSample a => ToSample (First a)
1037instance ToSample a => ToSample (Last a)
1056instance ToSample a => ToSample (Last a)
1038instance ToSample a => ToSample (Dual a)
1057instance ToSample a => ToSample (Dual a)
1058+
1059+-- $setup
1060+-- >>> :set -XOverloadedStrings
servant-docs/test/Servant/DocsSpec.hs+76−19
@@ -1,51 +1,69 @@
1−{-# LANGUAGE DataKinds #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE GADTs #-}
7+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE TypeOperators #-}
10+{-# LANGUAGE TypeOperators #-}
8−{-# LANGUAGE TypeSynonymInstances #-}
11+{-# LANGUAGE TypeSynonymInstances #-}
9{-# OPTIONS_GHC -fno-warn-orphans #-}
12{-# OPTIONS_GHC -fno-warn-orphans #-}
10{-# OPTIONS_GHC -freduction-depth=100 #-}
13{-# OPTIONS_GHC -freduction-depth=100 #-}
11
14
12module Servant.DocsSpec where
15module Servant.DocsSpec where
13
16
14import Control.Lens
17import Control.Lens
18+ ((&), (<>~))
19+import Control.Monad
20+ (unless)
21+import Control.Monad.Trans.Writer
22+ (Writer, runWriter, tell)
15import Data.Aeson
23import Data.Aeson
16−import Data.Monoid
24+import Data.List
25+ (isInfixOf)
17import Data.Proxy
26import Data.Proxy
18import Data.String.Conversions
27import Data.String.Conversions
19 (cs)
28 (cs)
20import GHC.Generics
29import GHC.Generics
21−import Test.Hspec
30+import Prelude ()
31+import Prelude.Compat
32+import Test.Tasty
33+ (TestName, TestTree, testGroup)
34+import Test.Tasty.Golden
35+ (goldenVsString)
36+import Test.Tasty.HUnit
37+ (Assertion, HasCallStack, assertFailure, testCase, (@?=))
22
38
23import Servant.API
39import Servant.API
24−import Servant.Test.ComprehensiveAPI
25import Servant.Docs.Internal
40import Servant.Docs.Internal
41+import Servant.Test.ComprehensiveAPI
26
42
27-- * comprehensive api
43-- * comprehensive api
28
44
29-- This declaration simply checks that all instances are in place.
45-- This declaration simply checks that all instances are in place.
46+comprehensiveDocs :: API
30−_ = docs comprehensiveAPI
47+comprehensiveDocs = docs comprehensiveAPI
31
48
32instance ToParam (QueryParam' mods "foo" Int) where
49instance ToParam (QueryParam' mods "foo" Int) where
33− toParam = error "unused"
50+ toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" Normal
34instance ToParam (QueryParam' mods "bar" Int) where
51instance ToParam (QueryParam' mods "bar" Int) where
35− toParam = error "unused"
52+ toParam _ = DocQueryParam "bar" ["1","2","3"] "QueryParams Int" Normal
36instance ToParam (QueryParams "foo" Int) where
53instance ToParam (QueryParams "foo" Int) where
37− toParam = error "unused"
54+ toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" List
38instance ToParam (QueryFlag "foo") where
55instance ToParam (QueryFlag "foo") where
39− toParam = error "unused"
56+ toParam _ = DocQueryParam "foo" [] "QueryFlag" Flag
40instance ToCapture (Capture "foo" Int) where
57instance ToCapture (Capture "foo" Int) where
41− toCapture = error "unused"
58+ toCapture _ = DocCapture "foo" "Capture foo Int"
42instance ToCapture (CaptureAll "foo" Int) where
59instance ToCapture (CaptureAll "foo" Int) where
43− toCapture = error "unused"
60+ toCapture _ = DocCapture "foo" "Capture all foo Int"
44
61
45-- * specs
62-- * specs
46
63
47−spec :: Spec
64+spec :: TestTree
48spec = describe "Servant.Docs" $ do
65spec = describe "Servant.Docs" $ do
66+ golden "comprehensive API" "golden/comprehensive.md" (markdown comprehensiveDocs)
49
67
50 describe "markdown" $ do
68 describe "markdown" $ do
51 let md = markdown (docs (Proxy :: Proxy TestApi1))
69 let md = markdown (docs (Proxy :: Proxy TestApi1))
@@ -146,3 +164,42 @@ instance ToSample TT where
146
164
147instance ToSample UT where
165instance ToSample UT where
148 toSamples _ = [("yks", UT1), ("kaks", UT2)]
166 toSamples _ = [("yks", UT1), ("kaks", UT2)]
167+
168+-------------------------------------------------------------------------------
169+-- HSpec like DSL for tasty
170+-------------------------------------------------------------------------------
171+
172+newtype TestTreeM a = TestTreeM (Writer [TestTree] a)
173+ deriving (Functor, Applicative, Monad)
174+
175+runTestTreeM :: TestTreeM () -> [TestTree]
176+runTestTreeM (TestTreeM m) = snd (runWriter m)
177+
178+class Describe r where
179+ describe :: TestName -> TestTreeM () -> r
180+
181+instance a ~ () => Describe (TestTreeM a) where
182+ describe n t = TestTreeM $ tell [ describe n t ]
183+
184+instance Describe TestTree where
185+ describe n t = testGroup n $ runTestTreeM t
186+
187+it :: TestName -> Assertion -> TestTreeM ()
188+it n assertion = TestTreeM $ tell [ testCase n assertion ]
189+
190+shouldBe :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion
191+shouldBe = (@?=)
192+
193+shouldContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
194+shouldContain = compareWith (flip isInfixOf) "does not contain"
195+
196+shouldNotContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
197+shouldNotContain = compareWith (\x y -> not (isInfixOf y x)) "contains"
198+
199+compareWith :: (Show a, Show b, HasCallStack) => (a -> b -> Bool) -> String -> a -> b -> Assertion
200+compareWith f msg x y = unless (f x y) $ assertFailure $
201+ show x ++ " " ++ msg ++ " " ++ show y
202+
203+golden :: TestName -> FilePath -> String -> TestTreeM ()
204+golden n fp contents = TestTreeM $ tell
205+ [ goldenVsString n fp (return (cs contents)) ]
servant-docs/test/Spec.hs+8−1
@@ -1 +1,8 @@
1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
1+module Main (main) where
2+
3+import Test.Tasty
4+ (defaultMain)
5+import qualified Servant.DocsSpec
6+
7+main :: IO ()
8+main = defaultMain Servant.DocsSpec.spec
servant/src/Servant/Test/ComprehensiveAPI.hs+25−25
@@ -16,37 +16,37 @@ type GET = Get '[JSON] NoContent
16
16
17type ComprehensiveAPI =
17type ComprehensiveAPI =
18 ComprehensiveAPIWithoutRaw :<|>
18 ComprehensiveAPIWithoutRaw :<|>
19− Raw
19+ "raw" :> Raw
20
20
21comprehensiveAPI :: Proxy ComprehensiveAPI
21comprehensiveAPI :: Proxy ComprehensiveAPI
22comprehensiveAPI = Proxy
22comprehensiveAPI = Proxy
23
23
24type ComprehensiveAPIWithoutRaw =
24type ComprehensiveAPIWithoutRaw =
25 GET :<|>
25 GET :<|>
26− Get '[JSON] Int :<|>
26+ "get-int" :> Get '[JSON] Int :<|>
27− Capture' '[Description "example description"] "foo" Int :> GET :<|>
27+ "capture" :> Capture' '[Description "example description"] "foo" Int :> GET :<|>
28− Header "foo" Int :> GET :<|>
28+ "header" :> Header "foo" Int :> GET :<|>
29− Header' '[Required, Lenient] "bar" Int :> GET :<|>
29+ "header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET :<|>
30− HttpVersion :> GET :<|>
30+ "http-version" :> HttpVersion :> GET :<|>
31− IsSecure :> GET :<|>
31+ "is-secure" :> IsSecure :> GET :<|>
32− QueryParam "foo" Int :> GET :<|>
32+ "param" :> QueryParam "foo" Int :> GET :<|>
33− QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
33+ "param-lenient" :> QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
34− QueryParams "foo" Int :> GET :<|>
34+ "params" :> QueryParams "foo" Int :> GET :<|>
35− QueryFlag "foo" :> GET :<|>
35+ "flag" :> QueryFlag "foo" :> GET :<|>
36− RemoteHost :> GET :<|>
36+ "remote-host" :> RemoteHost :> GET :<|>
37− ReqBody '[JSON] Int :> GET :<|>
37+ "req-body" :> ReqBody '[JSON] Int :> GET :<|>
38− ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
38+ "req-body-lenient" :> ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
39− Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
39+ "res-headers" :> Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
40− "foo" :> GET :<|>
40+ "foo" :> GET :<|>
41− Vault :> GET :<|>
41+ "vault" :> Vault :> GET :<|>
42− Verb 'POST 204 '[JSON] NoContent :<|>
42+ "post-no-content" :> Verb 'POST 204 '[JSON] NoContent :<|>
43− Verb 'POST 204 '[JSON] Int :<|>
43+ "post-int" :> Verb 'POST 204 '[JSON] Int :<|>
44− StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
44+ "streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
45− WithNamedContext "foo" '[] GET :<|>
45+ "named-context" :> WithNamedContext "foo" '[] GET :<|>
46− CaptureAll "foo" Int :> GET :<|>
46+ "capture-all" :> CaptureAll "foo" Int :> GET :<|>
47− Summary "foo" :> GET :<|>
47+ "summary" :> Summary "foo" :> GET :<|>
48− Description "foo" :> GET :<|>
48+ "description" :> Description "foo" :> GET :<|>
49− EmptyAPI
49+ "empty-api" :> EmptyAPI
50
50
51comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
51comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
52comprehensiveAPIWithoutRaw = Proxy
52comprehensiveAPIWithoutRaw = Proxy