Add noHeader function.
Which allows not adding a header where a signature declares one, making response headers optional.
This commit is contained in:
parent
3ddf225cec
commit
ed82056052
3 changed files with 44 additions and 5 deletions
|
@ -75,7 +75,7 @@ import Servant.API.QueryParam (QueryFlag, QueryParam,
|
||||||
import Servant.API.Raw (Raw)
|
import Servant.API.Raw (Raw)
|
||||||
import Servant.API.RemoteHost (RemoteHost)
|
import Servant.API.RemoteHost (RemoteHost)
|
||||||
import Servant.API.ReqBody (ReqBody)
|
import Servant.API.ReqBody (ReqBody)
|
||||||
import Servant.API.ResponseHeaders (AddHeader (addHeader),
|
import Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader,
|
||||||
BuildHeadersTo (buildHeadersTo),
|
BuildHeadersTo (buildHeadersTo),
|
||||||
GetHeaders (getHeaders),
|
GetHeaders (getHeaders),
|
||||||
HList (..), Headers (..),
|
HList (..), Headers (..),
|
||||||
|
|
|
@ -23,7 +23,9 @@
|
||||||
-- example above).
|
-- example above).
|
||||||
module Servant.API.ResponseHeaders
|
module Servant.API.ResponseHeaders
|
||||||
( Headers(..)
|
( Headers(..)
|
||||||
, AddHeader(addHeader)
|
, AddHeader
|
||||||
|
, addHeader
|
||||||
|
, noHeader
|
||||||
, BuildHeadersTo(buildHeadersTo)
|
, BuildHeadersTo(buildHeadersTo)
|
||||||
, GetHeaders(getHeaders)
|
, GetHeaders(getHeaders)
|
||||||
, HeaderValMap
|
, HeaderValMap
|
||||||
|
@ -108,17 +110,48 @@ instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v
|
||||||
-- We need all these fundeps to save type inference
|
-- We need all these fundeps to save type inference
|
||||||
class AddHeader h v orig new
|
class AddHeader h v orig new
|
||||||
| h v orig -> new, new -> h, new -> v, new -> orig where
|
| 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
|
addHeader' :: Header h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
|
||||||
|
|
||||||
|
|
||||||
instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v )
|
instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v )
|
||||||
=> AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
|
=> 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)
|
addHeader' hdr (Headers resp heads) = Headers resp (HCons hdr heads)
|
||||||
|
|
||||||
instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v
|
instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v
|
||||||
, new ~ (Headers '[Header h v] a) )
|
, new ~ (Headers '[Header h v] a) )
|
||||||
=> AddHeader h v a new where
|
=> AddHeader h v a new where
|
||||||
addHeader a resp = Headers resp (HCons (Header a) HNil)
|
addHeader' 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 = addHeader' . 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 = addHeader' MissingHeader
|
||||||
|
|
||||||
-- $setup
|
-- $setup
|
||||||
-- >>> import Servant.API
|
-- >>> import Servant.API
|
||||||
|
|
|
@ -22,3 +22,9 @@ spec = describe "Servant.API.ResponseHeaders" $ do
|
||||||
it "adds headers to the front of the list" $ 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
|
let val = addHeader 10 $ addHeader "b" 5 :: Headers '[Header "first" Int, Header "second" String] Int
|
||||||
getHeaders val `shouldBe` [("first", "10"), ("second", "b")]
|
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` []
|
||||||
|
|
Loading…
Reference in a new issue