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.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 (..),
|
||||
|
|
|
@ -23,7 +23,9 @@
|
|||
-- example above).
|
||||
module Servant.API.ResponseHeaders
|
||||
( Headers(..)
|
||||
, AddHeader(addHeader)
|
||||
, AddHeader
|
||||
, addHeader
|
||||
, noHeader
|
||||
, BuildHeadersTo(buildHeadersTo)
|
||||
, GetHeaders(getHeaders)
|
||||
, HeaderValMap
|
||||
|
@ -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
|
||||
addHeader' :: 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)
|
||||
addHeader' 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)
|
||||
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
|
||||
-- >>> import Servant.API
|
||||
|
|
|
@ -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` []
|
||||
|
|
Loading…
Reference in a new issue