@@ -148,8 +148,8 @@ module Servant.Docs
148 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
148 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
149 , DocNote(..), noteTitle, noteBody
149 , DocNote(..), noteTitle, noteBody
150 , DocIntro(..)
150 , DocIntro(..)
151− , Response, respStatus, respBody, defResponse
151+ , Response, respStatus, respTypes, respBody, defResponse
152− , Action, captures, headers, notes, params, rqbody, response, defAction
152+ , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction
155 , -- * Useful modules when defining your doc printers
155 , -- * Useful modules when defining your doc printers
@@ -304,22 +304,24 @@ data DocNote = DocNote
304data ParamKind = Normal | List | Flag
304data ParamKind = Normal | List | Flag
305 deriving (Eq, Show)
305 deriving (Eq, Show)
307−-- | A type to represent an HTTP response. Has an 'Int' status and
307+-- | A type to represent an HTTP response. Has an 'Int' status, a list of
308+-- possible 'MediaType's, and a list of example 'ByteString' response bodies.
308−-- a 'Maybe ByteString' response body. Tweak 'defResponse' using
309+-- Tweak 'defResponse' using the 'respStatus', 'respTypes' and 'respBody'
309−-- the 'respStatus' and 'respBody' lenses if you want.
310+-- lenses if you want.
311-- If you want to respond with a non-empty response body, you'll most likely
312-- If you want to respond with a non-empty response body, you'll most likely
312-- want to write a 'ToSample' instance for the type that'll be represented
313-- want to write a 'ToSample' instance for the type that'll be represented
313−-- as some JSON in the response.
314+-- as encoded data in the response.
315−-- Can be tweaked with two lenses.
316+-- Can be tweaked with three lenses.
317-- > λ> defResponse
318-- > λ> defResponse
318−-- > Response {_respStatus = 200, _respBody = []}
319+-- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
319-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
320-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
320−-- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
321+-- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
321data Response = Response
322data Response = Response
322 { _respStatus :: Int
323 { _respStatus :: Int
324+ , _respTypes :: [M.MediaType]
323 , _respBody :: [(Text, M.MediaType, ByteString)]
325 , _respBody :: [(Text, M.MediaType, ByteString)]
324 } deriving (Eq, Show)
326 } deriving (Eq, Show)
@@ -332,7 +334,7 @@ data Response = Response
332-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
334-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
333-- > Response {_respStatus = 204, _respBody = Just "[]"}
335-- > Response {_respStatus = 204, _respBody = Just "[]"}
334defResponse :: Response
336defResponse :: Response
335−defResponse = Response 200 []
337+defResponse = Response 200 [] []
337-- | A datatype that represents everything that can happen
339-- | A datatype that represents everything that can happen
338-- at an endpoint, with its lenses:
340-- at an endpoint, with its lenses:
@@ -345,13 +347,14 @@ defResponse = Response 200 []
345-- You can tweak an 'Action' (like the default 'defAction') with these lenses
347-- You can tweak an 'Action' (like the default 'defAction') with these lenses
346-- to transform an action and add some information to it.
348-- to transform an action and add some information to it.
347data Action = Action
349data Action = Action
348− { _captures :: [DocCapture] -- type collected + user supplied info
350+ { _captures :: [DocCapture] -- type collected + user supplied info
349− , _headers :: [Text] -- type collected
351+ , _headers :: [Text] -- type collected
350− , _params :: [DocQueryParam] -- type collected + user supplied info
352+ , _params :: [DocQueryParam] -- type collected + user supplied info
351− , _notes :: [DocNote] -- user supplied
353+ , _notes :: [DocNote] -- user supplied
352− , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
354+ , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
355+ , _rqtypes :: [M.MediaType] -- type collected
353− , _rqbody :: Maybe [(M.MediaType, ByteString)] -- user supplied
356+ , _rqbody :: [(M.MediaType, ByteString)] -- user supplied
354− , _response :: Response -- user supplied
357+ , _response :: Response -- user supplied
355 } deriving (Eq, Show)
358 } deriving (Eq, Show)
357-- Default 'Action'. Has no 'captures', no GET 'params', expects
360-- Default 'Action'. Has no 'captures', no GET 'params', expects
@@ -370,7 +373,8 @@ defAction =
374 defResponse
378 defResponse
376-- | Create an API that's comprised of a single endpoint.
380-- | Create an API that's comprised of a single endpoint.
@@ -449,9 +453,9 @@ sampleByteString
449 :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
453 :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
450 => Proxy ctypes
454 => Proxy ctypes
451 -> Proxy a
455 -> Proxy a
452− -> Maybe [(M.MediaType, ByteString)]
456+ -> [(M.MediaType, ByteString)]
453sampleByteString ctypes@Proxy Proxy =
457sampleByteString ctypes@Proxy Proxy =
454− fmap (amr ctypes) (toSample :: Maybe a)
458+ maybe [] (amr ctypes) (toSample :: Maybe a)
456-- | Synthesise a list of sample values of a particular type, encoded in the
460-- | Synthesise a list of sample values of a particular type, encoded in the
457-- specified media types.
461-- specified media types.
@@ -465,6 +469,25 @@ sampleByteStrings ctypes@Proxy Proxy =
465 enc (t, s) = uncurry (t,,) <$> amr ctypes s
469 enc (t, s) = uncurry (t,,) <$> amr ctypes s
466 in concatMap enc samples
470 in concatMap enc samples
472+-- | Generate a list of 'MediaType' values describing the content types
473+-- accepted by an API component.
474+class SupportedTypes (list :: [*]) where
475+ supportedTypes :: Proxy list -> [M.MediaType]
477+instance SupportedTypes '[] where
478+ supportedTypes Proxy = []
480+instance (Accept ctype) => SupportedTypes '[ctype] where
481+ supportedTypes Proxy = [ contentType (Proxy :: Proxy ctype) ]
483+instance (Accept ctype, Accept ctype', SupportedTypes rest)
484+ => SupportedTypes (ctype ': ctype' ': rest) where
486+ supportedTypes Proxy =
487+ [ contentType (Proxy :: Proxy ctype)
488+ , contentType (Proxy :: Proxy ctype')
489+ ] <> supportedTypes (Proxy :: Proxy rest)
468-- | The class that helps us automatically get documentation
491-- | The class that helps us automatically get documentation
469-- for GET parameters.
492-- for GET parameters.
@@ -504,7 +527,7 @@ markdown api = unlines $
504 mxParamsStr (action ^. mxParams) ++
527 mxParamsStr (action ^. mxParams) ++
505 headersStr (action ^. headers) ++
528 headersStr (action ^. headers) ++
506 paramsStr (action ^. params) ++
529 paramsStr (action ^. params) ++
507− rqbodyStr (action ^. rqbody) ++
530+ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
508 responseStr (action ^. response) ++
531 responseStr (action ^. response) ++
@@ -518,7 +541,7 @@ markdown api = unlines $
518 introStr i =
541 introStr i =
519 ("#### " ++ i ^. introTitle) :
542 ("#### " ++ i ^. introTitle) :
521− intersperse "" (i ^. introBody) ++
544+ intersperse "" (i ^. introBody) ++
@@ -541,6 +564,7 @@ markdown api = unlines $
541 map captureStr l ++
564 map captureStr l ++
544 captureStr cap =
568 captureStr cap =
545 "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
569 "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
@@ -552,6 +576,7 @@ markdown api = unlines $
552 map segmentStr l ++
576 map segmentStr l ++
555 segmentStr :: (String, [DocQueryParam]) -> String
580 segmentStr :: (String, [DocQueryParam]) -> String
556 segmentStr (segment, l) = unlines $
581 segmentStr (segment, l) = unlines $
557 ("**" ++ segment ++ "**:") :
582 ("**" ++ segment ++ "**:") :
@@ -575,8 +600,9 @@ markdown api = unlines $
575 map paramStr l ++
600 map paramStr l ++
578 paramStr param = unlines $
604 paramStr param = unlines $
579− (" - " ++ param ^. paramName) :
605+ ("- " ++ param ^. paramName) :
580 (if (not (null values) || param ^. paramKind /= Flag)
606 (if (not (null values) || param ^. paramKind /= Flag)
581 then [" - **Values**: *" ++ intercalate ", " values ++ "*"]
607 then [" - **Values**: *" ++ intercalate ", " values ++ "*"]
582 else []) ++
608 else []) ++
@@ -592,12 +618,20 @@ markdown api = unlines $
593 where values = param ^. paramValues
619 where values = param ^. paramValues
595− rqbodyStr :: Maybe [(M.MediaType, ByteString)]-> [String]
621+ rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]
596− rqbodyStr Nothing = []
622+ rqbodyStr [] [] = []
623+ rqbodyStr types samples =
624+ ["#### Request:", ""]
625+ <> formatTypes types
597− rqbodyStr (Just b) = concatMap formatBody b
626+ <> concatMap formatBody samples
629+ formatTypes ts = ["- Supported content types are: ", ""]
630+ <> map (\t -> " - `" <> show t <> "`") ts
599 formatBody (m, b) =
633 formatBody (m, b) =
600− "#### Request Body: `" <> show (M.mainType m <> "/" <> M.subType m) <> "`" :
634+ "- Example: `" <> cs (M.mainType m <> "/" <> M.subType m) <> "`" :
601 contentStr m b
635 contentStr m b
603 markdownForType mime_type =
637 markdownForType mime_type =
@@ -606,6 +640,7 @@ markdown api = unlines $
606 ("application", "xml") -> "xml"
640 ("application", "xml") -> "xml"
607 ("application", "json") -> "javascript"
641 ("application", "json") -> "javascript"
608 ("application", "javascript") -> "javascript"
642 ("application", "javascript") -> "javascript"
643+ ("text", "css") -> "css"
609 (_, _) -> ""
644 (_, _) -> ""
611 contentStr mime_type body =
646 contentStr mime_type body =
@@ -620,14 +655,16 @@ markdown api = unlines $
620 responseStr resp =
655 responseStr resp =
621 "#### Response:" :
656 "#### Response:" :
623− (" - Status code " ++ show (resp ^. respStatus)) :
658+ ("- Status code " ++ show (resp ^. respStatus)) :
660+ formatTypes (resp ^. respTypes) ++
626 where bodies = case resp ^. respBody of
663 where bodies = case resp ^. respBody of
627− [] -> [" - No response body\n"]
664+ [] -> ["- No response body\n"]
628− [("", t, r)] -> " - Response body as below." : contentStr t r
665+ [("", t, r)] -> "- Response body as below." : contentStr t r
630− concatMap (\(ctx, t, r) -> (" - " <> T.unpack ctx) : contentStr t r) xs
667+ concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs
632-- * Instances
669-- * Instances
@@ -669,16 +706,17 @@ instance HasDocs Delete where
669 action' = action & response.respBody .~ []
706 action' = action & response.respBody .~ []
670 & response.respStatus .~ 204
707 & response.respStatus .~ 204
672−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Get cts a) where
709+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
710+ => HasDocs (Get cts a) where
673 docsFor Proxy (endpoint, action) =
711 docsFor Proxy (endpoint, action) =
674 single endpoint' action'
712 single endpoint' action'
676 where endpoint' = endpoint & method .~ DocGET
714 where endpoint' = endpoint & method .~ DocGET
677 action' = action & response.respBody .~ sampleByteStrings t p
715 action' = action & response.respBody .~ sampleByteStrings t p
716+ & response.respTypes .~ supportedTypes t
678 t = Proxy :: Proxy cts
717 t = Proxy :: Proxy cts
679 p = Proxy :: Proxy a
718 p = Proxy :: Proxy a
682instance (KnownSymbol sym, HasDocs sublayout)
720instance (KnownSymbol sym, HasDocs sublayout)
683 => HasDocs (Header sym a :> sublayout) where
721 => HasDocs (Header sym a :> sublayout) where
684 docsFor Proxy (endpoint, action) =
722 docsFor Proxy (endpoint, action) =
@@ -688,22 +726,26 @@ instance (KnownSymbol sym, HasDocs sublayout)
688 action' = over headers (|> headername) action
726 action' = over headers (|> headername) action
689 headername = pack $ symbolVal (Proxy :: Proxy sym)
727 headername = pack $ symbolVal (Proxy :: Proxy sym)
691−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Post cts a) where
729+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
730+ => HasDocs (Post cts a) where
692 docsFor Proxy (endpoint, action) =
731 docsFor Proxy (endpoint, action) =
693 single endpoint' action'
732 single endpoint' action'
695 where endpoint' = endpoint & method .~ DocPOST
734 where endpoint' = endpoint & method .~ DocPOST
696 action' = action & response.respBody .~ sampleByteStrings t p
735 action' = action & response.respBody .~ sampleByteStrings t p
736+ & response.respTypes .~ supportedTypes t
697 & response.respStatus .~ 201
737 & response.respStatus .~ 201
698 t = Proxy :: Proxy cts
738 t = Proxy :: Proxy cts
699 p = Proxy :: Proxy a
739 p = Proxy :: Proxy a
701−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a) => HasDocs (Put cts a) where
741+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
742+ => HasDocs (Put cts a) where
702 docsFor Proxy (endpoint, action) =
743 docsFor Proxy (endpoint, action) =
703 single endpoint' action'
744 single endpoint' action'
705 where endpoint' = endpoint & method .~ DocPUT
746 where endpoint' = endpoint & method .~ DocPUT
706 action' = action & response.respBody .~ sampleByteStrings t p
747 action' = action & response.respBody .~ sampleByteStrings t p
748+ & response.respTypes .~ supportedTypes t
707 & response.respStatus .~ 200
749 & response.respStatus .~ 200
708 t = Proxy :: Proxy cts
750 t = Proxy :: Proxy cts
709 p = Proxy :: Proxy a
751 p = Proxy :: Proxy a
@@ -790,7 +832,7 @@ instance HasDocs Raw where
790-- example data. However, there's no reason to believe that the instances of
832-- example data. However, there's no reason to believe that the instances of
791-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
833-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
792-- both are even defined) for any particular type.
834-- both are even defined) for any particular type.
793−instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout)
835+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)
794 => HasDocs (ReqBody cts a :> sublayout) where
836 => HasDocs (ReqBody cts a :> sublayout) where
796 docsFor Proxy (endpoint, action) =
838 docsFor Proxy (endpoint, action) =
@@ -798,6 +840,7 @@ instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout)
799 where sublayoutP = Proxy :: Proxy sublayout
841 where sublayoutP = Proxy :: Proxy sublayout
800 action' = action & rqbody .~ sampleByteString t p
842 action' = action & rqbody .~ sampleByteString t p
843+ & rqtypes .~ supportedTypes t
801 t = Proxy :: Proxy cts
844 t = Proxy :: Proxy cts
802 p = Proxy :: Proxy a
845 p = Proxy :: Proxy a