@@ -1,31 +1,17 @@
1−{-# LANGUAGE TypeFamilies #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE TupleSections #-}
5−{-# LANGUAGE TypeOperators #-}
6−{-# LANGUAGE TemplateHaskell #-}
7−{-# LANGUAGE FlexibleContexts #-}
8−{-# LANGUAGE FlexibleInstances #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE ConstraintKinds #-}
12−{-# LANGUAGE UndecidableInstances #-}
13−{-# LANGUAGE PolyKinds #-}
14−
151-------------------------------------------------------------------------------
16−-- | This module lets you get API docs for free. It lets generate
2+-- | This module lets you get API docs for free. It lets you generate
173-- an 'API' from the type that represents your API using 'docs':
184--
195-- @docs :: 'HasDocs' api => 'Proxy' api -> 'API'@
206--
21−-- Alternately, if you wish to add one or more introductions to your
7+-- Alternatively, if you wish to add one or more introductions to your
228-- documentation, use 'docsWithIntros':
239--
24−-- @docsWithIntros :: 'HasDocs' api => [DocIntro] -> 'Proxy' api -> 'API'@
10+-- @'docsWithIntros' :: 'HasDocs' api => [DocIntro] -> 'Proxy' api -> 'API'@
2511--
2612-- You can then call 'markdown' on the 'API' value:
2713--
28−-- @markdown :: 'API' -> String@
14+-- @'markdown' :: 'API' -> String@
2915--
3016-- or define a custom pretty printer:
3117--
@@ -34,8 +20,8 @@
3420-- The only thing you'll need to do will be to implement some classes
3521-- for your captures, get parameters and request or response bodies.
3622--
37−-- Here's a little (but complete) example that you can run to see the
38−-- markdown pretty printer in action:
23+-- Here is a complete example that you can run to see the markdown pretty
24+-- printer in action:
3925--
4026-- > {-# LANGUAGE DataKinds #-}
4127-- > {-# LANGUAGE DeriveGeneric #-}
@@ -174,797 +160,9 @@ module Servant.Docs
174160 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
175161 , DocNote(..), noteTitle, noteBody
176162 , DocIntro(..)
177− , Response, respStatus, respTypes, respBody, defResponse
163+ , Response(..), respStatus, respTypes, respBody, defResponse
178164 , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction
179165 , single
180166 ) where
181167
182−import Control.Applicative
183−import Control.Lens hiding (Action)
184−import Data.Aeson
185−import Data.ByteString.Lazy.Char8 (ByteString)
186−import Data.Hashable
187−import Data.HashMap.Strict (HashMap)
188−import Data.List
189−import Data.Maybe
190−import Data.Monoid
191−import Data.Ord (comparing)
192−import Data.Proxy
193−import Data.String.Conversions
194−import Data.Text (Text, pack, unpack)
195−import GHC.Generics
196−import GHC.TypeLits
197−import GHC.Exts(Constraint)
198−import Servant.API
199−import Servant.Utils.Links
200−import Servant.API.ContentTypes
201−
202−import qualified Data.HashMap.Strict as HM
203−import qualified Data.Text as T
204−import qualified Network.HTTP.Media as M
205−
206−-- | Supported HTTP request methods
207−data Method = DocDELETE -- ^ the DELETE method
208− | DocGET -- ^ the GET method
209− | DocPOST -- ^ the POST method
210− | DocPUT -- ^ the PUT method
211− deriving (Eq, Ord, Generic)
212−
213−instance Show Method where
214− show DocGET = "GET"
215− show DocPOST = "POST"
216− show DocDELETE = "DELETE"
217− show DocPUT = "PUT"
218−
219−instance Hashable Method
220−
221−-- | An 'Endpoint' type that holds the 'path' and the 'method'.
222−--
223−-- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'
224−-- or any 'Endpoint' value you want using the 'path' and 'method'
225−-- lenses to tweak.
226−--
227−-- @
228−-- λ> 'defEndpoint'
229−-- GET /
230−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
231−-- GET /foo
232−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
233−-- POST /foo
234−-- @
235−data Endpoint = Endpoint
236− { _path :: [String] -- type collected
237− , _method :: Method -- type collected
238− } deriving (Eq, Ord, Generic)
239−
240−instance Show Endpoint where
241− show (Endpoint p m) =
242− show m ++ " " ++ showPath p
243−
244−-- |
245−-- Render a path as a '/'-delimited string
246−--
247−showPath :: [String] -> String
248−showPath [] = "/"
249−showPath ps = concatMap ('/' :) ps
250−
251−-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
252−--
253−-- Here's how you can modify it:
254−--
255−-- @
256−-- λ> 'defEndpoint'
257−-- GET /
258−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
259−-- GET /foo
260−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
261−-- POST /foo
262−-- @
263−defEndpoint :: Endpoint
264−defEndpoint = Endpoint [] DocGET
265−
266−instance Hashable Endpoint
267−
268−-- | Our API documentation type, a product of top-level information and a good
269−-- old hashmap from 'Endpoint' to 'Action'
270−data API = API
271− { _apiIntros :: [DocIntro]
272− , _apiEndpoints :: HashMap Endpoint Action
273− } deriving (Eq, Show)
274−
275−instance Monoid API where
276− API a1 b1 `mappend` API a2 b2 = API (a1 <> a2) (b1 <> b2)
277− mempty = API mempty mempty
278−
279−-- | An empty 'API'
280−emptyAPI :: API
281−emptyAPI = mempty
282−
283−-- | A type to represent captures. Holds the name of the capture
284−-- and a description.
285−--
286−-- Write a 'ToCapture' instance for your captured types.
287−data DocCapture = DocCapture
288− { _capSymbol :: String -- type supplied
289− , _capDesc :: String -- user supplied
290− } deriving (Eq, Ord, Show)
291−
292−-- | A type to represent a /GET/ parameter from the Query String. Holds its name,
293−-- the possible values (leave empty if there isn't a finite number of them),
294−-- and a description of how it influences the output or behavior.
295−--
296−-- Write a 'ToParam' instance for your GET parameter types
297−data DocQueryParam = DocQueryParam
298− { _paramName :: String -- type supplied
299− , _paramValues :: [String] -- user supplied
300− , _paramDesc :: String -- user supplied
301− , _paramKind :: ParamKind
302− } deriving (Eq, Ord, Show)
303−
304−-- | An introductory paragraph for your documentation. You can pass these to
305−-- 'docsWithIntros'.
306−data DocIntro = DocIntro
307− { _introTitle :: String -- ^ Appears above the intro blob
308− , _introBody :: [String] -- ^ Each String is a paragraph.
309− } deriving (Eq, Show)
310−
311−instance Ord DocIntro where
312− compare = comparing _introTitle
313−
314−-- | A type to represent extra notes that may be attached to an 'Action'.
315−--
316−-- This is intended to be used when writing your own HasDocs instances to
317−-- add extra sections to your endpoint's documentation.
318−data DocNote = DocNote
319− { _noteTitle :: String
320− , _noteBody :: [String]
321− } deriving (Eq, Ord, Show)
322−
323−-- | Type of extra information that a user may wish to "union" with their
324−-- documentation.
325−--
326−-- These are intended to be built using extraInfo.
327−-- Multiple ExtraInfo may be combined with the monoid instance.
328−newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
329−instance Monoid (ExtraInfo a) where
330− mempty = ExtraInfo mempty
331− ExtraInfo a `mappend` ExtraInfo b =
332− ExtraInfo $ HM.unionWith combineAction a b
333−
334−-- | Type of GET parameter:
335−--
336−-- - Normal corresponds to @QueryParam@, i.e your usual GET parameter
337−-- - List corresponds to @QueryParams@, i.e GET parameters with multiple values
338−-- - Flag corresponds to @QueryFlag@, i.e a value-less GET parameter
339−data ParamKind = Normal | List | Flag
340− deriving (Eq, Ord, Show)
341−
342−-- | A type to represent an HTTP response. Has an 'Int' status, a list of
343−-- possible 'MediaType's, and a list of example 'ByteString' response bodies.
344−-- Tweak 'defResponse' using the 'respStatus', 'respTypes' and 'respBody'
345−-- lenses if you want.
346−--
347−-- If you want to respond with a non-empty response body, you'll most likely
348−-- want to write a 'ToSample' instance for the type that'll be represented
349−-- as encoded data in the response.
350−--
351−-- Can be tweaked with three lenses.
352−--
353−-- > λ> defResponse
354−-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
355−-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
356−-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
357−data Response = Response
358− { _respStatus :: Int
359− , _respTypes :: [M.MediaType]
360− , _respBody :: [(Text, M.MediaType, ByteString)]
361− } deriving (Eq, Ord, Show)
362−
363−-- | Default response: status code 200, no response body.
364−--
365−-- Can be tweaked with two lenses.
366−--
367−-- > λ> defResponse
368−-- > Response {_respStatus = 200, _respBody = Nothing}
369−-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
370−-- > Response {_respStatus = 204, _respBody = Just "[]"}
371−defResponse :: Response
372−defResponse = Response 200 [] []
373−
374−-- | A datatype that represents everything that can happen
375−-- at an endpoint, with its lenses:
376−--
377−-- - List of captures ('captures')
378−-- - List of GET parameters ('params')
379−-- - What the request body should look like, if any is requested ('rqbody')
380−-- - What the response should be if everything goes well ('response')
381−--
382−-- You can tweak an 'Action' (like the default 'defAction') with these lenses
383−-- to transform an action and add some information to it.
384−data Action = Action
385− { _captures :: [DocCapture] -- type collected + user supplied info
386− , _headers :: [Text] -- type collected
387− , _params :: [DocQueryParam] -- type collected + user supplied info
388− , _notes :: [DocNote] -- user supplied
389− , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
390− , _rqtypes :: [M.MediaType] -- type collected
391− , _rqbody :: [(M.MediaType, ByteString)] -- user supplied
392− , _response :: Response -- user supplied
393− } deriving (Eq, Ord, Show)
394−
395−-- | Combine two Actions, we can't make a monoid as merging Response breaks the
396−-- laws.
397−--
398−-- As such, we invent a non-commutative, left associative operation
399−-- 'combineAction' to mush two together taking the response, body and content
400−-- types from the very left.
401−combineAction :: Action -> Action -> Action
402−Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =
403− Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
404−
405−-- Default 'Action'. Has no 'captures', no GET 'params', expects
406−-- no request body ('rqbody') and the typical response is 'defResponse'.
407−--
408−-- Tweakable with lenses.
409−--
410−-- > λ> defAction
411−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 200, _respBody = Nothing}}
412−-- > λ> defAction & response.respStatus .~ 201
413−-- > Action {_captures = [], _headers = [], _params = [], _mxParams = [], _rqbody = Nothing, _response = Response {_respStatus = 201, _respBody = Nothing}}
414−defAction :: Action
415−defAction =
416− Action []
417− []
418− []
419− []
420− []
421− []
422− []
423− defResponse
424−
425−-- | Create an API that's comprised of a single endpoint.
426−-- 'API' is a 'Monoid', so combine multiple endpoints with
427−-- 'mappend' or '<>'.
428−single :: Endpoint -> Action -> API
429−single e a = API mempty (HM.singleton e a)
430−
431−-- gimme some lenses
432−makeLenses ''API
433−makeLenses ''Endpoint
434−makeLenses ''DocCapture
435−makeLenses ''DocQueryParam
436−makeLenses ''DocIntro
437−makeLenses ''DocNote
438−makeLenses ''Response
439−makeLenses ''Action
440−
441−-- | Generate the docs for a given API that implements 'HasDocs'. This is the
442−-- default way to create documentation.
443−docs :: HasDocs layout => Proxy layout -> API
444−docs p = docsFor p (defEndpoint, defAction)
445−
446−-- | Closed type family, check if endpoint is exactly within API.
447−
448−-- We aren't sure what affects how an Endpoint is built up, so we require an
449−-- exact match.
450−type family IsIn (endpoint :: *) (api :: *) :: Constraint where
451− IsIn e (sa :<|> sb) = Or (IsIn e sa) (IsIn e sb)
452− IsIn (e :> sa) (e :> sb) = IsIn sa sb
453− IsIn e e = ()
454−
455−-- | Create an 'ExtraInfo' that is garunteed to be within the given API layout.
456−--
457−-- The safety here is to ensure that you only add custom documentation to an
458−-- endpoint that actually exists within your API.
459−--
460−-- > extra :: ExtraInfo TestApi
461−-- > extra =
462−-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $
463−-- > defAction & headers <>~ ["unicorns"]
464−-- > & notes <>~ [ DocNote "Title" ["This is some text"]
465−-- > , DocNote "Second secton" ["And some more"]
466−-- > ]
467−
468−extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
469− => Proxy endpoint -> Action -> ExtraInfo layout
470−extraInfo p action =
471− let api = docsFor p (defEndpoint, defAction)
472− -- Assume one endpoint, HasLink constraint means that we should only ever
473− -- point at one endpoint.
474− in ExtraInfo $ api ^. apiEndpoints & traversed .~ action
475−
476−-- | Generate documentation given some extra introductions (in the form of
477−-- 'DocInfo') and some extra endpoint documentation (in the form of
478−-- 'ExtraInfo'.
479−--
480−-- The extra introductions will be prepended to the top of the documentation,
481−-- before the specific endpoint documentation. The extra endpoint documentation
482−-- will be "unioned" with the automatically generated endpoint documentation.
483−--
484−-- You are expected to build up the ExtraInfo with the Monoid instance and
485−-- 'extraInfo'.
486−--
487−-- If you only want to add an introduction, use 'docsWithIntros'.
488−docsWith :: HasDocs layout
489− => [DocIntro]
490− -> ExtraInfo layout
491− -> Proxy layout
492− -> API
493−docsWith intros (ExtraInfo endpoints) p =
494− docs p & apiIntros <>~ intros
495− & apiEndpoints %~ HM.unionWith combineAction endpoints
496−
497−
498−-- | Generate the docs for a given API that implements 'HasDocs' with with any
499−-- number of introduction(s)
500−docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
501−docsWithIntros intros = docsWith intros mempty
502−
503−-- | The class that abstracts away the impact of API combinators
504−-- on documentation generation.
505−class HasDocs layout where
506− docsFor :: Proxy layout -> (Endpoint, Action) -> API
507−
508−-- | The class that lets us display a sample JSON input or output
509−-- when generating documentation for endpoints that either:
510−--
511−-- - expect a request body, or
512−-- - return a non empty response body
513−--
514−-- Example of an instance:
515−--
516−-- > {-# LANGUAGE DeriveGeneric #-}
517−-- > {-# LANGUAGE OverloadedStrings #-}
518−-- >
519−-- > import Data.Aeson
520−-- > import Data.Text
521−-- > import GHC.Generics
522−-- >
523−-- > data Greet = Greet { _msg :: Text }
524−-- > deriving (Generic, Show)
525−-- >
526−-- > instance FromJSON Greet
527−-- > instance ToJSON Greet
528−-- >
529−-- > instance ToSample Greet where
530−-- > toSample = Just g
531−-- >
532−-- > where g = Greet "Hello, haskeller!"
533−--
534−-- You can also instantiate this class using 'toSamples' instead of
535−-- 'toSample': it lets you specify different responses along with
536−-- some context (as 'Text') that explains when you're supposed to
537−-- get the corresponding response.
538−class ToJSON a => ToSample a where
539− {-# MINIMAL (toSample | toSamples) #-}
540− toSample :: Maybe a
541− toSample = snd <$> listToMaybe samples
542− where samples = toSamples :: [(Text, a)]
543−
544− toSamples :: [(Text, a)]
545− toSamples = maybe [] (return . ("",)) s
546− where s = toSample :: Maybe a
547−
548−-- | Synthesise a sample value of a type, encoded in the specified media types.
549−sampleByteString
550− :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
551− => Proxy ctypes
552− -> Proxy a
553− -> [(M.MediaType, ByteString)]
554−sampleByteString ctypes@Proxy Proxy =
555− maybe [] (allMimeRender ctypes) (toSample :: Maybe a)
556−
557−-- | Synthesise a list of sample values of a particular type, encoded in the
558−-- specified media types.
559−sampleByteStrings
560− :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
561− => Proxy ctypes
562− -> Proxy a
563− -> [(Text, M.MediaType, ByteString)]
564−sampleByteStrings ctypes@Proxy Proxy =
565− let samples = toSamples :: [(Text, a)]
566− enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s
567− in concatMap enc samples
568−
569−-- | Generate a list of 'MediaType' values describing the content types
570−-- accepted by an API component.
571−class SupportedTypes (list :: [*]) where
572− supportedTypes :: Proxy list -> [M.MediaType]
573−
574−instance SupportedTypes '[] where
575− supportedTypes Proxy = []
576−
577−instance (Accept ctype, SupportedTypes rest) => SupportedTypes (ctype ': rest)
578− where
579− supportedTypes Proxy =
580− contentType (Proxy :: Proxy ctype) : supportedTypes (Proxy :: Proxy rest)
581−
582−-- | The class that helps us automatically get documentation
583−-- for GET parameters.
584−--
585−-- Example of an instance:
586−--
587−-- > instance ToParam (QueryParam "capital" Bool) where
588−-- > toParam _ =
589−-- > DocQueryParam "capital"
590−-- > ["true", "false"]
591−-- > "Get the greeting message in uppercase (true) or not (false). Default is false."
592−class ToParam t where
593− toParam :: Proxy t -> DocQueryParam
594−
595−-- | The class that helps us automatically get documentation
596−-- for URL captures.
597−--
598−-- Example of an instance:
599−--
600−-- > instance ToCapture (Capture "name" Text) where
601−-- > toCapture _ = DocCapture "name" "name of the person to greet"
602−class ToCapture c where
603− toCapture :: Proxy c -> DocCapture
604−
605−-- | Generate documentation in Markdown format for
606−-- the given 'API'.
607−markdown :: API -> String
608−markdown api = unlines $
609− introsStr (api ^. apiIntros)
610− ++ (concatMap (uncurry printEndpoint) . sort . HM.toList $ api ^. apiEndpoints)
611−
612− where printEndpoint :: Endpoint -> Action -> [String]
613− printEndpoint endpoint action =
614− str :
615− "" :
616− notesStr (action ^. notes) ++
617− capturesStr (action ^. captures) ++
618− mxParamsStr (action ^. mxParams) ++
619− headersStr (action ^. headers) ++
620− paramsStr (action ^. params) ++
621− rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
622− responseStr (action ^. response) ++
623− []
624−
625− where str = "## " ++ show (endpoint^.method)
626− ++ " " ++ showPath (endpoint^.path)
627−
628− introsStr :: [DocIntro] -> [String]
629− introsStr = concatMap introStr
630−
631− introStr :: DocIntro -> [String]
632− introStr i =
633− ("#### " ++ i ^. introTitle) :
634− "" :
635− intersperse "" (i ^. introBody) ++
636− "" :
637− []
638−
639− notesStr :: [DocNote] -> [String]
640− notesStr = concatMap noteStr
641−
642− noteStr :: DocNote -> [String]
643− noteStr nt =
644− ("#### " ++ nt ^. noteTitle) :
645− "" :
646− intersperse "" (nt ^. noteBody) ++
647− "" :
648− []
649−
650− capturesStr :: [DocCapture] -> [String]
651− capturesStr [] = []
652− capturesStr l =
653− "#### Captures:" :
654− "" :
655− map captureStr l ++
656− "" :
657− []
658−
659− captureStr cap =
660− "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
661−
662− mxParamsStr :: [(String, [DocQueryParam])] -> [String]
663− mxParamsStr [] = []
664− mxParamsStr l =
665− "#### Matrix Parameters:" :
666− "" :
667− map segmentStr l
668− segmentStr :: (String, [DocQueryParam]) -> String
669− segmentStr (segment, l) = unlines $
670− ("**" ++ segment ++ "**:") :
671− "" :
672− map paramStr l ++
673− "" :
674− []
675−
676− headersStr :: [Text] -> [String]
677− headersStr [] = []
678− headersStr l = [""] ++ map headerStr l ++ [""]
679−
680− where headerStr hname = "- This endpoint is sensitive to the value of the **"
681− ++ unpack hname ++ "** HTTP header."
682−
683− paramsStr :: [DocQueryParam] -> [String]
684− paramsStr [] = []
685− paramsStr l =
686− "#### GET Parameters:" :
687− "" :
688− map paramStr l ++
689− "" :
690− []
691−
692− paramStr param = unlines $
693− ("- " ++ param ^. paramName) :
694− (if (not (null values) || param ^. paramKind /= Flag)
695− then [" - **Values**: *" ++ intercalate ", " values ++ "*"]
696− else []) ++
697− (" - **Description**: " ++ param ^. paramDesc) :
698− (if (param ^. paramKind == List)
699− then [" - This parameter is a **list**. All GET parameters with the name "
700− ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]
701− else []) ++
702− (if (param ^. paramKind == Flag)
703− then [" - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]
704− else []) ++
705− []
706−
707− where values = param ^. paramValues
708−
709− rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]
710− rqbodyStr [] [] = []
711− rqbodyStr types samples =
712− ["#### Request:", ""]
713− <> formatTypes types
714− <> concatMap formatBody samples
715−
716− formatTypes [] = []
717− formatTypes ts = ["- Supported content types are:", ""]
718− <> map (\t -> " - `" <> show t <> "`") ts
719− <> [""]
720−
721− formatBody (m, b) =
722− "- Example: `" <> cs (show m) <> "`" :
723− contentStr m b
724−
725− markdownForType mime_type =
726− case (M.mainType mime_type, M.subType mime_type) of
727− ("text", "html") -> "html"
728− ("application", "xml") -> "xml"
729− ("application", "json") -> "javascript"
730− ("application", "javascript") -> "javascript"
731− ("text", "css") -> "css"
732− (_, _) -> ""
733−
734− contentStr mime_type body =
735− "" :
736− "```" <> markdownForType mime_type :
737− cs body :
738− "```" :
739− "" :
740− []
741−
742− responseStr :: Response -> [String]
743− responseStr resp =
744− "#### Response:" :
745− "" :
746− ("- Status code " ++ show (resp ^. respStatus)) :
747− "" :
748− formatTypes (resp ^. respTypes) ++
749− bodies
750−
751− where bodies = case resp ^. respBody of
752− [] -> ["- No response body\n"]
753− [("", t, r)] -> "- Response body as below." : contentStr t r
754− xs ->
755− concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs
756−
757−-- * Instances
758−
759−-- | The generated docs for @a ':<|>' b@ just appends the docs
760−-- for @a@ with the docs for @b@.
761−instance (HasDocs layout1, HasDocs layout2)
762− => HasDocs (layout1 :<|> layout2) where
763−
764− docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
765−
766− where p1 :: Proxy layout1
767− p1 = Proxy
768−
769− p2 :: Proxy layout2
770− p2 = Proxy
771−
772−-- | @"books" :> 'Capture' "isbn" Text@ will appear as
773−-- @/books/:isbn@ in the docs.
774−instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
775− => HasDocs (Capture sym a :> sublayout) where
776−
777− docsFor Proxy (endpoint, action) =
778− docsFor sublayoutP (endpoint', action')
779−
780− where sublayoutP = Proxy :: Proxy sublayout
781− captureP = Proxy :: Proxy (Capture sym a)
782−
783− action' = over captures (|> toCapture captureP) action
784− endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint
785− symP = Proxy :: Proxy sym
786−
787−
788−instance HasDocs Delete where
789− docsFor Proxy (endpoint, action) =
790− single endpoint' action'
791−
792− where endpoint' = endpoint & method .~ DocDELETE
793−
794− action' = action & response.respBody .~ []
795− & response.respStatus .~ 204
796−
797−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
798− => HasDocs (Get cts a) where
799− docsFor Proxy (endpoint, action) =
800− single endpoint' action'
801−
802− where endpoint' = endpoint & method .~ DocGET
803− action' = action & response.respBody .~ sampleByteStrings t p
804− & response.respTypes .~ supportedTypes t
805− t = Proxy :: Proxy cts
806− p = Proxy :: Proxy a
807−
808−instance (KnownSymbol sym, HasDocs sublayout)
809− => HasDocs (Header sym a :> sublayout) where
810− docsFor Proxy (endpoint, action) =
811− docsFor sublayoutP (endpoint, action')
812−
813− where sublayoutP = Proxy :: Proxy sublayout
814− action' = over headers (|> headername) action
815− headername = pack $ symbolVal (Proxy :: Proxy sym)
816−
817−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
818− => HasDocs (Post cts a) where
819− docsFor Proxy (endpoint, action) =
820− single endpoint' action'
821−
822− where endpoint' = endpoint & method .~ DocPOST
823− action' = action & response.respBody .~ sampleByteStrings t p
824− & response.respTypes .~ supportedTypes t
825− & response.respStatus .~ 201
826− t = Proxy :: Proxy cts
827− p = Proxy :: Proxy a
828−
829−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
830− => HasDocs (Put cts a) where
831− docsFor Proxy (endpoint, action) =
832− single endpoint' action'
833−
834− where endpoint' = endpoint & method .~ DocPUT
835− action' = action & response.respBody .~ sampleByteStrings t p
836− & response.respTypes .~ supportedTypes t
837− & response.respStatus .~ 200
838− t = Proxy :: Proxy cts
839− p = Proxy :: Proxy a
840−
841−instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
842− => HasDocs (QueryParam sym a :> sublayout) where
843−
844− docsFor Proxy (endpoint, action) =
845− docsFor sublayoutP (endpoint, action')
846−
847− where sublayoutP = Proxy :: Proxy sublayout
848− paramP = Proxy :: Proxy (QueryParam sym a)
849− action' = over params (|> toParam paramP) action
850−
851−instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
852− => HasDocs (QueryParams sym a :> sublayout) where
853−
854− docsFor Proxy (endpoint, action) =
855− docsFor sublayoutP (endpoint, action')
856−
857− where sublayoutP = Proxy :: Proxy sublayout
858− paramP = Proxy :: Proxy (QueryParams sym a)
859− action' = over params (|> toParam paramP) action
860−
861−
862−instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
863− => HasDocs (QueryFlag sym :> sublayout) where
864−
865− docsFor Proxy (endpoint, action) =
866− docsFor sublayoutP (endpoint, action')
867−
868− where sublayoutP = Proxy :: Proxy sublayout
869− paramP = Proxy :: Proxy (QueryFlag sym)
870− action' = over params (|> toParam paramP) action
871−
872−
873−instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout)
874− => HasDocs (MatrixParam sym a :> sublayout) where
875−
876− docsFor Proxy (endpoint, action) =
877− docsFor sublayoutP (endpoint', action')
878−
879− where sublayoutP = Proxy :: Proxy sublayout
880− paramP = Proxy :: Proxy (MatrixParam sym a)
881− segment = endpoint ^. (path._last)
882− segment' = action ^. (mxParams._last._1)
883− endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=<value>") endpoint
884−
885− action' = if segment' /= segment
886− -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list
887− then over mxParams (|> (segment, [toParam paramP])) action
888− -- We've already inserted a matrix parameter for this segment, append to the existing list
889− else action & mxParams._last._2 <>~ [toParam paramP]
890− symP = Proxy :: Proxy sym
891−
892−
893−instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout)
894− => HasDocs (MatrixParams sym a :> sublayout) where
895−
896− docsFor Proxy (endpoint, action) =
897− docsFor sublayoutP (endpoint', action)
898−
899− where sublayoutP = Proxy :: Proxy sublayout
900− endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "=<value>"]) endpoint
901− symP = Proxy :: Proxy sym
902−
903−
904−instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
905− => HasDocs (MatrixFlag sym :> sublayout) where
906−
907− docsFor Proxy (endpoint, action) =
908− docsFor sublayoutP (endpoint', action)
909−
910− where sublayoutP = Proxy :: Proxy sublayout
911−
912− endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
913− symP = Proxy :: Proxy sym
914−
915−instance HasDocs Raw where
916− docsFor _proxy (endpoint, action) =
917− single endpoint action
918−
919−-- TODO: We use 'AllMimeRender' here because we need to be able to show the
920−-- example data. However, there's no reason to believe that the instances of
921−-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
922−-- both are even defined) for any particular type.
923−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)
924− => HasDocs (ReqBody cts a :> sublayout) where
925−
926− docsFor Proxy (endpoint, action) =
927− docsFor sublayoutP (endpoint, action')
928−
929− where sublayoutP = Proxy :: Proxy sublayout
930− action' = action & rqbody .~ sampleByteString t p
931− & rqtypes .~ supportedTypes t
932− t = Proxy :: Proxy cts
933− p = Proxy :: Proxy a
934−
935−instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where
936−
937− docsFor Proxy (endpoint, action) =
938− docsFor sublayoutP (endpoint', action)
939−
940− where sublayoutP = Proxy :: Proxy sublayout
941− endpoint' = endpoint & path <>~ [symbolVal pa]
942− pa = Proxy :: Proxy path
943−
944−{-
945−
946−-- | Serve your API's docs as markdown embedded in an html \<pre> tag.
947−--
948−-- > type MyApi = "users" :> Get [User]
949−-- > :<|> "docs :> Raw
950−-- >
951−-- > apiProxy :: Proxy MyApi
952−-- > apiProxy = Proxy
953−-- >
954−-- > server :: Server MyApi
955−-- > server = listUsers
956−-- > :<|> serveDocumentation apiProxy
957−serveDocumentation :: HasDocs api => Proxy api -> Server Raw
958−serveDocumentation proxy _request respond =
959− respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy
960−
961−toHtml :: String -> String
962−toHtml md =
963− "<html>" ++
964− "<body>" ++
965− "<pre>" ++
966− md ++
967− "</pre>" ++
968− "</body>" ++
969− "</html>"
970−-}
168+import Servant.Docs.Internal