eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #12 from anchor/jkarni/content-types

Browse source 
Extend servant-docs to support content types
This commit is contained in:
Christian Marie 2015-02-23 09:52:55 +11:00
commit 5df017267e
4 changed files with 169 additions and 90 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
README.md
View file

@ -27,10 +27,15 @@ import Servant
data Greet = Greet { _msg :: Text } data Greet = Greet { _msg :: Text }
deriving (Generic, Show) deriving (Generic, Show)
-- we get our JSON serialization for free -- we get our JSON serialization for free. This will be used by the default
-- 'MimeRender' instance for 'JSON'.
instance FromJSON Greet instance FromJSON Greet
instance ToJSON Greet instance ToJSON Greet
-- We can also implement 'MimeRender' explicitly for additional formats.
instance MimeRender PlainText Greet where
toByteString Proxy (Greet s) = "<h1>" <> cs s <> "</h1>"
-- we provide a sample value for the 'Greet' type -- we provide a sample value for the 'Greet' type
instance ToSample Greet where instance ToSample Greet where
toSample = Just g toSample = Just g
@ -51,8 +56,8 @@ instance ToCapture (Capture "greetid" Text) where
-- API specification -- API specification
type TestApi = type TestApi =
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON,PlainText] Greet
:<|> "greet" :> RQBody Greet :> Post Greet :<|> "greet" :> RQBody '[JSON] Greet :> Post '[JSON] Greet
:<|> "delete" :> Capture "greetid" Text :> Delete :<|> "delete" :> Capture "greetid" Text :> Delete
testApi :: Proxy TestApi testApi :: Proxy TestApi

26
example/greet.hs
View file

@ -1,12 +1,14 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
import Data.Aeson import Data.Aeson
import Data.Proxy import Data.Proxy
import Data.Text(Text) import Data.String.Conversions
import Data.Text (Text)
import GHC.Generics import GHC.Generics
import Servant.API import Servant.API
import Servant.Docs import Servant.Docs
@ -17,9 +19,15 @@ import Servant.Docs
newtype Greet = Greet Text newtype Greet = Greet Text
deriving (Generic, Show) deriving (Generic, Show)
-- | We can get JSON support automatically. This will be used to parse
-- and encode a Greeting as 'JSON'.
instance FromJSON Greet instance FromJSON Greet
instance ToJSON Greet instance ToJSON Greet
-- | We can also implement 'MimeRender' for additional formats like 'PlainText'.
instance MimeRender PlainText Greet where
toByteString Proxy (Greet s) = "\"" <> cs s <> "\""
-- We add some useful annotations to our captures, -- We add some useful annotations to our captures,
-- query parameters and request body to make the docs -- query parameters and request body to make the docs
-- really helpful. -- really helpful.
@ -65,12 +73,12 @@ intro2 = DocIntro "This title is below the last"
-- API specification -- API specification
type TestApi = type TestApi =
-- GET /hello/:name?capital={true, false} returns a Greet as JSON -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText
"hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
-- POST /greet with a Greet as JSON in the request body, -- POST /greet with a Greet as JSON in the request body,
-- returns a Greet as JSON -- returns a Greet as JSON
:<|> "greet" :> ReqBody Greet :> Post Greet :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
-- DELETE /greet/:greetid -- DELETE /greet/:greetid
:<|> "greet" :> Capture "greetid" Text :> Delete :<|> "greet" :> Capture "greetid" Text :> Delete

5
servant-docs.cabal
View file

@ -29,13 +29,12 @@ library
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, aeson , aeson
, aeson-pretty < 0.8
, bytestring , bytestring
, hashable , hashable
, http-media
, lens , lens
, servant >= 0.2.1 , servant >= 0.2.1
, string-conversions , string-conversions
, system-filepath
, text , text
, unordered-containers , unordered-containers
hs-source-dirs: src hs-source-dirs: src
@ -46,5 +45,5 @@ executable greet-docs
main-is: greet.hs main-is: greet.hs
hs-source-dirs: example hs-source-dirs: example
ghc-options: -Wall ghc-options: -Wall
build-depends: base, aeson, servant, servant-docs, text build-depends: base, aeson, servant, servant-docs, string-conversions, text
default-language: Haskell2010 default-language: Haskell2010

217
src/Servant/Docs.hs
View file

@ -1,13 +1,16 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- | This module lets you get API docs for free. It lets generate -- | This module lets you get API docs for free. It lets generate
@ -102,11 +105,11 @@
-- > -- API specification -- > -- API specification
-- > type TestApi = -- > type TestApi =
-- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON -- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON
-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet -- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
-- > -- >
-- > -- POST /greet with a Greet as JSON in the request body, -- > -- POST /greet with a Greet as JSON in the request body,
-- > -- returns a Greet as JSON -- > -- returns a Greet as JSON
-- > :<|> "greet" :> ReqBody Greet :> Post Greet -- > :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
-- > -- >
-- > -- DELETE /greet/:greetid -- > -- DELETE /greet/:greetid
-- > :<|> "greet" :> Capture "greetid" Text :> Delete -- > :<|> "greet" :> Capture "greetid" Text :> Delete
@ -145,8 +148,8 @@ module Servant.Docs
, DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind
, DocNote(..), noteTitle, noteBody , DocNote(..), noteTitle, noteBody
, DocIntro(..) , DocIntro(..)
, Response, respStatus, respBody, defResponse , Response, respStatus, respTypes, respBody, defResponse
, Action, captures, headers, notes, params, rqbody, response, defAction , Action, captures, headers, notes, params, rqtypes, rqbody, response, defAction
, single , single
, -- * Useful modules when defining your doc printers , -- * Useful modules when defining your doc printers
@ -154,25 +157,27 @@ module Servant.Docs
, module Data.Monoid , module Data.Monoid
) where ) where
import Control.Lens hiding (Action) import Control.Applicative
import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Ord(comparing)
import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Hashable import Data.Hashable
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import Data.List import Data.List
import Data.Maybe (listToMaybe) import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Ord (comparing)
import Data.Proxy import Data.Proxy
import Data.Text (Text, pack, unpack)
import Data.String.Conversions import Data.String.Conversions
import Data.Text (Text, pack, unpack)
import GHC.Generics import GHC.Generics
import GHC.TypeLits import GHC.TypeLits
import Servant.API import Servant.API
import Servant.API.ContentTypes
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T import qualified Data.Text as T
import qualified Network.HTTP.Media as M
-- | Supported HTTP request methods -- | Supported HTTP request methods
data Method = DocDELETE -- ^ the DELETE method data Method = DocDELETE -- ^ the DELETE method
@ -299,23 +304,25 @@ data DocNote = DocNote
data ParamKind = Normal | List | Flag data ParamKind = Normal | List | Flag
deriving (Eq, Show) deriving (Eq, Show)
-- | A type to represent an HTTP response. Has an 'Int' status and -- | A type to represent an HTTP response. Has an 'Int' status, a list of
-- a 'Maybe ByteString' response body. Tweak 'defResponse' using -- possible 'MediaType's, and a list of example 'ByteString' response bodies.
-- the 'respStatus' and 'respBody' lenses if you want. -- Tweak 'defResponse' using the 'respStatus', 'respTypes' and 'respBody'
-- lenses if you want.
-- --
-- If you want to respond with a non-empty response body, you'll most likely -- If you want to respond with a non-empty response body, you'll most likely
-- want to write a 'ToSample' instance for the type that'll be represented -- want to write a 'ToSample' instance for the type that'll be represented
-- as some JSON in the response. -- as encoded data in the response.
-- --
-- Can be tweaked with two lenses. -- Can be tweaked with three lenses.
-- --
-- > λ> defResponse -- > λ> defResponse
-- > Response {_respStatus = 200, _respBody = []} -- > Response {_respStatus = 200, _respTypes = [], _respBody = []}
-- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")] -- > λ> defResponse & respStatus .~ 204 & respBody .~ [("If everything goes well", "{ \"status\": \"ok\" }")]
-- > Response {_respStatus = 204, _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]} -- > Response {_respStatus = 204, _respTypes = [], _respBody = [("If everything goes well", "{ \"status\": \"ok\" }")]}
data Response = Response data Response = Response
{ _respStatus :: Int { _respStatus :: Int
, _respBody :: [(Text, ByteString)] , _respTypes :: [M.MediaType]
, _respBody :: [(Text, M.MediaType, ByteString)]
} deriving (Eq, Show) } deriving (Eq, Show)
-- | Default response: status code 200, no response body. -- | Default response: status code 200, no response body.
@ -327,7 +334,7 @@ data Response = Response
-- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]" -- > λ> defResponse & respStatus .~ 204 & respBody .~ Just "[]"
-- > Response {_respStatus = 204, _respBody = Just "[]"} -- > Response {_respStatus = 204, _respBody = Just "[]"}
defResponse :: Response defResponse :: Response
defResponse = Response 200 [] defResponse = Response 200 [] []
-- | A datatype that represents everything that can happen -- | A datatype that represents everything that can happen
-- at an endpoint, with its lenses: -- at an endpoint, with its lenses:
@ -340,13 +347,14 @@ defResponse = Response 200 []
-- You can tweak an 'Action' (like the default 'defAction') with these lenses -- You can tweak an 'Action' (like the default 'defAction') with these lenses
-- to transform an action and add some information to it. -- to transform an action and add some information to it.
data Action = Action data Action = Action
{ _captures :: [DocCapture] -- type collected + user supplied info { _captures :: [DocCapture] -- type collected + user supplied info
, _headers :: [Text] -- type collected , _headers :: [Text] -- type collected
, _params :: [DocQueryParam] -- type collected + user supplied info , _params :: [DocQueryParam] -- type collected + user supplied info
, _notes :: [DocNote] -- user supplied , _notes :: [DocNote] -- user supplied
, _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info , _mxParams :: [(String, [DocQueryParam])] -- type collected + user supplied info
, _rqbody :: Maybe ByteString -- user supplied , _rqtypes :: [M.MediaType] -- type collected
, _response :: Response -- user supplied , _rqbody :: [(M.MediaType, ByteString)] -- user supplied
, _response :: Response -- user supplied
} deriving (Eq, Show) } deriving (Eq, Show)
-- Default 'Action'. Has no 'captures', no GET 'params', expects -- Default 'Action'. Has no 'captures', no GET 'params', expects
@ -365,7 +373,8 @@ defAction =
[] []
[] []
[] []
Nothing []
[]
defResponse defResponse
-- | Create an API that's comprised of a single endpoint. -- | Create an API that's comprised of a single endpoint.
@ -428,24 +437,50 @@ class HasDocs layout where
-- You can also instantiate this class using 'toSamples' instead of -- You can also instantiate this class using 'toSamples' instead of
-- 'toSample': it lets you specify different responses along with -- 'toSample': it lets you specify different responses along with
-- some context (as 'Text') that explains when you're supposed to -- some context (as 'Text') that explains when you're supposed to
-- get the corresponding response. -- get the corresponding response.
class ToJSON a => ToSample a where class ToJSON a => ToSample a where
{-# MINIMAL (toSample | toSamples) #-} {-# MINIMAL (toSample | toSamples) #-}
toSample :: Maybe a toSample :: Maybe a
toSample = fmap snd $ listToMaybe samples toSample = snd <$> listToMaybe samples
where samples = toSamples :: [(Text, a)] where samples = toSamples :: [(Text, a)]
toSamples :: [(Text, a)] toSamples :: [(Text, a)]
toSamples = maybe [] (return . ("",)) s toSamples = maybe [] (return . ("",)) s
where s = toSample :: Maybe a where s = toSample :: Maybe a
sampleByteString :: forall a. ToSample a => Proxy a -> Maybe ByteString -- | Synthesise a sample value of a type, encoded in the specified media types.
sampleByteString Proxy = fmap encodePretty (toSample :: Maybe a) sampleByteString
:: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
=> Proxy ctypes
-> Proxy a
-> [(M.MediaType, ByteString)]
sampleByteString ctypes@Proxy Proxy =
maybe [] (allMimeRender ctypes) (toSample :: Maybe a)
sampleByteStrings :: forall a. ToSample a => Proxy a -> [(Text, ByteString)] -- | Synthesise a list of sample values of a particular type, encoded in the
sampleByteStrings Proxy = samples & traverse._2 %~ encodePretty -- specified media types.
sampleByteStrings
:: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
=> Proxy ctypes
-> Proxy a
-> [(Text, M.MediaType, ByteString)]
sampleByteStrings ctypes@Proxy Proxy =
let samples = toSamples :: [(Text, a)]
enc (t, s) = uncurry (t,,) <$> allMimeRender ctypes s
in concatMap enc samples
where samples = toSamples :: [(Text, a)] -- | Generate a list of 'MediaType' values describing the content types
-- accepted by an API component.
class SupportedTypes (list :: [*]) where
supportedTypes :: Proxy list -> [M.MediaType]
instance SupportedTypes '[] where
supportedTypes Proxy = []
instance (Accept ctype, SupportedTypes rest) => SupportedTypes (ctype ': rest)
where
supportedTypes Proxy =
contentType (Proxy :: Proxy ctype) : supportedTypes (Proxy :: Proxy rest)
-- | The class that helps us automatically get documentation -- | The class that helps us automatically get documentation
-- for GET parameters. -- for GET parameters.
@ -486,7 +521,7 @@ markdown api = unlines $
mxParamsStr (action ^. mxParams) ++ mxParamsStr (action ^. mxParams) ++
headersStr (action ^. headers) ++ headersStr (action ^. headers) ++
paramsStr (action ^. params) ++ paramsStr (action ^. params) ++
rqbodyStr (action ^. rqbody) ++ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
responseStr (action ^. response) ++ responseStr (action ^. response) ++
[] []
@ -500,7 +535,7 @@ markdown api = unlines $
introStr i = introStr i =
("#### " ++ i ^. introTitle) : ("#### " ++ i ^. introTitle) :
"" : "" :
intersperse "" (i ^. introBody) ++ intersperse "" (i ^. introBody) ++
"" : "" :
[] []
@ -523,6 +558,7 @@ markdown api = unlines $
map captureStr l ++ map captureStr l ++
"" : "" :
[] []
captureStr cap = captureStr cap =
"- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc) "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
@ -534,6 +570,7 @@ markdown api = unlines $
map segmentStr l ++ map segmentStr l ++
"" : "" :
[] []
segmentStr :: (String, [DocQueryParam]) -> String segmentStr :: (String, [DocQueryParam]) -> String
segmentStr (segment, l) = unlines $ segmentStr (segment, l) = unlines $
("**" ++ segment ++ "**:") : ("**" ++ segment ++ "**:") :
@ -557,8 +594,9 @@ markdown api = unlines $
map paramStr l ++ map paramStr l ++
"" : "" :
[] []
paramStr param = unlines $ paramStr param = unlines $
(" - " ++ param ^. paramName) : ("- " ++ param ^. paramName) :
(if (not (null values) || param ^. paramKind /= Flag) (if (not (null values) || param ^. paramKind /= Flag)
then [" - **Values**: *" ++ intercalate ", " values ++ "*"] then [" - **Values**: *" ++ intercalate ", " values ++ "*"]
else []) ++ else []) ++
@ -574,16 +612,35 @@ markdown api = unlines $
where values = param ^. paramValues where values = param ^. paramValues
rqbodyStr :: Maybe ByteString -> [String] rqbodyStr :: [M.MediaType] -> [(M.MediaType, ByteString)]-> [String]
rqbodyStr Nothing = [] rqbodyStr [] [] = []
rqbodyStr (Just b) = rqbodyStr types samples =
"#### Request Body:" : ["#### Request:", ""]
jsonStr b <> formatTypes types
<> concatMap formatBody samples
jsonStr b = formatTypes [] = []
formatTypes ts = ["- Supported content types are: ", ""]
<> map (\t -> " - `" <> show t <> "`") ts
<> [""]
formatBody (m, b) =
"- Example: `" <> cs (show m) <> "`" :
contentStr m b
markdownForType mime_type =
case (M.mainType mime_type, M.subType mime_type) of
("text", "html") -> "html"
("application", "xml") -> "xml"
("application", "json") -> "javascript"
("application", "javascript") -> "javascript"
("text", "css") -> "css"
(_, _) -> ""
contentStr mime_type body =
"" : "" :
"``` javascript" : "``` " <> markdownForType mime_type :
cs b : cs body :
"```" : "```" :
"" : "" :
[] []
@ -592,14 +649,16 @@ markdown api = unlines $
responseStr resp = responseStr resp =
"#### Response:" : "#### Response:" :
"" : "" :
(" - Status code " ++ show (resp ^. respStatus)) : ("- Status code " ++ show (resp ^. respStatus)) :
"" :
formatTypes (resp ^. respTypes) ++
bodies bodies
where bodies = case resp ^. respBody of where bodies = case resp ^. respBody of
[] -> [" - No response body\n"] [] -> ["- No response body\n"]
[("", r)] -> " - Response body as below." : jsonStr r [("", t, r)] -> "- Response body as below." : contentStr t r
xs -> xs ->
concatMap (\(ctx, r) -> (" - " <> T.unpack ctx) : jsonStr r) xs concatMap (\(ctx, t, r) -> ("- " <> T.unpack ctx) : contentStr t r) xs
-- * Instances -- * Instances
@ -641,12 +700,15 @@ instance HasDocs Delete where
action' = action & response.respBody .~ [] action' = action & response.respBody .~ []
& response.respStatus .~ 204 & response.respStatus .~ 204
instance ToSample a => HasDocs (Get a) where instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
=> HasDocs (Get cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocGET where endpoint' = endpoint & method .~ DocGET
action' = action & response.respBody .~ sampleByteStrings p action' = action & response.respBody .~ sampleByteStrings t p
& response.respTypes .~ supportedTypes t
t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance (KnownSymbol sym, HasDocs sublayout) instance (KnownSymbol sym, HasDocs sublayout)
@ -658,29 +720,30 @@ instance (KnownSymbol sym, HasDocs sublayout)
action' = over headers (|> headername) action action' = over headers (|> headername) action
headername = pack $ symbolVal (Proxy :: Proxy sym) headername = pack $ symbolVal (Proxy :: Proxy sym)
instance ToSample a => HasDocs (Post a) where instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
=> HasDocs (Post cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocPOST where endpoint' = endpoint & method .~ DocPOST
action' = action & response.respBody .~ sampleByteStrings t p
action' = action & response.respBody .~ sampleByteStrings p & response.respTypes .~ supportedTypes t
& response.respStatus .~ 201 & response.respStatus .~ 201
t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance ToSample a => HasDocs (Put a) where instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
=> HasDocs (Put cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
where endpoint' = endpoint & method .~ DocPUT where endpoint' = endpoint & method .~ DocPUT
action' = action & response.respBody .~ sampleByteStrings t p
action' = action & response.respBody .~ sampleByteStrings p & response.respTypes .~ supportedTypes t
& response.respStatus .~ 200 & response.respStatus .~ 200
t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout) instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
=> HasDocs (QueryParam sym a :> sublayout) where => HasDocs (QueryParam sym a :> sublayout) where
@ -755,20 +818,24 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
symP = Proxy :: Proxy sym symP = Proxy :: Proxy sym
instance HasDocs Raw where instance HasDocs Raw where
docsFor _proxy (endpoint, action) = docsFor _proxy (endpoint, action) =
single endpoint action single endpoint action
instance (ToSample a, HasDocs sublayout) -- TODO: We use 'AllMimeRender' here because we need to be able to show the
=> HasDocs (ReqBody a :> sublayout) where -- example data. However, there's no reason to believe that the instances of
-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
-- both are even defined) for any particular type.
instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout, SupportedTypes cts)
=> HasDocs (ReqBody cts a :> sublayout) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action') docsFor sublayoutP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout where sublayoutP = Proxy :: Proxy sublayout
action' = action & rqbody .~ sampleByteString t p
action' = action & rqbody .~ sampleByteString p & rqtypes .~ supportedTypes t
t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where