143091e · servant · git.iko.soy

git.iko.soy/servant

merge documentation from duplicate routes

Servant supports defining the same route multiple times with different content-types and result-types, but servant-docs was only documenting the first of copy of such duplicated routes. It now combines the documentation from all the copies. Unfortunately, it is not yet possible for the documentation to specify multiple status codes.

commit143091eb3f1a153d17b1bdae12fb70b768e07cf3 authorSamuel Gélineau <gelisam@simspace.com> dateThu 7 Nov 2019, 18:53 (7 years ago) parent624a42e

1 file changed+15−5

compare with master

unifiedsplit

servant-docs/src/Servant/Docs/Internal.hs+15−5

servant-docs/src/Servant/Docs/Internal.hs+15−5

@@ -20,6 +20,7 @@

2020#include "overlapping-compat.h"

2121module Servant.Docs.Internal where

2222

23+import Debug.Trace

2324import Prelude ()

2425import Prelude.Compat

2526

@@ -116,7 +117,8 @@ instance Semigroup API where

116117 (<>) = mappend

117118

118119instance Monoid API where

119− API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2) (b1 `mappend` b2)

120+ API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)

121+ (HM.unionWith combineAction b1 (traceShowId b2))

120122 mempty = API mempty mempty

121123

122124-- | An empty 'API'

@@ -223,6 +225,15 @@ data Response = Response

223225 , _respHeaders :: [HTTP.Header]

224226 } deriving (Eq, Ord, Show)

225227

228+-- | Combine two Responses, we can't make a monoid because merging Status breaks

229+-- the laws.

230+--

231+-- As such, we invent a non-commutative, left associative operation

232+-- 'combineResponse' to mush two together taking the status from the very left.

233+combineResponse :: Response -> Response -> Response

234+Response s ts bs hs `combineResponse` Response _ ts' bs' hs'

235+ = Response s (ts <> ts') (bs <> bs') (hs <> hs')

236+

226237-- | Default response: status code 200, no response body.

227238--

228239-- Can be tweaked with two lenses.

@@ -265,11 +276,10 @@ data Action = Action

265276-- laws.

266277--

267278-- As such, we invent a non-commutative, left associative operation

268−-- 'combineAction' to mush two together taking the response, body and content

269−-- types from the very left.

279+-- 'combineAction' to mush two together taking the response from the very left.

270280combineAction :: Action -> Action -> Action

271−Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =

272− Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp

281+Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' ts' body' resp' =

282+ Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') (ts <> ts') (body <> body') (resp `combineResponse` resp')

273283

274284-- | Default 'Action'. Has no 'captures', no query 'params', expects

275285-- no request body ('rqbody') and the typical response is 'defResponse'.