Merge pull request #324 from haskell-servant/jkarni/docsHeaderFix

Re-add missing Header instance for docs.

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
 

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)