@@ -1,4 +1,3 @@
2{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DefaultSignatures #-}
@@ -17,41 +16,55 @@
17{-# LANGUAGE TypeOperators #-}
16{-# LANGUAGE TypeOperators #-}
18{-# LANGUAGE UndecidableInstances #-}
17{-# LANGUAGE UndecidableInstances #-}
20−#include "overlapping-compat.h"
21module Servant.Docs.Internal where
19module Servant.Docs.Internal where
23−import Prelude ()
21+import Prelude ()
24import Prelude.Compat
22import Prelude.Compat
26import Control.Applicative
24import Control.Applicative
27−import Control.Arrow (second)
25+import Control.Arrow
28−import Control.Lens (makeLenses, mapped, over,
27+import Control.Lens
29− traversed, view, (%~), (&), (.~),
28+ (makeLenses, mapped, each, over, set, to, toListOf, traversed, view,
30− (<>~), (^.), (|>))
29+ _1, (%~), (&), (.~), (<>~), (^.), (|>))
31−import qualified Control.Monad.Omega as Omega
32import qualified Data.ByteString.Char8 as BSC
30import qualified Data.ByteString.Char8 as BSC
33−import Data.ByteString.Lazy.Char8 (ByteString)
31+import Data.ByteString.Lazy.Char8
34import qualified Data.CaseInsensitive as CI
33import qualified Data.CaseInsensitive as CI
35−import Data.Foldable (fold)
34+import Data.Foldable
36−import Data.Hashable (Hashable)
36+import Data.Hashable
37−import Data.HashMap.Strict (HashMap)
38+import Data.HashMap.Strict
40+import Data.List.Compat
38−import Data.List.Compat (intercalate, intersperse, sort)
41+ (intercalate, intersperse, sort)
39−import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)
42+import Data.List.NonEmpty
43+ (NonEmpty ((:|)), groupWith)
40import qualified Data.List.NonEmpty as NE
44import qualified Data.List.NonEmpty as NE
41import Data.Maybe
45import Data.Maybe
42−import Data.Monoid (All (..), Any (..), Dual (..),
46+import Data.Monoid
43− First (..), Last (..),
47+ (All (..), Any (..), Dual (..), First (..), Last (..),
44− Product (..), Sum (..))
48+ Product (..), Sum (..))
45−import Data.Ord (comparing)
49+import Data.Ord
46−import Data.Proxy (Proxy (Proxy))
51+import Data.Proxy
47−import Data.Semigroup (Semigroup (..))
52+ (Proxy (Proxy))
48−import Data.String.Conversions (cs)
53+import Data.String.Conversions
49−import Data.Text (Text, unpack)
55+import Data.Text
50import GHC.Generics
57import GHC.Generics
58+ (Generic, Rep, K1(K1), M1(M1), U1(U1), V1,
59+ (:*:)((:*:)), (:+:)(L1, R1))
60+import qualified GHC.Generics as G
51import GHC.TypeLits
61import GHC.TypeLits
52import Servant.API
62import Servant.API
53import Servant.API.ContentTypes
63import Servant.API.ContentTypes
54import Servant.API.TypeLevel
64import Servant.API.TypeLevel
65+import Servant.API.Generic
67+import qualified Data.Universe.Helpers as U
56import qualified Data.HashMap.Strict as HM
69import qualified Data.HashMap.Strict as HM
57import qualified Data.Text as T
70import qualified Data.Text as T
@@ -64,14 +77,15 @@ import qualified Network.HTTP.Types as HTTP
64-- or any 'Endpoint' value you want using the 'path' and 'method'
77-- or any 'Endpoint' value you want using the 'path' and 'method'
65-- lenses to tweak.
78-- lenses to tweak.
68−-- λ> 'defEndpoint'
80+-- >>> defEndpoint
70−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
83+-- >>> defEndpoint & path <>~ ["foo"]
71−-- GET /foo
84+-- "GET" /foo
72−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
86+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
73−-- POST /foo
87+-- "POST" /foo
75data Endpoint = Endpoint
89data Endpoint = Endpoint
76 { _path :: [String] -- type collected
90 { _path :: [String] -- type collected
77 , _method :: HTTP.Method -- type collected
91 , _method :: HTTP.Method -- type collected
@@ -92,14 +106,15 @@ showPath ps = concatMap ('/' :) ps
93-- Here's how you can modify it:
107-- Here's how you can modify it:
96−-- λ> 'defEndpoint'
109+-- >>> defEndpoint
97−-- GET /
110+-- "GET" /
98−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
112+-- >>> defEndpoint & path <>~ ["foo"]
99−-- GET /foo
113+-- "GET" /foo
100−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
115+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
101−-- POST /foo
116+-- "POST" /foo
103defEndpoint :: Endpoint
118defEndpoint :: Endpoint
104defEndpoint = Endpoint [] HTTP.methodGet
119defEndpoint = Endpoint [] HTTP.methodGet
@@ -116,7 +131,8 @@ instance Semigroup API where
116 (<>) = mappend
131 (<>) = mappend
118instance Monoid API where
133instance Monoid API where
119− API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2) (b1 `mappend` b2)
134+ API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)
135+ (HM.unionWith combineAction b1 b2)
120 mempty = API mempty mempty
136 mempty = API mempty mempty
122-- | An empty 'API'
138-- | An empty 'API'
@@ -145,6 +161,20 @@ data DocQueryParam = DocQueryParam
145 , _paramKind :: ParamKind
161 , _paramKind :: ParamKind
146 } deriving (Eq, Ord, Show)
162 } deriving (Eq, Ord, Show)
164+-- | A type to represent fragment. Holds the name of the fragment and its description.
166+-- Write a 'ToFragment' instance for your fragment types.
167+data DocFragment = DocFragment
168+ { _fragSymbol :: String -- type supplied
169+ , _fragDesc :: String -- user supplied
170+ } deriving (Eq, Ord, Show)
172+-- | There should be at most one 'Fragment' per API endpoint.
173+-- So here we are keeping the first occurrence.
174+combineFragment :: Maybe DocFragment -> Maybe DocFragment -> Maybe DocFragment
175+Nothing `combineFragment` mdocFragment = mdocFragment
176+Just docFragment `combineFragment` _ = Just docFragment
148-- | An introductory paragraph for your documentation. You can pass these to
178-- | An introductory paragraph for your documentation. You can pass these to
149-- 'docsWithIntros'.
179-- 'docsWithIntros'.
150data DocIntro = DocIntro
180data DocIntro = DocIntro
@@ -210,12 +240,14 @@ data ParamKind = Normal | List | Flag
210-- want to write a 'ToSample' instance for the type that'll be represented
240-- want to write a 'ToSample' instance for the type that'll be represented
211-- as encoded data in the response.
241-- as encoded data in the response.
213−-- Can be tweaked with three lenses.
243+-- Can be tweaked with four lenses.
246+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
248+-- >>> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "application/json", "{ \"status\": \"ok\" }")]
249+-- Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well",application/json,"{ \"status\": \"ok\" }")], _respHeaders = []}
216−-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
217−-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
218−-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
219data Response = Response
251data Response = Response
220 { _respStatus :: Int
252 { _respStatus :: Int
221 , _respTypes :: [M.MediaType]
253 , _respTypes :: [M.MediaType]
@@ -223,14 +255,25 @@ data Response = Response
223 , _respHeaders :: [HTTP.Header]
255 , _respHeaders :: [HTTP.Header]
224 } deriving (Eq, Ord, Show)
256 } deriving (Eq, Ord, Show)
258+-- | Combine two Responses, we can't make a monoid because merging Status breaks
261+-- As such, we invent a non-commutative, left associative operation
262+-- 'combineResponse' to mush two together taking the status from the very left.
263+combineResponse :: Response -> Response -> Response
264+Response s ts bs hs `combineResponse` Response _ ts' bs' hs'
265+ = Response s (ts <> ts') (bs <> bs') (hs <> hs')
226-- | Default response: status code 200, no response body.
267-- | Default response: status code 200, no response body.
228−-- Can be tweaked with two lenses.
269+-- Can be tweaked with four lenses.
272+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
274+-- >>> defResponse & respStatus .~ 204
275+-- Response {_respStatus = 204, _respTypes = [], _respBody = [], _respHeaders = []}
231−-- > Response {_respStatus = 200, _respBody = Nothing}
232−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
233−-- > Response {_respStatus = 204, _respBody = Just "[]"}
234defResponse :: Response
277defResponse :: Response
235defResponse = Response
278defResponse = Response
236 { _respStatus = 200
279 { _respStatus = 200
@@ -252,8 +295,9 @@ defResponse = Response
252data Action = Action
295data Action = Action
253 { _authInfo :: [DocAuthentication] -- user supplied info
296 { _authInfo :: [DocAuthentication] -- user supplied info
254 , _captures :: [DocCapture] -- type collected + user supplied info
297 , _captures :: [DocCapture] -- type collected + user supplied info
255− , _headers :: [Text] -- type collected
298+ , _headers :: [HTTP.Header] -- type collected
256 , _params :: [DocQueryParam] -- type collected + user supplied info
299 , _params :: [DocQueryParam] -- type collected + user supplied info
300+ , _fragment :: Maybe DocFragment -- type collected + user supplied info
257 , _notes :: [DocNote] -- user supplied
301 , _notes :: [DocNote] -- user supplied
258 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
302 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
259 , _rqtypes :: [M.MediaType] -- type collected
303 , _rqtypes :: [M.MediaType] -- type collected
@@ -265,27 +309,30 @@ data Action = Action
267-- As such, we invent a non-commutative, left associative operation
311-- As such, we invent a non-commutative, left associative operation
268−-- 'combineAction' to mush two together taking the response, body and content
312+-- 'combineAction' to mush two together taking the response from the very left.
269−-- types from the very left.
270combineAction :: Action -> Action -> Action
313combineAction :: Action -> Action -> Action
271−Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
314+Action a c h p f n m ts body resp
315+ `combineAction` Action a' c' h' p' f' n' m' ts' body' resp' =
272− Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
316+ Action (a <> a') (c <> c') (h <> h') (p <> p') (f `combineFragment` f') (n <> n') (m <> m') (ts <> ts') (body <> body') (resp `combineResponse` resp')
274-- | Default 'Action'. Has no 'captures', no query 'params', expects
318-- | Default 'Action'. Has no 'captures', no query 'params', expects
275-- no request body ('rqbody') and the typical response is 'defResponse'.
319-- no request body ('rqbody') and the typical response is 'defResponse'.
277-- Tweakable with lenses.
321-- Tweakable with lenses.
279−-- > λ> defAction
323+-- >>> defAction
280−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
324+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
281−-- > λ> defAction & response.respStatus .~ 201
326+-- >>> defAction & response.respStatus .~ 201
282−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
327+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
283defAction :: Action
329defAction :: Action
284defAction =
330defAction =
285 Action []
331 Action []
@@ -309,12 +356,14 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten
310-- @since 0.11.1
357-- @since 0.11.1
311data RenderingOptions = RenderingOptions
358data RenderingOptions = RenderingOptions
312− { _requestExamples :: !ShowContentTypes
359+ { _requestExamples :: !ShowContentTypes
313 -- ^ How many content types to display for request body examples?
360 -- ^ How many content types to display for request body examples?
314− , _responseExamples :: !ShowContentTypes
361+ , _responseExamples :: !ShowContentTypes
315 -- ^ How many content types to display for response body examples?
362 -- ^ How many content types to display for response body examples?
316− , _notesHeading :: !(Maybe String)
363+ , _notesHeading :: !(Maybe String)
317 -- ^ Optionally group all 'notes' together under a common heading.
364 -- ^ Optionally group all 'notes' together under a common heading.
365+ , _renderCurlBasePath :: !(Maybe String)
366+ -- ^ Optionally render example curl requests under a common base path (e.g. `http://localhost:80`).
318 } deriving (Show)
367 } deriving (Show)
320-- | Default API generation options.
369-- | Default API generation options.
@@ -326,9 +375,10 @@ data RenderingOptions = RenderingOptions
326-- @since 0.11.1
375-- @since 0.11.1
327defRenderingOptions :: RenderingOptions
376defRenderingOptions :: RenderingOptions
328defRenderingOptions = RenderingOptions
377defRenderingOptions = RenderingOptions
329− { _requestExamples = AllContentTypes
378+ { _requestExamples = AllContentTypes
330− , _responseExamples = AllContentTypes
379+ , _responseExamples = AllContentTypes
331− , _notesHeading = Nothing
380+ , _notesHeading = Nothing
381+ , _renderCurlBasePath = Nothing
334-- gimme some lenses
384-- gimme some lenses
@@ -338,6 +388,7 @@ makeLenses ''API
338makeLenses ''Endpoint
388makeLenses ''Endpoint
339makeLenses ''DocCapture
389makeLenses ''DocCapture
340makeLenses ''DocQueryParam
390makeLenses ''DocQueryParam
391+makeLenses ''DocFragment
341makeLenses ''DocIntro
392makeLenses ''DocIntro
342makeLenses ''DocNote
393makeLenses ''DocNote
343makeLenses ''Response
394makeLenses ''Response
@@ -347,7 +398,8 @@ makeLenses ''RenderingOptions
347-- | Generate the docs for a given API that implements 'HasDocs'. This is the
398-- | Generate the docs for a given API that implements 'HasDocs'. This is the
348-- default way to create documentation.
399-- default way to create documentation.
350−-- prop> docs == docsWithOptions defaultDocOptions
401+-- > docs == docsWithOptions defaultDocOptions
351docs :: HasDocs api => Proxy api -> API
403docs :: HasDocs api => Proxy api -> API
352docs p = docsWithOptions p defaultDocOptions
404docs p = docsWithOptions p defaultDocOptions
@@ -363,9 +415,9 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)
363-- > extra :: ExtraInfo TestApi
415-- > extra :: ExtraInfo TestApi
364-- > extra =
416-- > extra =
365-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
417-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
366−-- > defAction & headers <>~ ["unicorns"]
418+-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]
367-- > & notes <>~ [ DocNote "Title" ["This is some text"]
419-- > & notes <>~ [ DocNote "Title" ["This is some text"]
368−-- > , DocNote "Second secton" ["And some more"]
420+-- > , DocNote "Second section" ["And some more"]
371extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
423extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
@@ -395,7 +447,7 @@ docsWith opts intros (ExtraInfo endpoints) p =
395 & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
447 & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
398−-- | Generate the docs for a given API that implements 'HasDocs' with with any
450+-- | Generate the docs for a given API that implements 'HasDocs' with any
399-- number of introduction(s)
451-- number of introduction(s)
400docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
452docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
401docsWithIntros intros = docsWith defaultDocOptions intros mempty
453docsWithIntros intros = docsWith defaultDocOptions intros mempty
@@ -458,22 +510,22 @@ samples = map ("",)
459-- | Default sample Generic-based inputs/outputs.
511-- | Default sample Generic-based inputs/outputs.
460defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
512defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
461−defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
513+defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))
463-- | @'ToSample'@ for Generics.
515-- | @'ToSample'@ for Generics.
465−-- The use of @'Omega'@ allows for more productive sample generation.
517+-- Note: we use combinators from "Universe.Data.Helpers" for more productive sample generation.
466class GToSample t where
518class GToSample t where
467− gtoSamples :: proxy t -> Omega.Omega (Text, t x)
519+ gtoSamples :: proxy t -> [(Text, t x)]
469instance GToSample U1 where
521instance GToSample U1 where
470− gtoSamples _ = Omega.each (singleSample U1)
522+ gtoSamples _ = singleSample U1
472instance GToSample V1 where
524instance GToSample V1 where
473 gtoSamples _ = empty
525 gtoSamples _ = empty
475instance (GToSample p, GToSample q) => GToSample (p :*: q) where
527instance (GToSample p, GToSample q) => GToSample (p :*: q) where
476− gtoSamples _ = render <$> ps <*> qs
528+ gtoSamples _ = U.cartesianProduct render ps qs
478 ps = gtoSamples (Proxy :: Proxy p)
530 ps = gtoSamples (Proxy :: Proxy p)
479 qs = gtoSamples (Proxy :: Proxy q)
531 qs = gtoSamples (Proxy :: Proxy q)
@@ -482,13 +534,13 @@ instance (GToSample p, GToSample q) => GToSample (p :*: q) where
482 | otherwise = (ta <> ", " <> tb, a :*: b)
534 | otherwise = (ta <> ", " <> tb, a :*: b)
484instance (GToSample p, GToSample q) => GToSample (p :+: q) where
536instance (GToSample p, GToSample q) => GToSample (p :+: q) where
485− gtoSamples _ = lefts <|> rights
537+ gtoSamples _ = lefts U.+++ rights
487 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
539 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
488 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
540 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
490instance ToSample a => GToSample (K1 i a) where
542instance ToSample a => GToSample (K1 i a) where
491− gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
543+ gtoSamples _ = second K1 <$> toSamples (Proxy :: Proxy a)
493instance (GToSample f) => GToSample (M1 i a f) where
545instance (GToSample f) => GToSample (M1 i a f) where
494 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
546 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
@@ -556,6 +608,15 @@ class ToCapture c where
556class ToAuthInfo a where
608class ToAuthInfo a where
557 toAuthInfo :: Proxy a -> DocAuthentication
609 toAuthInfo :: Proxy a -> DocAuthentication
611+-- | The class that helps us get documentation for URL fragments.
613+-- Example of an instance:
615+-- > instance ToFragment (Fragment a) where
616+-- > toFragment _ = DocFragment "fragment" "fragment description"
617+class ToFragment t where
618+ toFragment :: Proxy t -> DocFragment
559-- | Generate documentation in Markdown format for
620-- | Generate documentation in Markdown format for
560-- the given 'API'.
621-- the given 'API'.
@@ -585,7 +646,7 @@ markdown = markdownWith defRenderingOptions
586-- @since 0.11.1
647-- @since 0.11.1
587markdownWith :: RenderingOptions -> API -> String
648markdownWith :: RenderingOptions -> API -> String
588−markdownWith RenderingOptions{..} api = unlines $
649+markdownWith RenderingOptions{..} api = unlines $
589 introsStr (api ^. apiIntros)
650 introsStr (api ^. apiIntros)
590 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
651 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
@@ -596,10 +657,12 @@ markdownWith RenderingOptions{..} api = unlines $
596 notesStr (action ^. notes) ++
657 notesStr (action ^. notes) ++
597 authStr (action ^. authInfo) ++
658 authStr (action ^. authInfo) ++
598 capturesStr (action ^. captures) ++
659 capturesStr (action ^. captures) ++
599− headersStr (action ^. headers) ++
660+ headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++
600 paramsStr meth (action ^. params) ++
661 paramsStr meth (action ^. params) ++
662+ fragmentStr (action ^. fragment) ++
601 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
663 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
602 responseStr (action ^. response) ++
664 responseStr (action ^. response) ++
665+ maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++
605 where str = "## " ++ BSC.unpack meth
668 where str = "## " ++ BSC.unpack meth
@@ -699,6 +762,14 @@ markdownWith RenderingOptions{..} api = unlines $
700 where values = param ^. paramValues
763 where values = param ^. paramValues
765+ fragmentStr :: Maybe DocFragment -> [String]
766+ fragmentStr Nothing = []
767+ fragmentStr (Just frag) =
768+ [ "### Fragment:", ""
769+ , "- *" ++ (frag ^. fragSymbol) ++ "*: " ++ (frag ^. fragDesc)
702 rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
773 rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
703 rqbodyStr [] [] = []
774 rqbodyStr [] [] = []
704 rqbodyStr types s =
775 rqbodyStr types s =
@@ -747,12 +818,11 @@ markdownWith RenderingOptions{..} api = unlines $
747 ("text", "css") -> "css"
818 ("text", "css") -> "css"
748 (_, _) -> ""
819 (_, _) -> ""
751 contentStr mime_type body =
821 contentStr mime_type body =
753− " ```" <> markdownForType mime_type :
823+ "```" <> markdownForType mime_type :
754 cs body :
824 cs body :
755− " ```" :
825+ "```" :
@@ -772,11 +842,41 @@ markdownWith RenderingOptions{..} api = unlines $
773 formatBodies _responseExamples xs
843 formatBodies _responseExamples xs
845+ curlStr :: Endpoint -> [HTTP.Header] -> [(Text, M.MediaType, ByteString)] -> String -> [String]
846+ curlStr endpoint hdrs reqBodies basePath =
847+ [ "### Sample Request:"
850+ , "curl -X" ++ BSC.unpack (endpoint ^. method) ++ " \\"
852+ maybe [] pure mbMediaTypeStr <>
854+ maybe [] pure mbReqBodyStr <>
855+ [ " " ++ basePath ++ showPath (endpoint ^. path)
860+ where escapeQuotes :: String -> String
861+ escapeQuotes = concatMap $ \c -> case c of
864+ mbReqBody = listToMaybe reqBodies
865+ mbMediaTypeStr = mkMediaTypeStr <$> mbReqBody
866+ headersStrs = mkHeaderStr <$> hdrs
867+ mbReqBodyStr = mkReqBodyStr <$> mbReqBody
868+ mkMediaTypeStr (_, media_type, _) =
869+ " -H \"Content-Type: " ++ show media_type ++ "\" \\"
870+ mkHeaderStr (hdrName, hdrVal) =
871+ " -H \"" ++ escapeQuotes (cs (CI.original hdrName)) ++ ": " ++
872+ escapeQuotes (cs hdrVal) ++ "\" \\"
873+ mkReqBodyStr (_, _, body) = " -d \"" ++ escapeQuotes (cs body) ++ "\" \\"
775-- * Instances
875-- * Instances
777-- | The generated docs for @a ':<|>' b@ just appends the docs
877-- | The generated docs for @a ':<|>' b@ just appends the docs
778-- for @a@ with the docs for @b@.
878-- for @a@ with the docs for @b@.
779−instance OVERLAPPABLE_
879+instance {-# OVERLAPPABLE #-}
780 (HasDocs a, HasDocs b)
880 (HasDocs a, HasDocs b)
781 => HasDocs (a :<|> b) where
881 => HasDocs (a :<|> b) where
@@ -795,7 +895,7 @@ instance HasDocs EmptyAPI where
795-- | @"books" :> 'Capture' "isbn" Text@ will appear as
895-- | @"books" :> 'Capture' "isbn" Text@ will appear as
796-- @/books/:isbn@ in the docs.
896-- @/books/:isbn@ in the docs.
797instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
897instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
798− => HasDocs (Capture' mods sym a :> api) where
898+ => HasDocs (Capture' '[] sym a :> api) where
800 docsFor Proxy (endpoint, action) =
900 docsFor Proxy (endpoint, action) =
801 docsFor subApiP (endpoint', action')
901 docsFor subApiP (endpoint', action')
@@ -807,6 +907,28 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
807 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
907 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
808 symP = Proxy :: Proxy sym
908 symP = Proxy :: Proxy sym
910+instance (KnownSymbol descr, KnownSymbol sym, HasDocs api)
911+ => HasDocs (Capture' (Description descr ': mods) sym a :> api) where
913+ docsFor Proxy (endpoint, action) =
914+ docsFor subApiP (endpoint', action')
916+ where subApiP = Proxy :: Proxy api
918+ docCapture = DocCapture (symbolVal symP) (symbolVal descrP)
919+ action' = over captures (|> docCapture) action
920+ endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
921+ descrP = Proxy :: Proxy descr
922+ symP = Proxy :: Proxy sym
924+instance {-# OVERLAPPABLE #-} HasDocs (Capture' mods sym a :> api)
925+ => HasDocs (Capture' (mod ': mods) sym a :> api) where
930+ where apiP = Proxy :: Proxy (Capture' mods sym a :> api)
811-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as
933-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as
812-- @/books/:isbn@ in the docs.
934-- @/books/:isbn@ in the docs.
@@ -824,7 +946,7 @@ instance (KnownSymbol sym, ToCapture (CaptureAll sym a), HasDocs sublayout)
824 symP = Proxy :: Proxy sym
946 symP = Proxy :: Proxy sym
827−instance OVERLAPPABLE_
949+instance {-# OVERLAPPABLE #-}
828 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
950 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
829 , ReflectMethod method)
951 , ReflectMethod method)
830 => HasDocs (Verb method status (ct ': cts) a) where
952 => HasDocs (Verb method status (ct ': cts) a) where
@@ -840,7 +962,37 @@ instance OVERLAPPABLE_
840 status = fromInteger $ natVal (Proxy :: Proxy status)
962 status = fromInteger $ natVal (Proxy :: Proxy status)
841 p = Proxy :: Proxy a
963 p = Proxy :: Proxy a
843−instance OVERLAPPING_
965+instance (ReflectMethod method) =>
966+ HasDocs (NoContentVerb method) where
967+ docsFor Proxy (endpoint, action) DocOptions{..} =
968+ single endpoint' action'
970+ where endpoint' = endpoint & method .~ method'
971+ action' = action & response.respStatus .~ 204
972+ & response.respTypes .~ []
973+ & response.respBody .~ []
974+ & response.respHeaders .~ []
975+ method' = reflectMethod (Proxy :: Proxy method)
977+-- | TODO: mention the endpoint is streaming, its framing strategy
979+-- Also there are no samples.
981+-- TODO: AcceptFraming for content-type
982+instance {-# OVERLAPPABLE #-}
983+ (Accept ct, KnownNat status, ReflectMethod method)
984+ => HasDocs (Stream method status framing ct a) where
985+ docsFor Proxy (endpoint, action) DocOptions{..} =
986+ single endpoint' action'
988+ where endpoint' = endpoint & method .~ method'
989+ action' = action & response.respTypes .~ allMime t
990+ & response.respStatus .~ status
991+ t = Proxy :: Proxy '[ct]
992+ method' = reflectMethod (Proxy :: Proxy method)
993+ status = fromInteger $ natVal (Proxy :: Proxy status)
995+instance {-# OVERLAPPING #-}
844 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
996 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
845 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
997 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
846 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
998 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
@@ -858,14 +1010,17 @@ instance OVERLAPPING_
858 status = fromInteger $ natVal (Proxy :: Proxy status)
1010 status = fromInteger $ natVal (Proxy :: Proxy status)
859 p = Proxy :: Proxy a
1011 p = Proxy :: Proxy a
861−instance (KnownSymbol sym, HasDocs api)
1013+instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)
862 => HasDocs (Header' mods sym a :> api) where
1014 => HasDocs (Header' mods sym a :> api) where
863 docsFor Proxy (endpoint, action) =
1015 docsFor Proxy (endpoint, action) =
864 docsFor subApiP (endpoint, action')
1016 docsFor subApiP (endpoint, action')
866 where subApiP = Proxy :: Proxy api
1018 where subApiP = Proxy :: Proxy api
867− action' = over headers (|> headername) action
1019+ action' = over headers (|> (headerName, headerVal)) action
868− headername = T.pack $ symbolVal (Proxy :: Proxy sym)
1020+ headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)
1021+ headerVal = case toSample (Proxy :: Proxy a) of
1022+ Just x -> cs $ toHeader x
1023+ Nothing -> "<no header sample provided>"
870instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
1025instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
871 => HasDocs (QueryParam' mods sym a :> api) where
1026 => HasDocs (QueryParam' mods sym a :> api) where
@@ -898,6 +1053,15 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
898 paramP = Proxy :: Proxy (QueryFlag sym)
1053 paramP = Proxy :: Proxy (QueryFlag sym)
899 action' = over params (|> toParam paramP) action
1054 action' = over params (|> toParam paramP) action
1056+instance (ToFragment (Fragment a), HasDocs api)
1057+ => HasDocs (Fragment a :> api) where
1059+ docsFor Proxy (endpoint, action) =
1060+ docsFor subApiP (endpoint, action')
1062+ where subApiP = Proxy :: Proxy api
1063+ fragmentP = Proxy :: Proxy (Fragment a)
1064+ action' = set fragment (Just (toFragment fragmentP)) action
902instance HasDocs Raw where
1066instance HasDocs Raw where
903 docsFor _proxy (endpoint, action) _ =
1067 docsFor _proxy (endpoint, action) _ =
@@ -930,7 +1094,6 @@ instance (KnownSymbol desc, HasDocs api)
930-- both are even defined) for any particular type.
1094-- both are even defined) for any particular type.
931instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
1095instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
932 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
1096 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
934 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
1097 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
935 docsFor subApiP (endpoint, action') opts
1098 docsFor subApiP (endpoint, action') opts
@@ -941,6 +1104,18 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
941 t = Proxy :: Proxy (ct ': cts)
1104 t = Proxy :: Proxy (ct ': cts)
942 p = Proxy :: Proxy a
1105 p = Proxy :: Proxy a
1107+-- | TODO: this instance is incomplete.
1108+instance (HasDocs api, Accept ctype) => HasDocs (StreamBody' mods framing ctype a :> api) where
1109+ docsFor Proxy (endpoint, action) opts =
1110+ docsFor subApiP (endpoint, action') opts
1112+ subApiP = Proxy :: Proxy api
1115+ action' = action & rqtypes .~ toList (contentTypes t)
1117+ t = Proxy :: Proxy ctype
944instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
1119instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
946 docsFor Proxy (endpoint, action) =
1121 docsFor Proxy (endpoint, action) =
@@ -969,6 +1144,9 @@ instance HasDocs api => HasDocs (Vault :> api) where
969instance HasDocs api => HasDocs (WithNamedContext name context api) where
1144instance HasDocs api => HasDocs (WithNamedContext name context api) where
970 docsFor Proxy = docsFor (Proxy :: Proxy api)
1145 docsFor Proxy = docsFor (Proxy :: Proxy api)
1147+instance HasDocs api => HasDocs (WithResource res :> api) where
1148+ docsFor Proxy = docsFor (Proxy :: Proxy api)
972instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
1150instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
973 docsFor Proxy (endpoint, action) =
1151 docsFor Proxy (endpoint, action) =
974 docsFor (Proxy :: Proxy api) (endpoint, action')
1152 docsFor (Proxy :: Proxy api) (endpoint, action')
@@ -976,6 +1154,9 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
976 authProxy = Proxy :: Proxy (BasicAuth realm usr)
1154 authProxy = Proxy :: Proxy (BasicAuth realm usr)
977 action' = over authInfo (|> toAuthInfo authProxy) action
1155 action' = over authInfo (|> toAuthInfo authProxy) action
1157+instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
1158+ docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
979-- ToSample instances for simple types
1160-- ToSample instances for simple types
980instance ToSample NoContent
1161instance ToSample NoContent
981instance ToSample Bool
1162instance ToSample Bool
@@ -992,6 +1173,7 @@ instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f
992instance ToSample a => ToSample (Maybe a)
1173instance ToSample a => ToSample (Maybe a)
993instance (ToSample a, ToSample b) => ToSample (Either a b)
1174instance (ToSample a, ToSample b) => ToSample (Either a b)
994instance ToSample a => ToSample [a]
1175instance ToSample a => ToSample [a]
1176+instance ToSample a => ToSample (NonEmpty a)
996-- ToSample instances for Control.Applicative types
1178-- ToSample instances for Control.Applicative types
997instance ToSample a => ToSample (Const a b)
1179instance ToSample a => ToSample (Const a b)
@@ -1005,3 +1187,6 @@ instance ToSample a => ToSample (Product a)
1005instance ToSample a => ToSample (First a)
1187instance ToSample a => ToSample (First a)
1006instance ToSample a => ToSample (Last a)
1188instance ToSample a => ToSample (Last a)
1007instance ToSample a => ToSample (Dual a)
1189instance ToSample a => ToSample (Dual a)
1192+-- >>> :set -XOverloadedStrings