Merge pull request #623 from haskell-servant/jkarni/noHeader

Add noHeader function.
This commit is contained in:
Julian Arni 2016-10-24 16:37:24 +01:00 committed by GitHub
commit c0906d1873
4 changed files with 50 additions and 6 deletions

View file

@ -1,3 +1,8 @@
upcoming
--------
* Added 'noHeader' function for *not* adding response headers.
0.9
---

View file

@ -75,7 +75,7 @@ import Servant.API.QueryParam (QueryFlag, QueryParam,
import Servant.API.Raw (Raw)
import Servant.API.RemoteHost (RemoteHost)
import Servant.API.ReqBody (ReqBody)
import Servant.API.ResponseHeaders (AddHeader (addHeader),
import Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader,
BuildHeadersTo (buildHeadersTo),
GetHeaders (getHeaders),
HList (..), Headers (..),

View file

@ -23,7 +23,9 @@
-- example above).
module Servant.API.ResponseHeaders
( Headers(..)
, AddHeader(addHeader)
, AddHeader
, addHeader
, noHeader
, BuildHeadersTo(buildHeadersTo)
, GetHeaders(getHeaders)
, HeaderValMap
@ -43,7 +45,7 @@ import Prelude ()
import Prelude.Compat
-- | Response Header objects. You should never need to construct one directly.
-- Instead, use 'addHeader'.
-- Instead, use 'addOptionalHeader.
data Headers ls a = Headers { getResponse :: a
-- ^ The underlying value of a 'Headers'
, getHeadersHList :: HList ls
@ -108,17 +110,48 @@ instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v
-- We need all these fundeps to save type inference
class AddHeader h v orig new
| h v orig -> new, new -> h, new -> v, new -> orig where
addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
addOptionalHeader :: Header h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v )
=> AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)
addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)
instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v
, new ~ (Headers '[Header h v] a) )
=> AddHeader h v a new where
addHeader a resp = Headers resp (HCons (Header a) HNil)
addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)
-- | @addHeader@ adds a header to a response. Note that it changes the type of
-- the value in the following ways:
--
-- 1. A simple value is wrapped in "Headers [<hdr>]":
--
-- >>> let example1 = addHeader 5 "hi" :: Headers '[Header "someheader" Int] String;
-- >>> getHeaders example1
-- [("someheader","5")]
--
-- 2. A value that already has a header has its new header *prepended* to the
-- existing list:
--
-- >>> let example1 = addHeader 5 "hi" :: Headers '[Header "someheader" Int] String;
-- >>> let example2 = addHeader True example1 :: Headers '[Header "1st" Bool, Header "someheader" Int] String
-- >>> getHeaders example2
-- [("1st","true"),("someheader","5")]
--
-- Note that while in your handlers type annotations are not required, since
-- the type can be inferred from the API type, in other cases you may find
-- yourself needing to add annotations.
addHeader :: AddHeader h v orig new => v -> orig -> new
addHeader = addOptionalHeader . Header
-- | Deliberately do not add a header to a value.
--
-- >>> let example1 = noHeader "hi" :: Headers '[Header "someheader" Int] String
-- >>> getHeaders example1
-- []
noHeader :: AddHeader h v orig new => orig -> new
noHeader = addOptionalHeader MissingHeader
-- $setup
-- >>> import Servant.API

View file

@ -22,3 +22,9 @@ spec = describe "Servant.API.ResponseHeaders" $ do
it "adds headers to the front of the list" $ do
let val = addHeader 10 $ addHeader "b" 5 :: Headers '[Header "first" Int, Header "second" String] Int
getHeaders val `shouldBe` [("first", "10"), ("second", "b")]
describe "noHeader" $ do
it "does not add a header" $ do
let val = noHeader 5 :: Headers '[Header "test" Int] Int
getHeaders val `shouldBe` []