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

add docs support for Header

Browse source
This commit is contained in:
Alp Mestanogullari 2014-12-08 13:07:34 +01:00
parent 2261521002
commit d831cf944f
2 changed files with 21 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-docs.cabal
View file

@ -86,6 +86,7 @@ library
, servant >= 0.2 , servant >= 0.2
, string-conversions , string-conversions
, system-filepath , system-filepath
, text
, unordered-containers , unordered-containers
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

20
src/Servant/Docs.hs
View file

@ -115,6 +115,7 @@ import Data.HashMap.Strict (HashMap)
import Data.List import Data.List
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import Data.Text (Text, pack, unpack)
import Data.String.Conversions import Data.String.Conversions
import GHC.Generics import GHC.Generics
import GHC.TypeLits import GHC.TypeLits
@ -255,6 +256,7 @@ defResponse = Response 200 Nothing
-- 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
, _params :: [DocQueryParam] -- type collected + user supplied info , _params :: [DocQueryParam] -- type collected + user supplied info
, _rqbody :: Maybe ByteString -- user supplied , _rqbody :: Maybe ByteString -- user supplied
, _response :: Response -- user supplied , _response :: Response -- user supplied
@ -272,6 +274,7 @@ data Action = Action
defAction :: Action defAction :: Action
defAction = defAction =
Action [] Action []
[]
[] []
Nothing Nothing
defResponse defResponse
@ -366,6 +369,7 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
replicate len '-' : replicate len '-' :
"" : "" :
capturesStr (action ^. captures) ++ capturesStr (action ^. captures) ++
headersStr (action ^. headers) ++
paramsStr (action ^. params) ++ paramsStr (action ^. params) ++
rqbodyStr (action ^. rqbody) ++ rqbodyStr (action ^. rqbody) ++
responseStr (action ^. response) ++ responseStr (action ^. response) ++
@ -385,6 +389,13 @@ markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList
captureStr cap = captureStr cap =
"- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc) "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
headersStr :: [Text] -> [String]
headersStr [] = []
headersStr l = [""] ++ map headerStr l ++ [""]
where headerStr hname = "- This endpoint is sensitive to the value of the **"
++ unpack hname ++ "** HTTP header."
paramsStr :: [DocQueryParam] -> [String] paramsStr :: [DocQueryParam] -> [String]
paramsStr [] = [] paramsStr [] = []
paramsStr l = paramsStr l =
@ -481,6 +492,15 @@ instance ToSample a => HasDocs (Get a) where
action' = action & response.respBody .~ sampleByteString p action' = action & response.respBody .~ sampleByteString p
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance (KnownSymbol sym, HasDocs sublayout)
=> HasDocs (Header sym a :> sublayout) where
docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint, action')
where sublayoutP = Proxy :: Proxy sublayout
action' = over headers (|> headername) action
headername = pack $ symbolVal (Proxy :: Proxy sym)
instance ToSample a => HasDocs (Post a) where instance ToSample a => HasDocs (Post a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'