@@ -1,3 +1,4 @@
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DefaultSignatures #-}
4{-# LANGUAGE DefaultSignatures #-}
@@ -16,55 +17,42 @@
16{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE UndecidableInstances #-}
18{-# LANGUAGE UndecidableInstances #-}
20+#include "overlapping-compat.h"
19module Servant.Docs.Internal where
21module Servant.Docs.Internal where
21−import Prelude ()
24+import Prelude ()
22import Prelude.Compat
25import Prelude.Compat
24import Control.Applicative
27import Control.Applicative
25−import Control.Arrow
28+import Control.Arrow (second)
27−import Control.Lens
29+import Control.Lens (makeLenses, mapped, over,
28− (makeLenses, mapped, each, over, set, to, toListOf, traversed, view,
30+ traversed, view, (%~), (&), (.~),
29− _1, (%~), (&), (.~), (<>~), (^.), (|>))
31+ (<>~), (^.), (|>))
32+import qualified Control.Monad.Omega as Omega
30import qualified Data.ByteString.Char8 as BSC
33import qualified Data.ByteString.Char8 as BSC
31−import Data.ByteString.Lazy.Char8
34+import Data.ByteString.Lazy.Char8 (ByteString)
33import qualified Data.CaseInsensitive as CI
35import qualified Data.CaseInsensitive as CI
34−import Data.Foldable
36+import Data.Foldable (fold)
36−import Data.Hashable
37+import Data.Hashable (Hashable)
38−import Data.HashMap.Strict
38+import Data.HashMap.Strict (HashMap)
40−import Data.List.Compat
41− (intercalate, intersperse, sort)
39+import Data.List.Compat (intercalate, intersperse, sort)
42−import Data.List.NonEmpty
40+import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)
43− (NonEmpty ((:|)), groupWith)
44import qualified Data.List.NonEmpty as NE
41import qualified Data.List.NonEmpty as NE
45import Data.Maybe
42import Data.Maybe
46−import Data.Monoid
43+import Data.Monoid (All (..), Any (..), Dual (..),
47− (All (..), Any (..), Dual (..), First (..), Last (..),
44+ First (..), Last (..),
48− Product (..), Sum (..))
45+ Product (..), Sum (..))
49−import Data.Ord
46+import Data.Ord (comparing)
51−import Data.Proxy
47+import Data.Proxy (Proxy (Proxy))
52− (Proxy (Proxy))
48+import Data.Semigroup (Semigroup (..))
53−import Data.String.Conversions
49+import Data.String.Conversions (cs)
55−import Data.Text
50+import Data.Text (Text, unpack)
57import GHC.Generics
51import GHC.Generics
58− (Generic, Rep, K1(K1), M1(M1), U1(U1), V1,
59− (:*:)((:*:)), (:+:)(L1, R1))
60−import qualified GHC.Generics as G
61import GHC.TypeLits
52import GHC.TypeLits
62import Servant.API
53import Servant.API
63import Servant.API.ContentTypes
54import Servant.API.ContentTypes
64import Servant.API.TypeLevel
55import Servant.API.TypeLevel
65−import Servant.API.Generic
67−import qualified Data.Universe.Helpers as U
69import qualified Data.HashMap.Strict as HM
57import qualified Data.HashMap.Strict as HM
70import qualified Data.Text as T
58import qualified Data.Text as T
@@ -77,15 +65,14 @@ import qualified Network.HTTP.Types as HTTP
77-- or any 'Endpoint' value you want using the 'path' and 'method'
65-- or any 'Endpoint' value you want using the 'path' and 'method'
78-- lenses to tweak.
66-- lenses to tweak.
80−-- >>> defEndpoint
69+-- λ> 'defEndpoint'
83−-- >>> defEndpoint & path <>~ ["foo"]
71+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
84−-- "GET" /foo
72+-- GET /foo
86−-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
73+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
87−-- "POST" /foo
74+-- POST /foo
89data Endpoint = Endpoint
76data Endpoint = Endpoint
90 { _path :: [String] -- type collected
77 { _path :: [String] -- type collected
91 , _method :: HTTP.Method -- type collected
78 , _method :: HTTP.Method -- type collected
@@ -106,15 +93,14 @@ showPath ps = concatMap ('/' :) ps
107-- Here's how you can modify it:
94-- Here's how you can modify it:
109−-- >>> defEndpoint
97+-- λ> 'defEndpoint'
110−-- "GET" /
98+-- GET /
112−-- >>> defEndpoint & path <>~ ["foo"]
99+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
113−-- "GET" /foo
100+-- GET /foo
115−-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
101+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
116−-- "POST" /foo
102+-- POST /foo
118defEndpoint :: Endpoint
104defEndpoint :: Endpoint
119defEndpoint = Endpoint [] HTTP.methodGet
105defEndpoint = Endpoint [] HTTP.methodGet
@@ -132,7 +118,7 @@ instance Semigroup API where
133instance Monoid API where
119instance Monoid API where
134 API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)
120 API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)
135− (HM.unionWith combineAction b1 b2)
121+ (HM.unionWith combineAction b1 (traceShowId b2))
136 mempty = API mempty mempty
122 mempty = API mempty mempty
138-- | An empty 'API'
124-- | An empty 'API'
@@ -161,20 +147,6 @@ data DocQueryParam = DocQueryParam
161 , _paramKind :: ParamKind
147 , _paramKind :: ParamKind
162 } deriving (Eq, Ord, Show)
148 } 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
178-- | An introductory paragraph for your documentation. You can pass these to
150-- | An introductory paragraph for your documentation. You can pass these to
179-- 'docsWithIntros'.
151-- 'docsWithIntros'.
180data DocIntro = DocIntro
152data DocIntro = DocIntro
@@ -240,14 +212,12 @@ data ParamKind = Normal | List | Flag
240-- want to write a 'ToSample' instance for the type that'll be represented
212-- want to write a 'ToSample' instance for the type that'll be represented
241-- as encoded data in the response.
213-- as encoded data in the response.
243−-- Can be tweaked with four lenses.
215+-- Can be tweaked with three 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 = []}
218+-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
219+-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
220+-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
251data Response = Response
221data Response = Response
252 { _respStatus :: Int
222 { _respStatus :: Int
253 , _respTypes :: [M.MediaType]
223 , _respTypes :: [M.MediaType]
@@ -266,14 +236,12 @@ Response s ts bs hs `combineResponse` Response _ ts' bs' hs'
267-- | Default response: status code 200, no response body.
237-- | Default response: status code 200, no response body.
269−-- Can be tweaked with four lenses.
239+-- Can be tweaked with two lenses.
272−-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
274−-- >>> defResponse & respStatus .~ 204
275−-- Response {_respStatus = 204, _respTypes = [], _respBody = [], _respHeaders = []}
242+-- > Response {_respStatus = 200, _respBody = Nothing}
243+-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
244+-- > Response {_respStatus = 204, _respBody = Just "[]"}
277defResponse :: Response
245defResponse :: Response
278defResponse = Response
246defResponse = Response
279 { _respStatus = 200
247 { _respStatus = 200
@@ -295,9 +263,8 @@ defResponse = Response
295data Action = Action
263data Action = Action
296 { _authInfo :: [DocAuthentication] -- user supplied info
264 { _authInfo :: [DocAuthentication] -- user supplied info
297 , _captures :: [DocCapture] -- type collected + user supplied info
265 , _captures :: [DocCapture] -- type collected + user supplied info
298− , _headers :: [HTTP.Header] -- type collected
266+ , _headers :: [Text] -- type collected
299 , _params :: [DocQueryParam] -- type collected + user supplied info
267 , _params :: [DocQueryParam] -- type collected + user supplied info
300− , _fragment :: Maybe DocFragment -- type collected + user supplied info
301 , _notes :: [DocNote] -- user supplied
268 , _notes :: [DocNote] -- user supplied
302 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
269 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
303 , _rqtypes :: [M.MediaType] -- type collected
270 , _rqtypes :: [M.MediaType] -- type collected
@@ -311,28 +278,24 @@ data Action = Action
311-- As such, we invent a non-commutative, left associative operation
278-- As such, we invent a non-commutative, left associative operation
312-- 'combineAction' to mush two together taking the response from the very left.
279-- 'combineAction' to mush two together taking the response from the very left.
313combineAction :: Action -> Action -> Action
280combineAction :: Action -> Action -> Action
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' =
281+Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' 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')
282+ Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') (ts <> ts') (body <> body') (resp `combineResponse` resp')
318-- | Default 'Action'. Has no 'captures', no query 'params', expects
284-- | Default 'Action'. Has no 'captures', no query 'params', expects
319-- no request body ('rqbody') and the typical response is 'defResponse'.
285-- no request body ('rqbody') and the typical response is 'defResponse'.
321-- Tweakable with lenses.
287-- Tweakable with lenses.
323−-- >>> defAction
289+-- > λ> defAction
324−-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
290+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
326−-- >>> defAction & response.respStatus .~ 201
291+-- > λ> defAction & response.respStatus .~ 201
327−-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
292+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
329defAction :: Action
293defAction :: Action
330defAction =
294defAction =
331 Action []
295 Action []
@@ -356,14 +319,12 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten
357-- @since 0.11.1
320-- @since 0.11.1
358data RenderingOptions = RenderingOptions
321data RenderingOptions = RenderingOptions
359− { _requestExamples :: !ShowContentTypes
322+ { _requestExamples :: !ShowContentTypes
360 -- ^ How many content types to display for request body examples?
323 -- ^ How many content types to display for request body examples?
361− , _responseExamples :: !ShowContentTypes
324+ , _responseExamples :: !ShowContentTypes
362 -- ^ How many content types to display for response body examples?
325 -- ^ How many content types to display for response body examples?
363− , _notesHeading :: !(Maybe String)
326+ , _notesHeading :: !(Maybe String)
364 -- ^ Optionally group all 'notes' together under a common heading.
327 -- ^ 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`).
367 } deriving (Show)
328 } deriving (Show)
369-- | Default API generation options.
330-- | Default API generation options.
@@ -375,10 +336,9 @@ data RenderingOptions = RenderingOptions
375-- @since 0.11.1
336-- @since 0.11.1
376defRenderingOptions :: RenderingOptions
337defRenderingOptions :: RenderingOptions
377defRenderingOptions = RenderingOptions
338defRenderingOptions = RenderingOptions
378− { _requestExamples = AllContentTypes
339+ { _requestExamples = AllContentTypes
379− , _responseExamples = AllContentTypes
340+ , _responseExamples = AllContentTypes
380− , _notesHeading = Nothing
341+ , _notesHeading = Nothing
381− , _renderCurlBasePath = Nothing
384-- gimme some lenses
344-- gimme some lenses
@@ -388,7 +348,6 @@ makeLenses ''API
388makeLenses ''Endpoint
348makeLenses ''Endpoint
389makeLenses ''DocCapture
349makeLenses ''DocCapture
390makeLenses ''DocQueryParam
350makeLenses ''DocQueryParam
391−makeLenses ''DocFragment
392makeLenses ''DocIntro
351makeLenses ''DocIntro
393makeLenses ''DocNote
352makeLenses ''DocNote
394makeLenses ''Response
353makeLenses ''Response
@@ -398,8 +357,7 @@ makeLenses ''RenderingOptions
398-- | Generate the docs for a given API that implements 'HasDocs'. This is the
357-- | Generate the docs for a given API that implements 'HasDocs'. This is the
399-- default way to create documentation.
358-- default way to create documentation.
401−-- > docs == docsWithOptions defaultDocOptions
360+-- prop> docs == docsWithOptions defaultDocOptions
403docs :: HasDocs api => Proxy api -> API
361docs :: HasDocs api => Proxy api -> API
404docs p = docsWithOptions p defaultDocOptions
362docs p = docsWithOptions p defaultDocOptions
@@ -415,9 +373,9 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)
415-- > extra :: ExtraInfo TestApi
373-- > extra :: ExtraInfo TestApi
416-- > extra =
374-- > extra =
417-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
375-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
418−-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]
376+-- > defAction & headers <>~ ["unicorns"]
419-- > & notes <>~ [ DocNote "Title" ["This is some text"]
377-- > & notes <>~ [ DocNote "Title" ["This is some text"]
420−-- > , DocNote "Second section" ["And some more"]
378+-- > , DocNote "Second secton" ["And some more"]
423extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
381extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
@@ -447,7 +405,7 @@ docsWith opts intros (ExtraInfo endpoints) p =
447 & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
405 & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
450−-- | Generate the docs for a given API that implements 'HasDocs' with any
408+-- | Generate the docs for a given API that implements 'HasDocs' with with any
451-- number of introduction(s)
409-- number of introduction(s)
452docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
410docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
453docsWithIntros intros = docsWith defaultDocOptions intros mempty
411docsWithIntros intros = docsWith defaultDocOptions intros mempty
@@ -510,22 +468,22 @@ samples = map ("",)
511-- | Default sample Generic-based inputs/outputs.
469-- | Default sample Generic-based inputs/outputs.
512defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
470defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
513−defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))
471+defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
515-- | @'ToSample'@ for Generics.
473-- | @'ToSample'@ for Generics.
517−-- Note: we use combinators from "Universe.Data.Helpers" for more productive sample generation.
475+-- The use of @'Omega'@ allows for more productive sample generation.
518class GToSample t where
476class GToSample t where
519− gtoSamples :: proxy t -> [(Text, t x)]
477+ gtoSamples :: proxy t -> Omega.Omega (Text, t x)
521instance GToSample U1 where
479instance GToSample U1 where
522− gtoSamples _ = singleSample U1
480+ gtoSamples _ = Omega.each (singleSample U1)
524instance GToSample V1 where
482instance GToSample V1 where
525 gtoSamples _ = empty
483 gtoSamples _ = empty
527instance (GToSample p, GToSample q) => GToSample (p :*: q) where
485instance (GToSample p, GToSample q) => GToSample (p :*: q) where
528− gtoSamples _ = U.cartesianProduct render ps qs
486+ gtoSamples _ = render <$> ps <*> qs
530 ps = gtoSamples (Proxy :: Proxy p)
488 ps = gtoSamples (Proxy :: Proxy p)
531 qs = gtoSamples (Proxy :: Proxy q)
489 qs = gtoSamples (Proxy :: Proxy q)
@@ -534,13 +492,13 @@ instance (GToSample p, GToSample q) => GToSample (p :*: q) where
534 | otherwise = (ta <> ", " <> tb, a :*: b)
492 | otherwise = (ta <> ", " <> tb, a :*: b)
536instance (GToSample p, GToSample q) => GToSample (p :+: q) where
494instance (GToSample p, GToSample q) => GToSample (p :+: q) where
537− gtoSamples _ = lefts U.+++ rights
495+ gtoSamples _ = lefts <|> rights
539 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
497 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
540 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
498 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
542instance ToSample a => GToSample (K1 i a) where
500instance ToSample a => GToSample (K1 i a) where
543− gtoSamples _ = second K1 <$> toSamples (Proxy :: Proxy a)
501+ gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
545instance (GToSample f) => GToSample (M1 i a f) where
503instance (GToSample f) => GToSample (M1 i a f) where
546 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
504 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
@@ -608,15 +566,6 @@ class ToCapture c where
608class ToAuthInfo a where
566class ToAuthInfo a where
609 toAuthInfo :: Proxy a -> DocAuthentication
567 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
620-- | Generate documentation in Markdown format for
569-- | Generate documentation in Markdown format for
621-- the given 'API'.
570-- the given 'API'.
@@ -646,7 +595,7 @@ markdown = markdownWith defRenderingOptions
647-- @since 0.11.1
596-- @since 0.11.1
648markdownWith :: RenderingOptions -> API -> String
597markdownWith :: RenderingOptions -> API -> String
649−markdownWith RenderingOptions{..} api = unlines $
598+markdownWith RenderingOptions{..} api = unlines $
650 introsStr (api ^. apiIntros)
599 introsStr (api ^. apiIntros)
651 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
600 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
@@ -657,12 +606,10 @@ markdownWith RenderingOptions{..} api = unlines $
657 notesStr (action ^. notes) ++
606 notesStr (action ^. notes) ++
658 authStr (action ^. authInfo) ++
607 authStr (action ^. authInfo) ++
659 capturesStr (action ^. captures) ++
608 capturesStr (action ^. captures) ++
660− headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++
609+ headersStr (action ^. headers) ++
661 paramsStr meth (action ^. params) ++
610 paramsStr meth (action ^. params) ++
662− fragmentStr (action ^. fragment) ++
663 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
611 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
664 responseStr (action ^. response) ++
612 responseStr (action ^. response) ++
665− maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++
668 where str = "## " ++ BSC.unpack meth
615 where str = "## " ++ BSC.unpack meth
@@ -762,14 +709,6 @@ markdownWith RenderingOptions{..} api = unlines $
763 where values = param ^. paramValues
710 where values = param ^. paramValues
765− fragmentStr :: Maybe DocFragment -> [String]
766− fragmentStr Nothing = []
767− fragmentStr (Just frag) =
768− [ "### Fragment:", ""
769− , "- *" ++ (frag ^. fragSymbol) ++ "*: " ++ (frag ^. fragDesc)
773 rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
712 rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
774 rqbodyStr [] [] = []
713 rqbodyStr [] [] = []
775 rqbodyStr types s =
714 rqbodyStr types s =
@@ -818,11 +757,12 @@ markdownWith RenderingOptions{..} api = unlines $
818 ("text", "css") -> "css"
757 ("text", "css") -> "css"
819 (_, _) -> ""
758 (_, _) -> ""
821 contentStr mime_type body =
761 contentStr mime_type body =
823− "```" <> markdownForType mime_type :
763+ " ```" <> markdownForType mime_type :
824 cs body :
764 cs body :
825− "```" :
765+ " ```" :
@@ -842,41 +782,11 @@ markdownWith RenderingOptions{..} api = unlines $
843 formatBodies _responseExamples xs
783 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) ++ "\" \\"
875-- * Instances
785-- * Instances
877-- | The generated docs for @a ':<|>' b@ just appends the docs
787-- | The generated docs for @a ':<|>' b@ just appends the docs
878-- for @a@ with the docs for @b@.
788-- for @a@ with the docs for @b@.
879−instance {-# OVERLAPPABLE #-}
789+instance OVERLAPPABLE_
880 (HasDocs a, HasDocs b)
790 (HasDocs a, HasDocs b)
881 => HasDocs (a :<|> b) where
791 => HasDocs (a :<|> b) where
@@ -895,7 +805,7 @@ instance HasDocs EmptyAPI where
895-- | @"books" :> 'Capture' "isbn" Text@ will appear as
805-- | @"books" :> 'Capture' "isbn" Text@ will appear as
896-- @/books/:isbn@ in the docs.
806-- @/books/:isbn@ in the docs.
897instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
807instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
898− => HasDocs (Capture' '[] sym a :> api) where
808+ => HasDocs (Capture' mods sym a :> api) where
900 docsFor Proxy (endpoint, action) =
810 docsFor Proxy (endpoint, action) =
901 docsFor subApiP (endpoint', action')
811 docsFor subApiP (endpoint', action')
@@ -907,28 +817,6 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
907 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
817 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
908 symP = Proxy :: Proxy sym
818 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)
933-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as
821-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as
934-- @/books/:isbn@ in the docs.
822-- @/books/:isbn@ in the docs.
@@ -946,7 +834,7 @@ instance (KnownSymbol sym, ToCapture (CaptureAll sym a), HasDocs sublayout)
946 symP = Proxy :: Proxy sym
834 symP = Proxy :: Proxy sym
949−instance {-# OVERLAPPABLE #-}
837+instance OVERLAPPABLE_
950 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
838 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
951 , ReflectMethod method)
839 , ReflectMethod method)
952 => HasDocs (Verb method status (ct ': cts) a) where
840 => HasDocs (Verb method status (ct ': cts) a) where
@@ -962,37 +850,7 @@ instance {-# OVERLAPPABLE #-}
962 status = fromInteger $ natVal (Proxy :: Proxy status)
850 status = fromInteger $ natVal (Proxy :: Proxy status)
963 p = Proxy :: Proxy a
851 p = Proxy :: Proxy a
965−instance (ReflectMethod method) =>
853+instance OVERLAPPING_
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 #-}
996 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
854 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
997 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
855 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
998 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
856 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
@@ -1010,17 +868,14 @@ instance {-# OVERLAPPING #-}
1010 status = fromInteger $ natVal (Proxy :: Proxy status)
868 status = fromInteger $ natVal (Proxy :: Proxy status)
1011 p = Proxy :: Proxy a
869 p = Proxy :: Proxy a
1013−instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)
871+instance (KnownSymbol sym, HasDocs api)
1014 => HasDocs (Header' mods sym a :> api) where
872 => HasDocs (Header' mods sym a :> api) where
1015 docsFor Proxy (endpoint, action) =
873 docsFor Proxy (endpoint, action) =
1016 docsFor subApiP (endpoint, action')
874 docsFor subApiP (endpoint, action')
1018 where subApiP = Proxy :: Proxy api
876 where subApiP = Proxy :: Proxy api
1019− action' = over headers (|> (headerName, headerVal)) action
877+ action' = over headers (|> headername) action
1020− headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)
878+ headername = T.pack $ symbolVal (Proxy :: Proxy sym)
1021− headerVal = case toSample (Proxy :: Proxy a) of
1022− Just x -> cs $ toHeader x
1023− Nothing -> "<no header sample provided>"
1025instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
880instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
1026 => HasDocs (QueryParam' mods sym a :> api) where
881 => HasDocs (QueryParam' mods sym a :> api) where
@@ -1053,15 +908,6 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
1053 paramP = Proxy :: Proxy (QueryFlag sym)
908 paramP = Proxy :: Proxy (QueryFlag sym)
1054 action' = over params (|> toParam paramP) action
909 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
1066instance HasDocs Raw where
912instance HasDocs Raw where
1067 docsFor _proxy (endpoint, action) _ =
913 docsFor _proxy (endpoint, action) _ =
@@ -1094,6 +940,7 @@ instance (KnownSymbol desc, HasDocs api)
1094-- both are even defined) for any particular type.
940-- both are even defined) for any particular type.
1095instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
941instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
1096 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
942 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
1097 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
944 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
1098 docsFor subApiP (endpoint, action') opts
945 docsFor subApiP (endpoint, action') opts
@@ -1104,18 +951,6 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
1104 t = Proxy :: Proxy (ct ': cts)
951 t = Proxy :: Proxy (ct ': cts)
1105 p = Proxy :: Proxy a
952 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
1119instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
954instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
1121 docsFor Proxy (endpoint, action) =
956 docsFor Proxy (endpoint, action) =
@@ -1144,9 +979,6 @@ instance HasDocs api => HasDocs (Vault :> api) where
1144instance HasDocs api => HasDocs (WithNamedContext name context api) where
979instance HasDocs api => HasDocs (WithNamedContext name context api) where
1145 docsFor Proxy = docsFor (Proxy :: Proxy api)
980 docsFor Proxy = docsFor (Proxy :: Proxy api)
1147−instance HasDocs api => HasDocs (WithResource res :> api) where
1148− docsFor Proxy = docsFor (Proxy :: Proxy api)
1150instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
982instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
1151 docsFor Proxy (endpoint, action) =
983 docsFor Proxy (endpoint, action) =
1152 docsFor (Proxy :: Proxy api) (endpoint, action')
984 docsFor (Proxy :: Proxy api) (endpoint, action')
@@ -1154,9 +986,6 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
1154 authProxy = Proxy :: Proxy (BasicAuth realm usr)
986 authProxy = Proxy :: Proxy (BasicAuth realm usr)
1155 action' = over authInfo (|> toAuthInfo authProxy) action
987 action' = over authInfo (|> toAuthInfo authProxy) action
1157−instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
1158− docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
1160-- ToSample instances for simple types
989-- ToSample instances for simple types
1161instance ToSample NoContent
990instance ToSample NoContent
1162instance ToSample Bool
991instance ToSample Bool
@@ -1173,7 +1002,6 @@ instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f
1173instance ToSample a => ToSample (Maybe a)
1002instance ToSample a => ToSample (Maybe a)
1174instance (ToSample a, ToSample b) => ToSample (Either a b)
1003instance (ToSample a, ToSample b) => ToSample (Either a b)
1175instance ToSample a => ToSample [a]
1004instance ToSample a => ToSample [a]
1176−instance ToSample a => ToSample (NonEmpty a)
1178-- ToSample instances for Control.Applicative types
1006-- ToSample instances for Control.Applicative types
1179instance ToSample a => ToSample (Const a b)
1007instance ToSample a => ToSample (Const a b)
@@ -1187,6 +1015,3 @@ instance ToSample a => ToSample (Product a)
1187instance ToSample a => ToSample (First a)
1015instance ToSample a => ToSample (First a)
1188instance ToSample a => ToSample (Last a)
1016instance ToSample a => ToSample (Last a)
1189instance ToSample a => ToSample (Dual a)
1017instance ToSample a => ToSample (Dual a)
1192−-- >>> :set -XOverloadedStrings