git.iko.soy/typeable/servant
on master help sign in
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
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'.