git.iko.soy/typeable/servant
on master help sign in
Merge pull request #1071 from phadej/golden-servant-docs

Golden servant docs

commit05d0f7e4604a349b4012eda9f218bbb61917112e authorOleg Grenrus <oleg.grenrus@iki.fi> dateThu 8 Nov 2018, 17:37 (8 years ago) parent80a047d953747b
6 files changed+693−82
compare with master
unifiedsplit
servant-docs/golden/comprehensive.md+521 servant-docs/servant-docs.cabal+7−3 servant-docs/src/Servant/Docs/Internal.hs+56−34 servant-docs/test/Servant/DocsSpec.hs+76−19 servant-docs/test/Spec.hs+8−1 servant/src/Servant/Test/ComprehensiveAPI.hs+25−25
servant-docs/golden/comprehensive.mdnew file+521
@@ -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
2626extra-source-files:
2727 CHANGELOG.md
2828 README.md
29+ golden/comprehensive.md
30+
2931source-repository head
3032 type: git
3133 location: http://github.com/haskell-servant/servant.git
@@ -93,6 +95,7 @@ test-suite spec
9395 -- Dependencies inherited from the library. No need to specify bounds.
9496 build-depends:
9597 base
98+ , base-compat
9699 , aeson
97100 , lens
98101 , servant
@@ -101,7 +104,8 @@ test-suite spec
101104
102105 -- Additonal dependencies
103106 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
105111
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
3232import Data.ByteString.Lazy.Char8
3333 (ByteString)
3434import qualified Data.CaseInsensitive as CI
35+import Data.Foldable
36+ (toList)
3537import Data.Foldable
3638 (fold)
3739import Data.Hashable
@@ -74,14 +76,15 @@ import qualified Network.HTTP.Types as HTTP
7476-- or any 'Endpoint' value you want using the 'path' and 'method'
7577-- lenses to tweak.
7678--
77−-- @
78−-- λ> 'defEndpoint'
79−-- GET /
80−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
81−-- GET /foo
82−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
83−-- POST /foo
84−-- @
79+-- >>> defEndpoint
80+-- "GET" /
81+--
82+-- >>> defEndpoint & path <>~ ["foo"]
83+-- "GET" /foo
84+--
85+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
86+-- "POST" /foo
87+--
8588data Endpoint = Endpoint
8689 { _path :: [String] -- type collected
8790 , _method :: HTTP.Method -- type collected
@@ -102,14 +105,15 @@ showPath ps = concatMap ('/' :) ps
102105--
103106-- Here's how you can modify it:
104107--
105−-- @
106−-- λ> 'defEndpoint'
107−-- GET /
108−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
109−-- GET /foo
110−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
111−-- POST /foo
112−-- @
108+-- >>> defEndpoint
109+-- "GET" /
110+--
111+-- >>> defEndpoint & path <>~ ["foo"]
112+-- "GET" /foo
113+--
114+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
115+-- "POST" /foo
116+--
113117defEndpoint :: Endpoint
114118defEndpoint = Endpoint [] HTTP.methodGet
115119
@@ -220,12 +224,14 @@ data ParamKind = Normal | List | Flag
220224-- want to write a 'ToSample' instance for the type that'll be represented
221225-- as encoded data in the response.
222226--
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 = []}
224234--
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\" }")]}
229235data Response = Response
230236 { _respStatus :: Int
231237 , _respTypes :: [M.MediaType]
@@ -235,12 +241,14 @@ data Response = Response
235241
236242-- | Default response: status code 200, no response body.
237243--
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 = []}
239251--
240−-- > λ> defResponse
241−-- > Response {_respStatus = 200, _respBody = Nothing}
242−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
243−-- > Response {_respStatus = 204, _respBody = Just "[]"}
244252defResponse :: Response
245253defResponse = Response
246254 { _respStatus = 200
@@ -286,10 +294,12 @@ Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
286294--
287295-- Tweakable with lenses.
288296--
289−-- > λ> defAction
290−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
291−-- > λ> defAction & response.respStatus .~ 201
292−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
297+-- >>> defAction
298+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
299+--
300+-- >>> defAction & response.respStatus .~ 201
301+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
302+--
293303defAction :: Action
294304defAction =
295305 Action []
@@ -357,7 +367,8 @@ makeLenses ''RenderingOptions
357367-- | Generate the docs for a given API that implements 'HasDocs'. This is the
358368-- default way to create documentation.
359369--
360−-- prop> docs == docsWithOptions defaultDocOptions
370+-- > docs == docsWithOptions defaultDocOptions
371+--
361372docs :: HasDocs api => Proxy api -> API
362373docs p = docsWithOptions p defaultDocOptions
363374
@@ -958,7 +969,6 @@ instance (KnownSymbol desc, HasDocs api)
958969-- both are even defined) for any particular type.
959970instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
960971 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
961−
962972 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
963973 docsFor subApiP (endpoint, action') opts
964974
@@ -969,8 +979,17 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
969979 t = Proxy :: Proxy (ct ': cts)
970980 p = Proxy :: Proxy a
971981
972−instance HasDocs api => HasDocs (StreamBody framing ctype a :> api) where
973− docsFor Proxy _ _ = error "HasDocs @StreamBody"
982+-- | TODO: this instance is incomplete.
983+instance (HasDocs api, Accept ctype) => HasDocs (StreamBody framing ctype a :> api) where
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
974993
975994instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
976995
@@ -1036,3 +1055,6 @@ instance ToSample a => ToSample (Product a)
10361055instance ToSample a => ToSample (First a)
10371056instance ToSample a => ToSample (Last a)
10381057instance 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 #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE TypeOperators #-}
8−{-# LANGUAGE TypeSynonymInstances #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveFunctor #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE GADTs #-}
7+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8+{-# LANGUAGE MultiParamTypeClasses #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE TypeOperators #-}
11+{-# LANGUAGE TypeSynonymInstances #-}
912{-# OPTIONS_GHC -fno-warn-orphans #-}
1013{-# OPTIONS_GHC -freduction-depth=100 #-}
1114
1215module Servant.DocsSpec where
1316
1417import Control.Lens
18+ ((&), (<>~))
19+import Control.Monad
20+ (unless)
21+import Control.Monad.Trans.Writer
22+ (Writer, runWriter, tell)
1523import Data.Aeson
16−import Data.Monoid
24+import Data.List
25+ (isInfixOf)
1726import Data.Proxy
1827import Data.String.Conversions
1928 (cs)
2029import 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, (@?=))
2238
2339import Servant.API
24−import Servant.Test.ComprehensiveAPI
2540import Servant.Docs.Internal
41+import Servant.Test.ComprehensiveAPI
2642
2743-- * comprehensive api
2844
2945-- This declaration simply checks that all instances are in place.
30−_ = docs comprehensiveAPI
46+comprehensiveDocs :: API
47+comprehensiveDocs = docs comprehensiveAPI
3148
3249instance ToParam (QueryParam' mods "foo" Int) where
33− toParam = error "unused"
50+ toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" Normal
3451instance ToParam (QueryParam' mods "bar" Int) where
35− toParam = error "unused"
52+ toParam _ = DocQueryParam "bar" ["1","2","3"] "QueryParams Int" Normal
3653instance ToParam (QueryParams "foo" Int) where
37− toParam = error "unused"
54+ toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" List
3855instance ToParam (QueryFlag "foo") where
39− toParam = error "unused"
56+ toParam _ = DocQueryParam "foo" [] "QueryFlag" Flag
4057instance ToCapture (Capture "foo" Int) where
41− toCapture = error "unused"
58+ toCapture _ = DocCapture "foo" "Capture foo Int"
4259instance ToCapture (CaptureAll "foo" Int) where
43− toCapture = error "unused"
60+ toCapture _ = DocCapture "foo" "Capture all foo Int"
4461
4562-- * specs
4663
47−spec :: Spec
64+spec :: TestTree
4865spec = describe "Servant.Docs" $ do
66+ golden "comprehensive API" "golden/comprehensive.md" (markdown comprehensiveDocs)
4967
5068 describe "markdown" $ do
5169 let md = markdown (docs (Proxy :: Proxy TestApi1))
@@ -146,3 +164,42 @@ instance ToSample TT where
146164
147165instance ToSample UT where
148166 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
1616
1717type ComprehensiveAPI =
1818 ComprehensiveAPIWithoutRaw :<|>
19− Raw
19+ "raw" :> Raw
2020
2121comprehensiveAPI :: Proxy ComprehensiveAPI
2222comprehensiveAPI = Proxy
2323
2424type ComprehensiveAPIWithoutRaw =
2525 GET :<|>
26− Get '[JSON] Int :<|>
27− Capture' '[Description "example description"] "foo" Int :> GET :<|>
28− Header "foo" Int :> GET :<|>
29− Header' '[Required, Lenient] "bar" Int :> GET :<|>
30− HttpVersion :> GET :<|>
31− IsSecure :> GET :<|>
32− QueryParam "foo" Int :> GET :<|>
33− QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
34− QueryParams "foo" Int :> GET :<|>
35− QueryFlag "foo" :> GET :<|>
36− RemoteHost :> GET :<|>
37− ReqBody '[JSON] Int :> GET :<|>
38− ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
39− Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
40− "foo" :> GET :<|>
41− Vault :> GET :<|>
42− Verb 'POST 204 '[JSON] NoContent :<|>
43− Verb 'POST 204 '[JSON] Int :<|>
44− StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
45− WithNamedContext "foo" '[] GET :<|>
46− CaptureAll "foo" Int :> GET :<|>
47− Summary "foo" :> GET :<|>
48− Description "foo" :> GET :<|>
49− EmptyAPI
26+ "get-int" :> Get '[JSON] Int :<|>
27+ "capture" :> Capture' '[Description "example description"] "foo" Int :> GET :<|>
28+ "header" :> Header "foo" Int :> GET :<|>
29+ "header-lenient" :> Header' '[Required, Lenient] "bar" Int :> GET :<|>
30+ "http-version" :> HttpVersion :> GET :<|>
31+ "is-secure" :> IsSecure :> GET :<|>
32+ "param" :> QueryParam "foo" Int :> GET :<|>
33+ "param-lenient" :> QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
34+ "params" :> QueryParams "foo" Int :> GET :<|>
35+ "flag" :> QueryFlag "foo" :> GET :<|>
36+ "remote-host" :> RemoteHost :> GET :<|>
37+ "req-body" :> ReqBody '[JSON] Int :> GET :<|>
38+ "req-body-lenient" :> ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
39+ "res-headers" :> Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
40+ "foo" :> GET :<|>
41+ "vault" :> Vault :> GET :<|>
42+ "post-no-content" :> Verb 'POST 204 '[JSON] NoContent :<|>
43+ "post-int" :> Verb 'POST 204 '[JSON] Int :<|>
44+ "streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
45+ "named-context" :> WithNamedContext "foo" '[] GET :<|>
46+ "capture-all" :> CaptureAll "foo" Int :> GET :<|>
47+ "summary" :> Summary "foo" :> GET :<|>
48+ "description" :> Description "foo" :> GET :<|>
49+ "empty-api" :> EmptyAPI
5050
5151comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
5252comprehensiveAPIWithoutRaw = Proxy