diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 0c3e30ac..8167d667 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -707,6 +707,15 @@ instance OVERLAPPING_ status = fromInteger $ natVal (Proxy :: Proxy status) 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) => HasDocs (QueryParam sym a :> sublayout) where diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index d37f78c9..703ea795 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -63,6 +63,7 @@ spec = describe "Servant.Docs" $ do , ("zwei, kaks, kaks",(TT2,UT2,UT2)) ] + where tests md = do it "mentions supported content-types" $ do @@ -76,11 +77,15 @@ spec = describe "Servant.Docs" $ do md `shouldContain` "POST" 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" $ md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}" it "contains request body samples" $ md `shouldContain` "17" + -- * APIs data Datatype1 = Datatype1 { dt1field1 :: String @@ -103,6 +108,7 @@ instance MimeRender PlainText Int where type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int) :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1 + :<|> Header "X-Test" Int :> Put '[JSON] Int data TT = TT1 | TT2 deriving (Show, Eq) data UT = UT1 | UT2 deriving (Show, Eq)