@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE ConstraintKinds #-}
32{-# LANGUAGE DataKinds #-}
43{-# LANGUAGE DefaultSignatures #-}
@@ -17,41 +16,55 @@
1716{-# LANGUAGE TypeOperators #-}
1817{-# LANGUAGE UndecidableInstances #-}
1918
20−#include "overlapping-compat.h"
2119module Servant.Docs.Internal where
2220
23−import Prelude ()
21+import Prelude ()
2422import Prelude.Compat
2523
2624import Control.Applicative
27−import Control.Arrow (second)
28−import Control.Lens (makeLenses, mapped, over,
29− traversed, view, (%~), (&), (.~),
30− (<>~), (^.), (|>))
31−import qualified Control.Monad.Omega as Omega
25+import Control.Arrow
26+ (second)
27+import Control.Lens
28+ (makeLenses, mapped, each, over, set, to, toListOf, traversed, view,
29+ _1, (%~), (&), (.~), (<>~), (^.), (|>))
3230import qualified Data.ByteString.Char8 as BSC
33−import Data.ByteString.Lazy.Char8 (ByteString)
31+import Data.ByteString.Lazy.Char8
32+ (ByteString)
3433import qualified Data.CaseInsensitive as CI
35−import Data.Foldable (fold)
36−import Data.Hashable (Hashable)
37−import Data.HashMap.Strict (HashMap)
38−import Data.List.Compat (intercalate, intersperse, sort)
39−import Data.List.NonEmpty (NonEmpty ((:|)), groupWith)
34+import Data.Foldable
35+ (fold, toList)
36+import Data.Hashable
37+ (Hashable)
38+import Data.HashMap.Strict
39+ (HashMap)
40+import Data.List.Compat
41+ (intercalate, intersperse, sort)
42+import Data.List.NonEmpty
43+ (NonEmpty ((:|)), groupWith)
4044import qualified Data.List.NonEmpty as NE
4145import Data.Maybe
42−import Data.Monoid (All (..), Any (..), Dual (..),
43− First (..), Last (..),
44− Product (..), Sum (..))
45−import Data.Ord (comparing)
46−import Data.Proxy (Proxy (Proxy))
47−import Data.Semigroup (Semigroup (..))
48−import Data.String.Conversions (cs)
49−import Data.Text (Text, unpack)
46+import Data.Monoid
47+ (All (..), Any (..), Dual (..), First (..), Last (..),
48+ Product (..), Sum (..))
49+import Data.Ord
50+ (comparing)
51+import Data.Proxy
52+ (Proxy (Proxy))
53+import Data.String.Conversions
54+ (cs)
55+import Data.Text
56+ (Text, unpack)
5057import GHC.Generics
58+ (Generic, Rep, K1(K1), M1(M1), U1(U1), V1,
59+ (:*:)((:*:)), (:+:)(L1, R1))
60+import qualified GHC.Generics as G
5161import GHC.TypeLits
5262import Servant.API
5363import Servant.API.ContentTypes
5464import Servant.API.TypeLevel
65+import Servant.API.Generic
66+
67+import qualified Data.Universe.Helpers as U
5568
5669import qualified Data.HashMap.Strict as HM
5770import qualified Data.Text as T
@@ -64,14 +77,15 @@ import qualified Network.HTTP.Types as HTTP
6477-- or any 'Endpoint' value you want using the 'path' and 'method'
6578-- lenses to tweak.
6679--
67−-- @
68−-- λ> 'defEndpoint'
69−-- GET /
70−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
71−-- GET /foo
72−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
73−-- POST /foo
74−-- @
80+-- >>> defEndpoint
81+-- "GET" /
82+--
83+-- >>> defEndpoint & path <>~ ["foo"]
84+-- "GET" /foo
85+--
86+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
87+-- "POST" /foo
88+--
7589data Endpoint = Endpoint
7690 { _path :: [String] -- type collected
7791 , _method :: HTTP.Method -- type collected
@@ -92,14 +106,15 @@ showPath ps = concatMap ('/' :) ps
92106--
93107-- Here's how you can modify it:
94108--
95−-- @
96−-- λ> 'defEndpoint'
97−-- GET /
98−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
99−-- GET /foo
100−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
101−-- POST /foo
102−-- @
109+-- >>> defEndpoint
110+-- "GET" /
111+--
112+-- >>> defEndpoint & path <>~ ["foo"]
113+-- "GET" /foo
114+--
115+-- >>> defEndpoint & path <>~ ["foo"] & method .~ HTTP.methodPost
116+-- "POST" /foo
117+--
103118defEndpoint :: Endpoint
104119defEndpoint = Endpoint [] HTTP.methodGet
105120
@@ -116,7 +131,8 @@ instance Semigroup API where
116131 (<>) = mappend
117132
118133instance Monoid API where
119− API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2) (b1 `mappend` b2)
134+ API a1 b1 `mappend` API a2 b2 = API (a1 `mappend` a2)
135+ (HM.unionWith combineAction b1 b2)
120136 mempty = API mempty mempty
121137
122138-- | An empty 'API'
@@ -145,6 +161,20 @@ data DocQueryParam = DocQueryParam
145161 , _paramKind :: ParamKind
146162 } deriving (Eq, Ord, Show)
147163
164+-- | A type to represent fragment. Holds the name of the fragment and its description.
165+--
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)
171+
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
177+
148178-- | An introductory paragraph for your documentation. You can pass these to
149179-- 'docsWithIntros'.
150180data DocIntro = DocIntro
@@ -210,12 +240,14 @@ data ParamKind = Normal | List | Flag
210240-- want to write a 'ToSample' instance for the type that'll be represented
211241-- as encoded data in the response.
212242--
213−-- Can be tweaked with three lenses.
243+-- Can be tweaked with four lenses.
244+--
245+-- >>> defResponse
246+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
247+--
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 = []}
214250--
215−-- > λ> defResponse
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\" }")]}
219251data Response = Response
220252 { _respStatus :: Int
221253 , _respTypes :: [M.MediaType]
@@ -223,14 +255,25 @@ data Response = Response
223255 , _respHeaders :: [HTTP.Header]
224256 } deriving (Eq, Ord, Show)
225257
258+-- | Combine two Responses, we can't make a monoid because merging Status breaks
259+-- the laws.
260+--
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')
266+
226267-- | Default response: status code 200, no response body.
227268--
228−-- Can be tweaked with two lenses.
269+-- Can be tweaked with four lenses.
270+--
271+-- >>> defResponse
272+-- Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}
273+--
274+-- >>> defResponse & respStatus .~ 204
275+-- Response {_respStatus = 204, _respTypes = [], _respBody = [], _respHeaders = []}
229276--
230−-- > λ> defResponse
231−-- > Response {_respStatus = 200, _respBody = Nothing}
232−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
233−-- > Response {_respStatus = 204, _respBody = Just "[]"}
234277defResponse :: Response
235278defResponse = Response
236279 { _respStatus = 200
@@ -252,8 +295,9 @@ defResponse = Response
252295data Action = Action
253296 { _authInfo :: [DocAuthentication] -- user supplied info
254297 , _captures :: [DocCapture] -- type collected + user supplied info
255− , _headers :: [Text] -- type collected
298+ , _headers :: [HTTP.Header] -- type collected
256299 , _params :: [DocQueryParam] -- type collected + user supplied info
300+ , _fragment :: Maybe DocFragment -- type collected + user supplied info
257301 , _notes :: [DocNote] -- user supplied
258302 , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
259303 , _rqtypes :: [M.MediaType] -- type collected
@@ -265,27 +309,30 @@ data Action = Action
265309-- laws.
266310--
267311-- As such, we invent a non-commutative, left associative operation
268−-- 'combineAction' to mush two together taking the response, body and content
269−-- types from the very left.
312+-- 'combineAction' to mush two together taking the response from the very left.
270313combineAction :: Action -> Action -> Action
271−Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
272− Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
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' =
316+ Action (a <> a') (c <> c') (h <> h') (p <> p') (f `combineFragment` f') (n <> n') (m <> m') (ts <> ts') (body <> body') (resp `combineResponse` resp')
273317
274318-- | Default 'Action'. Has no 'captures', no query 'params', expects
275319-- no request body ('rqbody') and the typical response is 'defResponse'.
276320--
277321-- Tweakable with lenses.
278322--
279−-- > λ> defAction
280−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
281−-- > λ> defAction & response.respStatus .~ 201
282−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
323+-- >>> defAction
324+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 200, _respTypes = [], _respBody = [], _respHeaders = []}}
325+--
326+-- >>> defAction & response.respStatus .~ 201
327+-- Action {_authInfo = [], _captures = [], _headers = [], _params = [], _fragment = Nothing, _notes = [], _mxParams = [], _rqtypes = [], _rqbody = [], _response = Response {_respStatus = 201, _respTypes = [], _respBody = [], _respHeaders = []}}
328+--
283329defAction :: Action
284330defAction =
285331 Action []
286332 []
287333 []
288334 []
335+ Nothing
289336 []
290337 []
291338 []
@@ -309,12 +356,14 @@ data ShowContentTypes = AllContentTypes -- ^ For each example, show each conten
309356--
310357-- @since 0.11.1
311358data RenderingOptions = RenderingOptions
312− { _requestExamples :: !ShowContentTypes
359+ { _requestExamples :: !ShowContentTypes
313360 -- ^ How many content types to display for request body examples?
314− , _responseExamples :: !ShowContentTypes
361+ , _responseExamples :: !ShowContentTypes
315362 -- ^ How many content types to display for response body examples?
316− , _notesHeading :: !(Maybe String)
363+ , _notesHeading :: !(Maybe String)
317364 -- ^ 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`).
318367 } deriving (Show)
319368
320369-- | Default API generation options.
@@ -326,9 +375,10 @@ data RenderingOptions = RenderingOptions
326375-- @since 0.11.1
327376defRenderingOptions :: RenderingOptions
328377defRenderingOptions = RenderingOptions
329− { _requestExamples = AllContentTypes
330− , _responseExamples = AllContentTypes
331− , _notesHeading = Nothing
378+ { _requestExamples = AllContentTypes
379+ , _responseExamples = AllContentTypes
380+ , _notesHeading = Nothing
381+ , _renderCurlBasePath = Nothing
332382 }
333383
334384-- gimme some lenses
@@ -338,6 +388,7 @@ makeLenses ''API
338388makeLenses ''Endpoint
339389makeLenses ''DocCapture
340390makeLenses ''DocQueryParam
391+makeLenses ''DocFragment
341392makeLenses ''DocIntro
342393makeLenses ''DocNote
343394makeLenses ''Response
@@ -347,7 +398,8 @@ makeLenses ''RenderingOptions
347398-- | Generate the docs for a given API that implements 'HasDocs'. This is the
348399-- default way to create documentation.
349400--
350−-- prop> docs == docsWithOptions defaultDocOptions
401+-- > docs == docsWithOptions defaultDocOptions
402+--
351403docs :: HasDocs api => Proxy api -> API
352404docs p = docsWithOptions p defaultDocOptions
353405
@@ -363,9 +415,9 @@ docsWithOptions p = docsFor p (defEndpoint, defAction)
363415-- > extra :: ExtraInfo TestApi
364416-- > extra =
365417-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
366−-- > defAction & headers <>~ ["unicorns"]
418+-- > defAction & headers <>~ [("X-Num-Unicorns", 1)]
367419-- > & notes <>~ [ DocNote "Title" ["This is some text"]
368−-- > , DocNote "Second secton" ["And some more"]
420+-- > , DocNote "Second section" ["And some more"]
369421-- > ]
370422
371423extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
@@ -458,22 +510,22 @@ samples = map ("",)
458510
459511-- | Default sample Generic-based inputs/outputs.
460512defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
461−defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
513+defaultSamples _ = second G.to <$> gtoSamples (Proxy :: Proxy (Rep a))
462514
463515-- | @'ToSample'@ for Generics.
464516--
465−-- The use of @'Omega'@ allows for more productive sample generation.
517+-- Note: we use combinators from "Universe.Data.Helpers" for more productive sample generation.
466518class GToSample t where
467− gtoSamples :: proxy t -> Omega.Omega (Text, t x)
519+ gtoSamples :: proxy t -> [(Text, t x)]
468520
469521instance GToSample U1 where
470− gtoSamples _ = Omega.each (singleSample U1)
522+ gtoSamples _ = singleSample U1
471523
472524instance GToSample V1 where
473525 gtoSamples _ = empty
474526
475527instance (GToSample p, GToSample q) => GToSample (p :*: q) where
476− gtoSamples _ = render <$> ps <*> qs
528+ gtoSamples _ = U.cartesianProduct render ps qs
477529 where
478530 ps = gtoSamples (Proxy :: Proxy p)
479531 qs = gtoSamples (Proxy :: Proxy q)
@@ -482,13 +534,13 @@ instance (GToSample p, GToSample q) => GToSample (p :*: q) where
482534 | otherwise = (ta <> ", " <> tb, a :*: b)
483535
484536instance (GToSample p, GToSample q) => GToSample (p :+: q) where
485− gtoSamples _ = lefts <|> rights
537+ gtoSamples _ = lefts U.+++ rights
486538 where
487539 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
488540 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
489541
490542instance ToSample a => GToSample (K1 i a) where
491− gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
543+ gtoSamples _ = second K1 <$> toSamples (Proxy :: Proxy a)
492544
493545instance (GToSample f) => GToSample (M1 i a f) where
494546 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
@@ -556,6 +608,15 @@ class ToCapture c where
556608class ToAuthInfo a where
557609 toAuthInfo :: Proxy a -> DocAuthentication
558610
611+-- | The class that helps us get documentation for URL fragments.
612+--
613+-- Example of an instance:
614+--
615+-- > instance ToFragment (Fragment a) where
616+-- > toFragment _ = DocFragment "fragment" "fragment description"
617+class ToFragment t where
618+ toFragment :: Proxy t -> DocFragment
619+
559620-- | Generate documentation in Markdown format for
560621-- the given 'API'.
561622--
@@ -585,7 +646,7 @@ markdown = markdownWith defRenderingOptions
585646--
586647-- @since 0.11.1
587648markdownWith :: RenderingOptions -> API -> String
588−markdownWith RenderingOptions{..} api = unlines $
649+markdownWith RenderingOptions{..} api = unlines $
589650 introsStr (api ^. apiIntros)
590651 ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
591652
@@ -596,10 +657,12 @@ markdownWith RenderingOptions{..} api = unlines $
596657 notesStr (action ^. notes) ++
597658 authStr (action ^. authInfo) ++
598659 capturesStr (action ^. captures) ++
599− headersStr (action ^. headers) ++
660+ headersStr (toListOf (headers . each . _1 . to (T.pack . BSC.unpack . CI.original)) action) ++
600661 paramsStr meth (action ^. params) ++
662+ fragmentStr (action ^. fragment) ++
601663 rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
602664 responseStr (action ^. response) ++
665+ maybe [] (curlStr endpoint (action ^. headers) (action ^. rqbody)) _renderCurlBasePath ++
603666 []
604667
605668 where str = "## " ++ BSC.unpack meth
@@ -699,6 +762,14 @@ markdownWith RenderingOptions{..} api = unlines $
699762
700763 where values = param ^. paramValues
701764
765+ fragmentStr :: Maybe DocFragment -> [String]
766+ fragmentStr Nothing = []
767+ fragmentStr (Just frag) =
768+ [ "### Fragment:", ""
769+ , "- *" ++ (frag ^. fragSymbol) ++ "*: " ++ (frag ^. fragDesc)
770+ , ""
771+ ]
772+
702773 rqbodyStr :: [M.MediaType] -> [(Text, M.MediaType, ByteString)]-> [String]
703774 rqbodyStr [] [] = []
704775 rqbodyStr types s =
@@ -747,12 +818,11 @@ markdownWith RenderingOptions{..} api = unlines $
747818 ("text", "css") -> "css"
748819 (_, _) -> ""
749820
750−
751821 contentStr mime_type body =
752822 "" :
753− " ```" <> markdownForType mime_type :
823+ "```" <> markdownForType mime_type :
754824 cs body :
755− " ```" :
825+ "```" :
756826 "" :
757827 []
758828
@@ -772,11 +842,41 @@ markdownWith RenderingOptions{..} api = unlines $
772842 xs ->
773843 formatBodies _responseExamples xs
774844
845+ curlStr :: Endpoint -> [HTTP.Header] -> [(Text, M.MediaType, ByteString)] -> String -> [String]
846+ curlStr endpoint hdrs reqBodies basePath =
847+ [ "### Sample Request:"
848+ , ""
849+ , "```bash"
850+ , "curl -X" ++ BSC.unpack (endpoint ^. method) ++ " \\"
851+ ] <>
852+ maybe [] pure mbMediaTypeStr <>
853+ headersStrs <>
854+ maybe [] pure mbReqBodyStr <>
855+ [ " " ++ basePath ++ showPath (endpoint ^. path)
856+ , "```"
857+ , ""
858+ ]
859+
860+ where escapeQuotes :: String -> String
861+ escapeQuotes = concatMap $ \c -> case c of
862+ '\"' -> "\\\""
863+ _ -> [c]
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) ++ "\" \\"
874+
775875-- * Instances
776876
777877-- | The generated docs for @a ':<|>' b@ just appends the docs
778878-- for @a@ with the docs for @b@.
779−instance OVERLAPPABLE_
879+instance {-# OVERLAPPABLE #-}
780880 (HasDocs a, HasDocs b)
781881 => HasDocs (a :<|> b) where
782882
@@ -795,7 +895,7 @@ instance HasDocs EmptyAPI where
795895-- | @"books" :> 'Capture' "isbn" Text@ will appear as
796896-- @/books/:isbn@ in the docs.
797897instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
798− => HasDocs (Capture' mods sym a :> api) where
898+ => HasDocs (Capture' '[] sym a :> api) where
799899
800900 docsFor Proxy (endpoint, action) =
801901 docsFor subApiP (endpoint', action')
@@ -807,6 +907,28 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
807907 endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
808908 symP = Proxy :: Proxy sym
809909
910+instance (KnownSymbol descr, KnownSymbol sym, HasDocs api)
911+ => HasDocs (Capture' (Description descr ': mods) sym a :> api) where
912+
913+ docsFor Proxy (endpoint, action) =
914+ docsFor subApiP (endpoint', action')
915+
916+ where subApiP = Proxy :: Proxy api
917+
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
923+
924+instance {-# OVERLAPPABLE #-} HasDocs (Capture' mods sym a :> api)
925+ => HasDocs (Capture' (mod ': mods) sym a :> api) where
926+
927+ docsFor Proxy =
928+ docsFor apiP
929+
930+ where apiP = Proxy :: Proxy (Capture' mods sym a :> api)
931+
810932
811933-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as
812934-- @/books/:isbn@ in the docs.
@@ -824,7 +946,7 @@ instance (KnownSymbol sym, ToCapture (CaptureAll sym a), HasDocs sublayout)
824946 symP = Proxy :: Proxy sym
825947
826948
827−instance OVERLAPPABLE_
949+instance {-# OVERLAPPABLE #-}
828950 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
829951 , ReflectMethod method)
830952 => HasDocs (Verb method status (ct ': cts) a) where
@@ -840,7 +962,37 @@ instance OVERLAPPABLE_
840962 status = fromInteger $ natVal (Proxy :: Proxy status)
841963 p = Proxy :: Proxy a
842964
843−instance OVERLAPPING_
965+instance (ReflectMethod method) =>
966+ HasDocs (NoContentVerb method) where
967+ docsFor Proxy (endpoint, action) DocOptions{..} =
968+ single endpoint' action'
969+
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)
976+
977+-- | TODO: mention the endpoint is streaming, its framing strategy
978+--
979+-- Also there are no samples.
980+--
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'
987+
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)
994+
995+instance {-# OVERLAPPING #-}
844996 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
845997 , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
846998 => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
@@ -858,14 +1010,17 @@ instance OVERLAPPING_
8581010 status = fromInteger $ natVal (Proxy :: Proxy status)
8591011 p = Proxy :: Proxy a
8601012
861−instance (KnownSymbol sym, HasDocs api)
1013+instance (ToHttpApiData a, ToSample a, KnownSymbol sym, HasDocs api)
8621014 => HasDocs (Header' mods sym a :> api) where
8631015 docsFor Proxy (endpoint, action) =
8641016 docsFor subApiP (endpoint, action')
8651017
8661018 where subApiP = Proxy :: Proxy api
867− action' = over headers (|> headername) action
868− headername = T.pack $ symbolVal (Proxy :: Proxy sym)
1019+ action' = over headers (|> (headerName, headerVal)) action
1020+ headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy sym)
1021+ headerVal = case toSample (Proxy :: Proxy a) of
1022+ Just x -> cs $ toHeader x
1023+ Nothing -> "<no header sample provided>"
8691024
8701025instance (KnownSymbol sym, ToParam (QueryParam' mods sym a), HasDocs api)
8711026 => HasDocs (QueryParam' mods sym a :> api) where
@@ -898,6 +1053,15 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
8981053 paramP = Proxy :: Proxy (QueryFlag sym)
8991054 action' = over params (|> toParam paramP) action
9001055
1056+instance (ToFragment (Fragment a), HasDocs api)
1057+ => HasDocs (Fragment a :> api) where
1058+
1059+ docsFor Proxy (endpoint, action) =
1060+ docsFor subApiP (endpoint, action')
1061+
1062+ where subApiP = Proxy :: Proxy api
1063+ fragmentP = Proxy :: Proxy (Fragment a)
1064+ action' = set fragment (Just (toFragment fragmentP)) action
9011065
9021066instance HasDocs Raw where
9031067 docsFor _proxy (endpoint, action) _ =
@@ -930,7 +1094,6 @@ instance (KnownSymbol desc, HasDocs api)
9301094-- both are even defined) for any particular type.
9311095instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
9321096 => HasDocs (ReqBody' mods (ct ': cts) a :> api) where
933−
9341097 docsFor Proxy (endpoint, action) opts@DocOptions{..} =
9351098 docsFor subApiP (endpoint, action') opts
9361099
@@ -941,6 +1104,18 @@ instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
9411104 t = Proxy :: Proxy (ct ': cts)
9421105 p = Proxy :: Proxy a
9431106
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
1111+ where
1112+ subApiP = Proxy :: Proxy api
1113+
1114+ action' :: Action
1115+ action' = action & rqtypes .~ toList (contentTypes t)
1116+
1117+ t = Proxy :: Proxy ctype
1118+
9441119instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
9451120
9461121 docsFor Proxy (endpoint, action) =
@@ -976,6 +1151,9 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
9761151 authProxy = Proxy :: Proxy (BasicAuth realm usr)
9771152 action' = over authInfo (|> toAuthInfo authProxy) action
9781153
1154+instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
1155+ docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
1156+
9791157-- ToSample instances for simple types
9801158instance ToSample NoContent
9811159instance ToSample Bool
@@ -992,6 +1170,7 @@ instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f
9921170instance ToSample a => ToSample (Maybe a)
9931171instance (ToSample a, ToSample b) => ToSample (Either a b)
9941172instance ToSample a => ToSample [a]
1173+instance ToSample a => ToSample (NonEmpty a)
9951174
9961175-- ToSample instances for Control.Applicative types
9971176instance ToSample a => ToSample (Const a b)
@@ -1005,3 +1184,6 @@ instance ToSample a => ToSample (Product a)
10051184instance ToSample a => ToSample (First a)
10061185instance ToSample a => ToSample (Last a)
10071186instance ToSample a => ToSample (Dual a)
1187+
1188+-- $setup
1189+-- >>> :set -XOverloadedStrings