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

Re-add missing Header instance for docs.

Browse source
This commit is contained in:
Julian K. Arni 2016-01-11 13:37:20 +01:00
parent 357cc839b6
commit 37afddf3a2
2 changed files with 15 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -707,6 +707,15 @@ instance OVERLAPPING_
status = fromInteger $ natVal (Proxy :: Proxy status) status = fromInteger $ natVal (Proxy :: Proxy status)
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 = T.pack $ symbolVal (Proxy :: Proxy sym)
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

6
servant-docs/test/Servant/DocsSpec.hs
View file

@ -63,6 +63,7 @@ spec = describe "Servant.Docs" $ do
, ("zwei, kaks, kaks",(TT2,UT2,UT2)) , ("zwei, kaks, kaks",(TT2,UT2,UT2))
] ]
where where
tests md = do tests md = do
it "mentions supported content-types" $ do it "mentions supported content-types" $ do
@ -76,11 +77,15 @@ spec = describe "Servant.Docs" $ do
md `shouldContain` "POST" md `shouldContain` "POST"
md `shouldContain` "GET" md `shouldContain` "GET"
it "mentions headers" $ do
md `shouldContain` "- This endpoint is sensitive to the value of the **X-Test** HTTP header."
it "contains response samples" $ it "contains response samples" $
md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}" md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}"
it "contains request body samples" $ it "contains request body samples" $
md `shouldContain` "17" md `shouldContain` "17"
-- * APIs -- * APIs
data Datatype1 = Datatype1 { dt1field1 :: String data Datatype1 = Datatype1 { dt1field1 :: String
@ -103,6 +108,7 @@ instance MimeRender PlainText Int where
type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int) type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
:<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1 :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
:<|> Header "X-Test" Int :> Put '[JSON] Int
data TT = TT1 | TT2 deriving (Show, Eq) data TT = TT1 | TT2 deriving (Show, Eq)
data UT = UT1 | UT2 deriving (Show, Eq) data UT = UT1 | UT2 deriving (Show, Eq)