@@ -1,3 +1,4 @@
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DefaultSignatures #-}
4{-# LANGUAGE DefaultSignatures #-}
@@ -16,6 +17,7 @@
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
21import Prelude ()
23import Prelude ()
@@ -25,14 +27,15 @@ import Control.Applicative
25import Control.Arrow
27import Control.Arrow
27import Control.Lens
29import Control.Lens
28− (makeLenses, mapped, each, over, set, to, toListOf, traversed, view,
30+ (makeLenses, mapped, over, 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
31import Data.ByteString.Lazy.Char8
34import Data.ByteString.Lazy.Char8
32 (ByteString)
35 (ByteString)
33import qualified Data.CaseInsensitive as CI
36import qualified Data.CaseInsensitive as CI
34import Data.Foldable
37import Data.Foldable
35− (fold, toList)
38+ (fold)
36import Data.Hashable
39import Data.Hashable
37 (Hashable)
40 (Hashable)
38import Data.HashMap.Strict
41import Data.HashMap.Strict
@@ -50,21 +53,17 @@ import Data.Ord
50 (comparing)
53 (comparing)
51import Data.Proxy
54import Data.Proxy
52 (Proxy (Proxy))
55 (Proxy (Proxy))
53import Data.String.Conversions
58import Data.String.Conversions
55import Data.Text
60import Data.Text
56 (Text, unpack)
61 (Text, unpack)
57import GHC.Generics
62import 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
63import GHC.TypeLits
62import Servant.API
64import Servant.API
63import Servant.API.ContentTypes
65import Servant.API.ContentTypes
64import Servant.API.TypeLevel
66import Servant.API.TypeLevel
65−import Servant.API.Generic
67−import qualified Data.Universe.Helpers as U
69import qualified Data.HashMap.Strict as HM
68import qualified Data.HashMap.Strict as HM
70import qualified Data.Text as T
69import qualified Data.Text as T
@@ -77,15 +76,14 @@ import qualified Network.HTTP.Types as HTTP
77-- or any 'Endpoint' value you want using the 'path' and 'method'
76-- or any 'Endpoint' value you want using the 'path' and 'method'
78-- lenses to tweak.
77-- lenses to tweak.
80−-- >>> defEndpoint
80+-- λ> 'defEndpoint'
83−-- >>> defEndpoint & path <>~ ["foo"]
82+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
84−-- "GET" /foo
83+-- GET /foo
86−-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
84+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
87−-- "POST" /foo
85+-- POST /foo
89data Endpoint = Endpoint
87data Endpoint = Endpoint
90 { _path :: [String] -- type collected
88 { _path :: [String] -- type collected
91 , _method :: HTTP.Method -- type collected
89 , _method :: HTTP.Method -- type collected
@@ -106,15 +104,14 @@ showPath ps = concatMap ('/' :) ps
107-- Here's how you can modify it:
105-- Here's how you can modify it:
109−-- >>> defEndpoint
108+-- λ> 'defEndpoint'
110−-- "GET" /
109+-- GET /
112−-- >>> defEndpoint & path <>~ ["foo"]
110+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
113−-- "GET" /foo
111+-- GET /foo
115−-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
112+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
116−-- "POST" /foo
113+-- POST /foo
118defEndpoint :: Endpoint
115defEndpoint :: Endpoint
119defEndpoint = Endpoint [] HTTP.methodGet
116defEndpoint = Endpoint [] HTTP.methodGet
@@ -131,8 +128,7 @@ instance Semigroup API where
131 (<>) = mappend
128 (<>) = mappend
133instance Monoid API where
130instance Monoid API where
134− API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)
131+ 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
132 mempty = API mempty mempty
138-- | An empty 'API'
134-- | An empty 'API'
@@ -161,20 +157,6 @@ data DocQueryParam = DocQueryParam
161 , _paramKind :: ParamKind
157 , _paramKind :: ParamKind
162 } deriving (Eq, Ord, Show)
158 } 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
160-- | An introductory paragraph for your documentation. You can pass these to
179-- 'docsWithIntros'.
161-- 'docsWithIntros'.
180data DocIntro = DocIntro
162data DocIntro = DocIntro
@@ -240,14 +222,12 @@ data ParamKind = Normal | List | Flag
240-- want to write a 'ToSample' instance for the type that'll be represented
222-- want to write a 'ToSample' instance for the type that'll be represented
241-- as encoded data in the response.
223-- as encoded data in the response.
243−-- Can be tweaked with four lenses.
225+-- 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 = []}
228+-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
229+-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
230+-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
251data Response = Response
231data Response = Response
252 { _respStatus :: Int
232 { _respStatus :: Int
253 , _respTypes :: [M.MediaType]
233 , _respTypes :: [M.MediaType]
@@ -255,25 +235,14 @@ data Response = Response
255 , _respHeaders :: [HTTP.Header]
235 , _respHeaders :: [HTTP.Header]
256 } deriving (Eq, Ord, Show)
236 } 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.
238-- | Default response: status code 200, no response body.
269−-- Can be tweaked with four lenses.
240+-- Can be tweaked with two lenses.
272−-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
274−-- >>> defResponse & respStatus .~ 204
275−-- Response {_respStatus = 204, _respTypes = [], _respBody = [], _respHeaders = []}
243+-- > Response {_respStatus = 200, _respBody = Nothing}
244+-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
245+-- > Response {_respStatus = 204, _respBody = Just "[]"}
277defResponse :: Response
246defResponse :: Response
278defResponse = Response
247defResponse = Response
279 { _respStatus = 200
248 { _respStatus = 200
@@ -295,9 +264,8 @@ defResponse = Response
295data Action = Action
264data Action = Action
296 { _authInfo :: [DocAuthentication] -- user supplied info
265 { _authInfo :: [DocAuthentication] -- user supplied info
297 , _captures :: [DocCapture] -- type collected + user supplied info
266 , _captures :: [DocCapture] -- type collected + user supplied info
298− , _headers :: [HTTP.Header] -- type collected
267+ , _headers :: [Text] -- type collected
299 , _params :: [DocQueryParam] -- type collected + user supplied info
268 , _params :: [DocQueryParam] -- type collected + user supplied info
300− , _fragment :: Maybe DocFragment -- type collected + user supplied info
301 , _notes :: [DocNote] -- user supplied
269 , _notes :: [DocNote] -- user supplied
302 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
270 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
303 , _rqtypes :: [M.MediaType] -- type collected
271 , _rqtypes :: [M.MediaType] -- type collected
@@ -309,30 +277,27 @@ data Action = Action
311-- As such, we invent a non-commutative, left associative operation
279-- As such, we invent a non-commutative, left associative operation
312−-- 'combineAction' to mush two together taking the response from the very left.
280+-- 'combineAction' to mush two together taking the response, body and content
281+-- types from the very left.
313combineAction :: Action -> Action -> Action
282combineAction :: Action -> Action -> Action
314−Action a c h p f n m ts body resp
283+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')
284+ 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
286-- | Default 'Action'. Has no 'captures', no query 'params', expects
319-- no request body ('rqbody') and the typical response is 'defResponse'.
287-- no request body ('rqbody') and the typical response is 'defResponse'.
321-- Tweakable with lenses.
289-- Tweakable with lenses.
323−-- >>> defAction
291+-- > λ> defAction
324−-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
292+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
326−-- >>> defAction & response.respStatus .~ 201
293+-- > λ> defAction & response.respStatus .~ 201
327−-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
294+-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
329defAction :: Action
295defAction :: Action
330defAction =
296defAction =
331 Action []
297 Action []
@@ -356,14 +321,12 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten
357-- @since 0.11.1
322-- @since 0.11.1
358data RenderingOptions = RenderingOptions
323data RenderingOptions = RenderingOptions
359− { _requestExamples :: !ShowContentTypes
324+ { _requestExamples :: !ShowContentTypes
360 -- ^ How many content types to display for request body examples?
325 -- ^ How many content types to display for request body examples?
361− , _responseExamples :: !ShowContentTypes
326+ , _responseExamples :: !ShowContentTypes
362 -- ^ How many content types to display for response body examples?
327 -- ^ How many content types to display for response body examples?
363− , _notesHeading :: !(Maybe String)
328+ , _notesHeading :: !(Maybe String)
364 -- ^ Optionally group all 'notes' together under a common heading.
329 -- ^ 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)
330 } deriving (Show)
369-- | Default API generation options.
332-- | Default API generation options.
@@ -375,10 +338,9 @@ data RenderingOptions = RenderingOptions
375-- @since 0.11.1
338-- @since 0.11.1
376defRenderingOptions :: RenderingOptions
339defRenderingOptions :: RenderingOptions
377defRenderingOptions = RenderingOptions
340defRenderingOptions = RenderingOptions
378− { _requestExamples = AllContentTypes
341+ { _requestExamples = AllContentTypes
379− , _responseExamples = AllContentTypes
342+ , _responseExamples = AllContentTypes
380− , _notesHeading = Nothing
343+ , _notesHeading = Nothing
381− , _renderCurlBasePath = Nothing
384-- gimme some lenses
346-- gimme some lenses
@@ -388,7 +350,6 @@ makeLenses ''API
388makeLenses ''Endpoint
350makeLenses ''Endpoint
389makeLenses ''DocCapture
351makeLenses ''DocCapture
390makeLenses ''DocQueryParam
352makeLenses ''DocQueryParam
391−makeLenses ''DocFragment
392makeLenses ''DocIntro
353makeLenses ''DocIntro
393makeLenses ''DocNote
354makeLenses ''DocNote
394makeLenses ''Response
355makeLenses ''Response
@@ -398,8 +359,7 @@ makeLenses ''RenderingOptions
398-- | Generate the docs for a given API that implements 'HasDocs'. This is the
359-- | Generate the docs for a given API that implements 'HasDocs'. This is the
399-- default way to create documentation.
360-- default way to create documentation.
401−-- > docs == docsWithOptions defaultDocOptions
362+-- prop> docs == docsWithOptions defaultDocOptions
403docs :: HasDocs api => Proxy api -> API
363docs :: HasDocs api => Proxy api -> API
404docs p = docsWithOptions p defaultDocOptions
364docs p = docsWithOptions p defaultDocOptions
@@ -415,9 +375,9 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)
415-- > extra :: ExtraInfo TestApi
375-- > extra :: ExtraInfo TestApi
416-- > extra =
376-- > extra =
417-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
377-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
418−-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]
378+-- > defAction & headers <>~ ["unicorns"]
419-- > & notes <>~ [ DocNote "Title" ["This is some text"]
379-- > & notes <>~ [ DocNote "Title" ["This is some text"]
420−-- > , DocNote "Second section" ["And some more"]
380+-- > , DocNote "Second secton" ["And some more"]
423extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
383extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
@@ -510,22 +470,22 @@ samples = map ("",)
511-- | Default sample Generic-based inputs/outputs.
471-- | Default sample Generic-based inputs/outputs.
512defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
472defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
513−defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))
473+defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
515-- | @'ToSample'@ for Generics.
475-- | @'ToSample'@ for Generics.
517−-- Note: we use combinators from "Universe.Data.Helpers" for more productive sample generation.
477+-- The use of @'Omega'@ allows for more productive sample generation.
518class GToSample t where
478class GToSample t where
519− gtoSamples :: proxy t -> [(Text, t x)]
479+ gtoSamples :: proxy t -> Omega.Omega (Text, t x)
521instance GToSample U1 where
481instance GToSample U1 where
522− gtoSamples _ = singleSample U1
482+ gtoSamples _ = Omega.each (singleSample U1)
524instance GToSample V1 where
484instance GToSample V1 where
525 gtoSamples _ = empty
485 gtoSamples _ = empty
527instance (GToSample p, GToSample q) => GToSample (p :*: q) where
487instance (GToSample p, GToSample q) => GToSample (p :*: q) where
528− gtoSamples _ = U.cartesianProduct render ps qs
488+ gtoSamples _ = render <$> ps <*> qs
530 ps = gtoSamples (Proxy :: Proxy p)
490 ps = gtoSamples (Proxy :: Proxy p)
531 qs = gtoSamples (Proxy :: Proxy q)
491 qs = gtoSamples (Proxy :: Proxy q)
@@ -534,13 +494,13 @@ instance (GToSample p, GToSample q) => GToSample (p :*: q) where
534 | otherwise = (ta <> ", " <> tb, a :*: b)
494 | otherwise = (ta <> ", " <> tb, a :*: b)
536instance (GToSample p, GToSample q) => GToSample (p :+: q) where
496instance (GToSample p, GToSample q) => GToSample (p :+: q) where
537− gtoSamples _ = lefts U.+++ rights
497+ gtoSamples _ = lefts <|> rights
539 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
499 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
540 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
500 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
542instance ToSample a => GToSample (K1 i a) where
502instance ToSample a => GToSample (K1 i a) where
543− gtoSamples _ = second K1 <$> toSamples (Proxy :: Proxy a)
503+ gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
545instance (GToSample f) => GToSample (M1 i a f) where
505instance (GToSample f) => GToSample (M1 i a f) where
546 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
506 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
@@ -608,15 +568,6 @@ class ToCapture c where
608class ToAuthInfo a where
568class ToAuthInfo a where
609 toAuthInfo :: Proxy a -> DocAuthentication
569 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
571-- | Generate documentation in Markdown format for
621-- the given 'API'.
572-- the given 'API'.
@@ -646,7 +597,7 @@ markdown = markdownWith defRenderingOptions
647-- @since 0.11.1
598-- @since 0.11.1
648markdownWith :: RenderingOptions -> API -> String
599markdownWith :: RenderingOptions -> API -> String
649−markdownWith RenderingOptions{..} api = unlines $
600+markdownWith RenderingOptions{..} api = unlines $
650 introsStr (api ^. apiIntros)
601 introsStr (api ^. apiIntros)
651 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
602 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
@@ -657,12 +608,10 @@ markdownWith RenderingOptions{..} api = unlines $
657 notesStr (action ^. notes) ++
608 notesStr (action ^. notes) ++
658 authStr (action ^. authInfo) ++
609 authStr (action ^. authInfo) ++
659 capturesStr (action ^. captures) ++
610 capturesStr (action ^. captures) ++
660− headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++
611+ headersStr (action ^. headers) ++
661 paramsStr meth (action ^. params) ++
612 paramsStr meth (action ^. params) ++
662− fragmentStr (action ^. fragment) ++
663 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
613 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
664 responseStr (action ^. response) ++
614 responseStr (action ^. response) ++
665− maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++
668 where str = "## " ++ BSC.unpack meth
617 where str = "## " ++ BSC.unpack meth
@@ -762,14 +711,6 @@ markdownWith RenderingOptions{..} api = unlines $
763 where values = param ^. paramValues
712 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]
714 rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
774 rqbodyStr [] [] = []
715 rqbodyStr [] [] = []
775 rqbodyStr types s =
716 rqbodyStr types s =
@@ -818,11 +759,12 @@ markdownWith RenderingOptions{..} api = unlines $
818 ("text", "css") -> "css"
759 ("text", "css") -> "css"
819 (_, _) -> ""
760 (_, _) -> ""
821 contentStr mime_type body =
763 contentStr mime_type body =
823− "```" <> markdownForType mime_type :
765+ " ```" <> markdownForType mime_type :
824 cs body :
766 cs body :
825− "```" :
767+ " ```" :
@@ -842,41 +784,11 @@ markdownWith RenderingOptions{..} api = unlines $
843 formatBodies _responseExamples xs
785 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
787-- * Instances
877-- | The generated docs for @a ':<|>' b@ just appends the docs
789-- | The generated docs for @a ':<|>' b@ just appends the docs
878-- for @a@ with the docs for @b@.
790-- for @a@ with the docs for @b@.
879−instance {-# OVERLAPPABLE #-}
791+instance OVERLAPPABLE_
880 (HasDocs a, HasDocs b)
792 (HasDocs a, HasDocs b)
881 => HasDocs (a :<|> b) where
793 => HasDocs (a :<|> b) where
@@ -895,7 +807,7 @@ instance HasDocs EmptyAPI where
895-- | @"books" :> 'Capture' "isbn" Text@ will appear as
807-- | @"books" :> 'Capture' "isbn" Text@ will appear as
896-- @/books/:isbn@ in the docs.
808-- @/books/:isbn@ in the docs.
897instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
809instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
898− => HasDocs (Capture' '[] sym a :> api) where
810+ => HasDocs (Capture' mods sym a :> api) where
900 docsFor Proxy (endpoint, action) =
812 docsFor Proxy (endpoint, action) =
901 docsFor subApiP (endpoint', action')
813 docsFor subApiP (endpoint', action')
@@ -907,28 +819,6 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
907 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
819 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
908 symP = Proxy :: Proxy sym
820 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
823-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as
934-- @/books/:isbn@ in the docs.
824-- @/books/:isbn@ in the docs.
@@ -946,7 +836,7 @@ instance (KnownSymbol sym, ToCapture (CaptureAll sym a), HasDocs sublayout)
946 symP = Proxy :: Proxy sym
836 symP = Proxy :: Proxy sym
949−instance {-# OVERLAPPABLE #-}
839+instance OVERLAPPABLE_
950 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
840 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
951 , ReflectMethod method)
841 , ReflectMethod method)
952 => HasDocs (Verb method status (ct ': cts) a) where
842 => HasDocs (Verb method status (ct ': cts) a) where
@@ -962,25 +852,12 @@ instance {-# OVERLAPPABLE #-}
962 status = fromInteger $ natVal (Proxy :: Proxy status)
852 status = fromInteger $ natVal (Proxy :: Proxy status)
963 p = Proxy :: Proxy a
853 p = Proxy :: Proxy a
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
855-- | TODO: mention the endpoint is streaming, its framing strategy
979-- Also there are no samples.
857-- Also there are no samples.
980−--
858+instance OVERLAPPABLE_
981−-- TODO: AcceptFraming for content-type
859+ (MimeRender ct a, KnownNat status
982−instance {-# OVERLAPPABLE #-}
983− (Accept ct, KnownNat status, ReflectMethod method)
860+ , ReflectMethod method)
984 => HasDocs (Stream method status framing ct a) where
861 => HasDocs (Stream method status framing ct a) where
985 docsFor Proxy (endpoint, action) DocOptions{..} =
862 docsFor Proxy (endpoint, action) DocOptions{..} =
986 single endpoint' action'
863 single endpoint' action'
@@ -991,8 +868,9 @@ instance {-# OVERLAPPABLE #-}
991 t = Proxy :: Proxy '[ct]
868 t = Proxy :: Proxy '[ct]
992 method' = reflectMethod (Proxy :: Proxy method)
869 method' = reflectMethod (Proxy :: Proxy method)
993 status = fromInteger $ natVal (Proxy :: Proxy status)
870 status = fromInteger $ natVal (Proxy :: Proxy status)
871+ p = Proxy :: Proxy a
995−instance {-# OVERLAPPING #-}
873+instance OVERLAPPING_
996 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
874 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
997 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
875 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
998 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
876 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
@@ -1010,17 +888,14 @@ instance {-# OVERLAPPING #-}
1010 status = fromInteger $ natVal (Proxy :: Proxy status)
888 status = fromInteger $ natVal (Proxy :: Proxy status)
1011 p = Proxy :: Proxy a
889 p = Proxy :: Proxy a
1013−instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)
891+instance (KnownSymbol sym, HasDocs api)
1014 => HasDocs (Header' mods sym a :> api) where
892 => HasDocs (Header' mods sym a :> api) where
1015 docsFor Proxy (endpoint, action) =
893 docsFor Proxy (endpoint, action) =
1016 docsFor subApiP (endpoint, action')
894 docsFor subApiP (endpoint, action')
1018 where subApiP = Proxy :: Proxy api
896 where subApiP = Proxy :: Proxy api
1019− action' = over headers (|> (headerName, headerVal)) action
897+ action' = over headers (|> headername) action
1020− headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)
898+ 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)
900instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
1026 => HasDocs (QueryParam' mods sym a :> api) where
901 => HasDocs (QueryParam' mods sym a :> api) where
@@ -1053,15 +928,6 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
1053 paramP = Proxy :: Proxy (QueryFlag sym)
928 paramP = Proxy :: Proxy (QueryFlag sym)
1054 action' = over params (|> toParam paramP) action
929 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
932instance HasDocs Raw where
1067 docsFor _proxy (endpoint, action) _ =
933 docsFor _proxy (endpoint, action) _ =
@@ -1094,6 +960,7 @@ instance (KnownSymbol desc, HasDocs api)
1094-- both are even defined) for any particular type.
960-- both are even defined) for any particular type.
1095instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
961instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
1096 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
962 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
1097 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
964 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
1098 docsFor subApiP (endpoint, action') opts
965 docsFor subApiP (endpoint, action') opts
@@ -1104,18 +971,6 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
1104 t = Proxy :: Proxy (ct ': cts)
971 t = Proxy :: Proxy (ct ': cts)
1105 p = Proxy :: Proxy a
972 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
974instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
1121 docsFor Proxy (endpoint, action) =
976 docsFor Proxy (endpoint, action) =
@@ -1151,9 +1006,6 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
1151 authProxy = Proxy :: Proxy (BasicAuth realm usr)
1006 authProxy = Proxy :: Proxy (BasicAuth realm usr)
1152 action' = over authInfo (|> toAuthInfo authProxy) action
1007 action' = over authInfo (|> toAuthInfo authProxy) action
1154−instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
1155− docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
1157-- ToSample instances for simple types
1009-- ToSample instances for simple types
1158instance ToSample NoContent
1010instance ToSample NoContent
1159instance ToSample Bool
1011instance ToSample Bool
@@ -1170,7 +1022,6 @@ instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f
1170instance ToSample a => ToSample (Maybe a)
1022instance ToSample a => ToSample (Maybe a)
1171instance (ToSample a, ToSample b) => ToSample (Either a b)
1023instance (ToSample a, ToSample b) => ToSample (Either a b)
1172instance ToSample a => ToSample [a]
1024instance ToSample a => ToSample [a]
1173−instance ToSample a => ToSample (NonEmpty a)
1175-- ToSample instances for Control.Applicative types
1026-- ToSample instances for Control.Applicative types
1176instance ToSample a => ToSample (Const a b)
1027instance ToSample a => ToSample (Const a b)
@@ -1184,6 +1035,3 @@ instance ToSample a => ToSample (Product a)
1184instance ToSample a => ToSample (First a)
1035instance ToSample a => ToSample (First a)
1185instance ToSample a => ToSample (Last a)
1036instance ToSample a => ToSample (Last a)
1186instance ToSample a => ToSample (Dual a)
1037instance ToSample a => ToSample (Dual a)
1189−-- >>> :set -XOverloadedStrings