@@ -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,41 @@
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 ()
23+import Prelude ()
22import Prelude.Compat
24import Prelude.Compat
24import Control.Applicative
26import Control.Applicative
25−import Control.Arrow
27+import Control.Arrow (second)
27−import Control.Lens
28+import Control.Lens (makeLenses, mapped, over,
28− (makeLenses, mapped, each, over, set, to, toListOf, traversed, view,
29+ traversed, view, (%~), (&), (.~),
29− _1, (%~), (&), (.~), (<>~), (^.), (|>))
30+ (<>~), (^.), (|>))
31+import qualified Control.Monad.Omega as Omega
30import qualified Data.ByteString.Char8 as BSC
32import qualified Data.ByteString.Char8 as BSC
31−import Data.ByteString.Lazy.Char8
33+import Data.ByteString.Lazy.Char8 (ByteString)
33import qualified Data.CaseInsensitive as CI
34import qualified Data.CaseInsensitive as CI
34−import Data.Foldable
35+import Data.Foldable (fold)
36−import Data.Hashable
36+import Data.Hashable (Hashable)
38−import Data.HashMap.Strict
37+import Data.HashMap.Strict (HashMap)
40−import Data.List.Compat
41− (intercalate, intersperse, sort)
38+import Data.List.Compat (intercalate, intersperse, sort)
42−import Data.List.NonEmpty
39+import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)
43− (NonEmpty ((:|)), groupWith)
44import qualified Data.List.NonEmpty as NE
40import qualified Data.List.NonEmpty as NE
45import Data.Maybe
41import Data.Maybe
46−import Data.Monoid
42+import Data.Monoid (All (..), Any (..), Dual (..),
47− (All (..), Any (..), Dual (..), First (..), Last (..),
43+ First (..), Last (..),
48− Product (..), Sum (..))
44+ Product (..), Sum (..))
49−import Data.Ord
45+import Data.Ord (comparing)
51−import Data.Proxy
46+import Data.Proxy (Proxy (Proxy))
52− (Proxy (Proxy))
47+import Data.Semigroup (Semigroup (..))
53−import Data.String.Conversions
48+import Data.String.Conversions (cs)
55−import Data.Text
49+import Data.Text (Text, unpack)
57import GHC.Generics
50import 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
51import GHC.TypeLits
62import Servant.API
52import Servant.API
63import Servant.API.ContentTypes
53import Servant.API.ContentTypes
64import Servant.API.TypeLevel
54import Servant.API.TypeLevel
65−import Servant.API.Generic
67−import qualified Data.Universe.Helpers as U
69import qualified Data.HashMap.Strict as HM
56import qualified Data.HashMap.Strict as HM
70import qualified Data.Text as T
57import qualified Data.Text as T
@@ -77,15 +64,14 @@ import qualified Network.HTTP.Types as HTTP
77-- or any 'Endpoint' value you want using the 'path' and 'method'
64-- or any 'Endpoint' value you want using the 'path' and 'method'
78-- lenses to tweak.
65-- lenses to tweak.
80−-- >>> defEndpoint
68+-- λ> 'defEndpoint'
83−-- >>> defEndpoint & path <>~ ["foo"]
70+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
84−-- "GET" /foo
71+-- GET /foo
86−-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
72+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
87−-- "POST" /foo
73+-- POST /foo
89data Endpoint = Endpoint
75data Endpoint = Endpoint
90 { _path :: [String] -- type collected
76 { _path :: [String] -- type collected
91 , _method :: HTTP.Method -- type collected
77 , _method :: HTTP.Method -- type collected
@@ -106,15 +92,14 @@ showPath ps = concatMap ('/' :) ps
107-- Here's how you can modify it:
93-- Here's how you can modify it:
109−-- >>> defEndpoint
96+-- λ> 'defEndpoint'
110−-- "GET" /
97+-- GET /
112−-- >>> defEndpoint & path <>~ ["foo"]
98+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
113−-- "GET" /foo
99+-- GET /foo
115−-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
100+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
116−-- "POST" /foo
101+-- POST /foo
118defEndpoint :: Endpoint
103defEndpoint :: Endpoint
119defEndpoint = Endpoint [] HTTP.methodGet
104defEndpoint = Endpoint [] HTTP.methodGet
@@ -131,8 +116,7 @@ instance Semigroup API where
131 (<>) = mappend
116 (<>) = mappend
133instance Monoid API where
118instance Monoid API where
134− API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)
119+ API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2) (b1 `mappend` b2)
135− (HM.unionWith combineAction b1 b2)
136 mempty = API mempty mempty
120 mempty = API mempty mempty
138-- | An empty 'API'
122-- | An empty 'API'
@@ -161,20 +145,6 @@ data DocQueryParam = DocQueryParam
161 , _paramKind :: ParamKind
145 , _paramKind :: ParamKind
162 } deriving (Eq, Ord, Show)
146 } 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
148-- | An introductory paragraph for your documentation. You can pass these to
179-- 'docsWithIntros'.
149-- 'docsWithIntros'.
180data DocIntro = DocIntro
150data DocIntro = DocIntro
@@ -240,14 +210,12 @@ data ParamKind = Normal | List | Flag
240-- want to write a 'ToSample' instance for the type that'll be represented
210-- want to write a 'ToSample' instance for the type that'll be represented
241-- as encoded data in the response.
211-- as encoded data in the response.
243−-- Can be tweaked with four lenses.
213+-- 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 = []}
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\" }")]}
251data Response = Response
219data Response = Response
252 { _respStatus :: Int
220 { _respStatus :: Int
253 , _respTypes :: [M.MediaType]
221 , _respTypes :: [M.MediaType]
@@ -255,25 +223,14 @@ data Response = Response
255 , _respHeaders :: [HTTP.Header]
223 , _respHeaders :: [HTTP.Header]
256 } deriving (Eq, Ord, Show)
224 } 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')
267-- | Default response: status code 200, no response body.
226-- | Default response: status code 200, no response body.
269−-- Can be tweaked with four lenses.
228+-- Can be tweaked with two 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 "[]"}
277defResponse :: Response
234defResponse :: Response
278defResponse = Response
235defResponse = Response
279 { _respStatus = 200
236 { _respStatus = 200
@@ -295,9 +252,8 @@ defResponse = Response
295data Action = Action
252data Action = Action
296 { _authInfo :: [DocAuthentication] -- user supplied info
253 { _authInfo :: [DocAuthentication] -- user supplied info
297 , _captures :: [DocCapture] -- type collected + user supplied info
254 , _captures :: [DocCapture] -- type collected + user supplied info
298− , _headers :: [HTTP.Header] -- type collected
255+ , _headers :: [Text] -- type collected
299 , _params :: [DocQueryParam] -- type collected + user supplied info
256 , _params :: [DocQueryParam] -- type collected + user supplied info
300− , _fragment :: Maybe DocFragment -- type collected + user supplied info
301 , _notes :: [DocNote] -- user supplied
257 , _notes :: [DocNote] -- user supplied
302 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
258 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
303 , _rqtypes :: [M.MediaType] -- type collected
259 , _rqtypes :: [M.MediaType] -- type collected
@@ -309,30 +265,27 @@ data Action = Action
311-- As such, we invent a non-commutative, left associative operation
267-- As such, we invent a non-commutative, left associative operation
312−-- 'combineAction' to mush two together taking the response from the very left.
268+-- 'combineAction' to mush two together taking the response, body and content
269+-- types from the very left.
313combineAction :: Action -> Action -> Action
270combineAction :: Action -> Action -> Action
314−Action a c h p f n m ts body resp
271+Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
315− `combineAction` Action a' c' h' p' f' 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')
272+ Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
318-- | Default 'Action'. Has no 'captures', no query 'params', expects
274-- | Default 'Action'. Has no 'captures', no query 'params', expects
319-- no request body ('rqbody') and the typical response is 'defResponse'.
275-- no request body ('rqbody') and the typical response is 'defResponse'.
321-- Tweakable with lenses.
277-- Tweakable with lenses.
323−-- >>> defAction
279+-- > λ> defAction
324−-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
280+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
326−-- >>> defAction & response.respStatus .~ 201
281+-- > λ> defAction & response.respStatus .~ 201
327−-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
282+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
329defAction :: Action
283defAction :: Action
330defAction =
284defAction =
331 Action []
285 Action []
@@ -356,14 +309,12 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten
357-- @since 0.11.1
310-- @since 0.11.1
358data RenderingOptions = RenderingOptions
311data RenderingOptions = RenderingOptions
359− { _requestExamples :: !ShowContentTypes
312+ { _requestExamples :: !ShowContentTypes
360 -- ^ How many content types to display for request body examples?
313 -- ^ How many content types to display for request body examples?
361− , _responseExamples :: !ShowContentTypes
314+ , _responseExamples :: !ShowContentTypes
362 -- ^ How many content types to display for response body examples?
315 -- ^ How many content types to display for response body examples?
363− , _notesHeading :: !(Maybe String)
316+ , _notesHeading :: !(Maybe String)
364 -- ^ Optionally group all 'notes' together under a common heading.
317 -- ^ 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)
318 } deriving (Show)
369-- | Default API generation options.
320-- | Default API generation options.
@@ -375,10 +326,9 @@ data RenderingOptions = RenderingOptions
375-- @since 0.11.1
326-- @since 0.11.1
376defRenderingOptions :: RenderingOptions
327defRenderingOptions :: RenderingOptions
377defRenderingOptions = RenderingOptions
328defRenderingOptions = RenderingOptions
378− { _requestExamples = AllContentTypes
329+ { _requestExamples = AllContentTypes
379− , _responseExamples = AllContentTypes
330+ , _responseExamples = AllContentTypes
380− , _notesHeading = Nothing
331+ , _notesHeading = Nothing
381− , _renderCurlBasePath = Nothing
384-- gimme some lenses
334-- gimme some lenses
@@ -388,7 +338,6 @@ makeLenses ''API
388makeLenses ''Endpoint
338makeLenses ''Endpoint
389makeLenses ''DocCapture
339makeLenses ''DocCapture
390makeLenses ''DocQueryParam
340makeLenses ''DocQueryParam
391−makeLenses ''DocFragment
392makeLenses ''DocIntro
341makeLenses ''DocIntro
393makeLenses ''DocNote
342makeLenses ''DocNote
394makeLenses ''Response
343makeLenses ''Response
@@ -398,8 +347,7 @@ makeLenses ''RenderingOptions
398-- | Generate the docs for a given API that implements 'HasDocs'. This is the
347-- | Generate the docs for a given API that implements 'HasDocs'. This is the
399-- default way to create documentation.
348-- default way to create documentation.
401−-- > docs == docsWithOptions defaultDocOptions
350+-- prop> docs == docsWithOptions defaultDocOptions
403docs :: HasDocs api => Proxy api -> API
351docs :: HasDocs api => Proxy api -> API
404docs p = docsWithOptions p defaultDocOptions
352docs p = docsWithOptions p defaultDocOptions
@@ -415,9 +363,9 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)
415-- > extra :: ExtraInfo TestApi
363-- > extra :: ExtraInfo TestApi
416-- > extra =
364-- > extra =
417-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
365-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
418−-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]
366+-- > defAction & headers <>~ ["unicorns"]
419-- > & notes <>~ [ DocNote "Title" ["This is some text"]
367-- > & notes <>~ [ DocNote "Title" ["This is some text"]
420−-- > , DocNote "Second section" ["And some more"]
368+-- > , DocNote "Second secton" ["And some more"]
423extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
371extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
@@ -447,7 +395,7 @@ docsWith opts intros (ExtraInfo endpoints) p =
447 & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
395 & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
450−-- | Generate the docs for a given API that implements 'HasDocs' with any
398+-- | Generate the docs for a given API that implements 'HasDocs' with with any
451-- number of introduction(s)
399-- number of introduction(s)
452docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
400docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
453docsWithIntros intros = docsWith defaultDocOptions intros mempty
401docsWithIntros intros = docsWith defaultDocOptions intros mempty
@@ -510,22 +458,22 @@ samples = map ("",)
511-- | Default sample Generic-based inputs/outputs.
459-- | Default sample Generic-based inputs/outputs.
512defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
460defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
513−defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))
461+defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
515-- | @'ToSample'@ for Generics.
463-- | @'ToSample'@ for Generics.
517−-- Note: we use combinators from "Universe.Data.Helpers" for more productive sample generation.
465+-- The use of @'Omega'@ allows for more productive sample generation.
518class GToSample t where
466class GToSample t where
519− gtoSamples :: proxy t -> [(Text, t x)]
467+ gtoSamples :: proxy t -> Omega.Omega (Text, t x)
521instance GToSample U1 where
469instance GToSample U1 where
522− gtoSamples _ = singleSample U1
470+ gtoSamples _ = Omega.each (singleSample U1)
524instance GToSample V1 where
472instance GToSample V1 where
525 gtoSamples _ = empty
473 gtoSamples _ = empty
527instance (GToSample p, GToSample q) => GToSample (p :*: q) where
475instance (GToSample p, GToSample q) => GToSample (p :*: q) where
528− gtoSamples _ = U.cartesianProduct render ps qs
476+ gtoSamples _ = render <$> ps <*> qs
530 ps = gtoSamples (Proxy :: Proxy p)
478 ps = gtoSamples (Proxy :: Proxy p)
531 qs = gtoSamples (Proxy :: Proxy q)
479 qs = gtoSamples (Proxy :: Proxy q)
@@ -534,13 +482,13 @@ instance (GToSample p, GToSample q) => GToSample (p :*: q) where
534 | otherwise = (ta <> ", " <> tb, a :*: b)
482 | otherwise = (ta <> ", " <> tb, a :*: b)
536instance (GToSample p, GToSample q) => GToSample (p :+: q) where
484instance (GToSample p, GToSample q) => GToSample (p :+: q) where
537− gtoSamples _ = lefts U.+++ rights
485+ gtoSamples _ = lefts <|> rights
539 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
487 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
540 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
488 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
542instance ToSample a => GToSample (K1 i a) where
490instance ToSample a => GToSample (K1 i a) where
543− gtoSamples _ = second K1 <$> toSamples (Proxy :: Proxy a)
491+ gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
545instance (GToSample f) => GToSample (M1 i a f) where
493instance (GToSample f) => GToSample (M1 i a f) where
546 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
494 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
@@ -608,15 +556,6 @@ class ToCapture c where
608class ToAuthInfo a where
556class ToAuthInfo a where
609 toAuthInfo :: Proxy a -> DocAuthentication
557 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
559-- | Generate documentation in Markdown format for
621-- the given 'API'.
560-- the given 'API'.
@@ -646,7 +585,7 @@ markdown = markdownWith defRenderingOptions
647-- @since 0.11.1
586-- @since 0.11.1
648markdownWith :: RenderingOptions -> API -> String
587markdownWith :: RenderingOptions -> API -> String
649−markdownWith RenderingOptions{..} api = unlines $
588+markdownWith RenderingOptions{..} api = unlines $
650 introsStr (api ^. apiIntros)
589 introsStr (api ^. apiIntros)
651 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
590 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
@@ -657,12 +596,10 @@ markdownWith RenderingOptions{..} api = unlines $
657 notesStr (action ^. notes) ++
596 notesStr (action ^. notes) ++
658 authStr (action ^. authInfo) ++
597 authStr (action ^. authInfo) ++
659 capturesStr (action ^. captures) ++
598 capturesStr (action ^. captures) ++
660− headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++
599+ headersStr (action ^. headers) ++
661 paramsStr meth (action ^. params) ++
600 paramsStr meth (action ^. params) ++
662− fragmentStr (action ^. fragment) ++
663 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
601 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
664 responseStr (action ^. response) ++
602 responseStr (action ^. response) ++
665− maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++
668 where str = "## " ++ BSC.unpack meth
605 where str = "## " ++ BSC.unpack meth
@@ -762,14 +699,6 @@ markdownWith RenderingOptions{..} api = unlines $
763 where values = param ^. paramValues
700 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]
702 rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
774 rqbodyStr [] [] = []
703 rqbodyStr [] [] = []
775 rqbodyStr types s =
704 rqbodyStr types s =
@@ -818,11 +747,12 @@ markdownWith RenderingOptions{..} api = unlines $
818 ("text", "css") -> "css"
747 ("text", "css") -> "css"
819 (_, _) -> ""
748 (_, _) -> ""
821 contentStr mime_type body =
751 contentStr mime_type body =
823− "```" <> markdownForType mime_type :
753+ " ```" <> markdownForType mime_type :
824 cs body :
754 cs body :
825− "```" :
755+ " ```" :
@@ -842,41 +772,11 @@ markdownWith RenderingOptions{..} api = unlines $
843 formatBodies _responseExamples xs
773 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
775-- * Instances
877-- | The generated docs for @a ':<|>' b@ just appends the docs
777-- | The generated docs for @a ':<|>' b@ just appends the docs
878-- for @a@ with the docs for @b@.
778-- for @a@ with the docs for @b@.
879−instance {-# OVERLAPPABLE #-}
779+instance OVERLAPPABLE_
880 (HasDocs a, HasDocs b)
780 (HasDocs a, HasDocs b)
881 => HasDocs (a :<|> b) where
781 => HasDocs (a :<|> b) where
@@ -895,7 +795,7 @@ instance HasDocs EmptyAPI where
895-- | @"books" :> 'Capture' "isbn" Text@ will appear as
795-- | @"books" :> 'Capture' "isbn" Text@ will appear as
896-- @/books/:isbn@ in the docs.
796-- @/books/:isbn@ in the docs.
897instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
797instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
898− => HasDocs (Capture' '[] sym a :> api) where
798+ => HasDocs (Capture' mods sym a :> api) where
900 docsFor Proxy (endpoint, action) =
800 docsFor Proxy (endpoint, action) =
901 docsFor subApiP (endpoint', action')
801 docsFor subApiP (endpoint', action')
@@ -907,28 +807,6 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
907 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
807 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
908 symP = Proxy :: Proxy sym
808 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
811-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as
934-- @/books/:isbn@ in the docs.
812-- @/books/:isbn@ in the docs.
@@ -946,7 +824,7 @@ instance (KnownSymbol sym, ToCapture (CaptureAll sym a), HasDocs sublayout)
946 symP = Proxy :: Proxy sym
824 symP = Proxy :: Proxy sym
949−instance {-# OVERLAPPABLE #-}
827+instance OVERLAPPABLE_
950 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
828 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
951 , ReflectMethod method)
829 , ReflectMethod method)
952 => HasDocs (Verb method status (ct ': cts) a) where
830 => HasDocs (Verb method status (ct ': cts) a) where
@@ -962,37 +840,7 @@ instance {-# OVERLAPPABLE #-}
962 status = fromInteger $ natVal (Proxy :: Proxy status)
840 status = fromInteger $ natVal (Proxy :: Proxy status)
963 p = Proxy :: Proxy a
841 p = Proxy :: Proxy a
965−instance (ReflectMethod method) =>
843+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
844 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
997 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
845 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
998 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
846 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
@@ -1010,17 +858,14 @@ instance {-# OVERLAPPING #-}
1010 status = fromInteger $ natVal (Proxy :: Proxy status)
858 status = fromInteger $ natVal (Proxy :: Proxy status)
1011 p = Proxy :: Proxy a
859 p = Proxy :: Proxy a
1013−instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)
861+instance (KnownSymbol sym, HasDocs api)
1014 => HasDocs (Header' mods sym a :> api) where
862 => HasDocs (Header' mods sym a :> api) where
1015 docsFor Proxy (endpoint, action) =
863 docsFor Proxy (endpoint, action) =
1016 docsFor subApiP (endpoint, action')
864 docsFor subApiP (endpoint, action')
1018 where subApiP = Proxy :: Proxy api
866 where subApiP = Proxy :: Proxy api
1019− action' = over headers (|> (headerName, headerVal)) action
867+ action' = over headers (|> headername) action
1020− headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)
868+ 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)
870instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
1026 => HasDocs (QueryParam' mods sym a :> api) where
871 => HasDocs (QueryParam' mods sym a :> api) where
@@ -1053,15 +898,6 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
1053 paramP = Proxy :: Proxy (QueryFlag sym)
898 paramP = Proxy :: Proxy (QueryFlag sym)
1054 action' = over params (|> toParam paramP) action
899 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
902instance HasDocs Raw where
1067 docsFor _proxy (endpoint, action) _ =
903 docsFor _proxy (endpoint, action) _ =
@@ -1094,6 +930,7 @@ instance (KnownSymbol desc, HasDocs api)
1094-- both are even defined) for any particular type.
930-- both are even defined) for any particular type.
1095instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
931instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
1096 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
932 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
1097 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
934 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
1098 docsFor subApiP (endpoint, action') opts
935 docsFor subApiP (endpoint, action') opts
@@ -1104,18 +941,6 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
1104 t = Proxy :: Proxy (ct ': cts)
941 t = Proxy :: Proxy (ct ': cts)
1105 p = Proxy :: Proxy a
942 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
944instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
1121 docsFor Proxy (endpoint, action) =
946 docsFor Proxy (endpoint, action) =
@@ -1144,9 +969,6 @@ instance HasDocs api => HasDocs (Vault :> api) where
1144instance HasDocs api => HasDocs (WithNamedContext name context api) where
969instance HasDocs api => HasDocs (WithNamedContext name context api) where
1145 docsFor Proxy = docsFor (Proxy :: Proxy api)
970 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
972instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
1151 docsFor Proxy (endpoint, action) =
973 docsFor Proxy (endpoint, action) =
1152 docsFor (Proxy :: Proxy api) (endpoint, action')
974 docsFor (Proxy :: Proxy api) (endpoint, action')
@@ -1154,9 +976,6 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
1154 authProxy = Proxy :: Proxy (BasicAuth realm usr)
976 authProxy = Proxy :: Proxy (BasicAuth realm usr)
1155 action' = over authInfo (|> toAuthInfo authProxy) action
977 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
979-- ToSample instances for simple types
1161instance ToSample NoContent
980instance ToSample NoContent
1162instance ToSample Bool
981instance ToSample Bool
@@ -1173,7 +992,6 @@ instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f
1173instance ToSample a => ToSample (Maybe a)
992instance ToSample a => ToSample (Maybe a)
1174instance (ToSample a, ToSample b) => ToSample (Either a b)
993instance (ToSample a, ToSample b) => ToSample (Either a b)
1175instance ToSample a => ToSample [a]
994instance ToSample a => ToSample [a]
1176−instance ToSample a => ToSample (NonEmpty a)
1178-- ToSample instances for Control.Applicative types
996-- ToSample instances for Control.Applicative types
1179instance ToSample a => ToSample (Const a b)
997instance ToSample a => ToSample (Const a b)
@@ -1187,6 +1005,3 @@ instance ToSample a => ToSample (Product a)
1187instance ToSample a => ToSample (First a)
1005instance ToSample a => ToSample (First a)
1188instance ToSample a => ToSample (Last a)
1006instance ToSample a => ToSample (Last a)
1189instance ToSample a => ToSample (Dual a)
1007instance ToSample a => ToSample (Dual a)
1192−-- >>> :set -XOverloadedStrings