git.iko.soy/servant
on master help sign in
Add noHeader function.
ed82056Julian K. Arni
servant/src/Servant/API.hs+1−1
compare with master
unifiedsplit
@@ -75,7 +75,7 @@ import Servant.API.QueryParam (QueryFlag, QueryParam,
75import Servant.API.Raw (Raw)
75import Servant.API.Raw (Raw)
76import Servant.API.RemoteHost (RemoteHost)
76import Servant.API.RemoteHost (RemoteHost)
77import Servant.API.ReqBody (ReqBody)
77import Servant.API.ReqBody (ReqBody)
78−import Servant.API.ResponseHeaders (AddHeader (addHeader),
78+import Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader,
79 BuildHeadersTo (buildHeadersTo),
79 BuildHeadersTo (buildHeadersTo),
80 GetHeaders (getHeaders),
80 GetHeaders (getHeaders),
81 HList (..), Headers (..),
81 HList (..), Headers (..),
servant/src/Servant/API/ResponseHeaders.hs+37−4
@@ -23,7 +23,9 @@
23-- example above).
23-- example above).
24module Servant.API.ResponseHeaders
24module Servant.API.ResponseHeaders
25 ( Headers(..)
25 ( Headers(..)
26− , AddHeader(addHeader)
26+ , AddHeader
27+ , addHeader
28+ , noHeader
27 , BuildHeadersTo(buildHeadersTo)
29 , BuildHeadersTo(buildHeadersTo)
28 , GetHeaders(getHeaders)
30 , GetHeaders(getHeaders)
29 , HeaderValMap
31 , HeaderValMap
@@ -108,17 +110,48 @@ instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v
108-- We need all these fundeps to save type inference
110-- We need all these fundeps to save type inference
109class AddHeader h v orig new
111class AddHeader h v orig new
110 | h v orig -> new, new -> h, new -> v, new -> orig where
112 | h v orig -> new, new -> h, new -> v, new -> orig where
111− addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
113+ addHeader' :: Header h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
112
114
113
115
114instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v )
116instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v )
115 => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
117 => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
116− addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)
118+ addHeader' hdr (Headers resp heads) = Headers resp (HCons hdr heads)
117
119
118instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v
120instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v
119 , new ~ (Headers '[Header h v] a) )
121 , new ~ (Headers '[Header h v] a) )
120 => AddHeader h v a new where
122 => AddHeader h v a new where
121− addHeader a resp = Headers resp (HCons (Header a) HNil)
123+ addHeader' hdr resp = Headers resp (HCons hdr HNil)
124+
125+-- | @addHeader@ adds a header to a response. Note that it changes the type of
126+-- the value in the following ways:
127+--
128+-- 1. A simple value is wrapped in "Headers [<hdr>]":
129+--
130+-- >>> let example1 = addHeader 5 "hi" :: Headers '[Header "someheader" Int] String;
131+-- >>> getHeaders example1
132+-- [("someheader","5")]
133+--
134+-- 2. A value that already has a header has its new header *prepended* to the
135+-- existing list:
136+--
137+-- >>> let example1 = addHeader 5 "hi" :: Headers '[Header "someheader" Int] String;
138+-- >>> let example2 = addHeader True example1 :: Headers '[Header "1st" Bool, Header "someheader" Int] String
139+-- >>> getHeaders example2
140+-- [("1st","true"),("someheader","5")]
141+--
142+-- Note that while in your handlers type annotations are not required, since
143+-- the type can be inferred from the API type, in other cases you may find
144+-- yourself needing to add annotations.
145+addHeader :: AddHeader h v orig new => v -> orig -> new
146+addHeader = addHeader' . Header
147+
148+-- | Deliberately do not add a header to a value.
149+--
150+-- >>> let example1 = noHeader "hi" :: Headers '[Header "someheader" Int] String
151+-- >>> getHeaders example1
152+-- []
153+noHeader :: AddHeader h v orig new => orig -> new
154+noHeader = addHeader' MissingHeader
122
155
123-- $setup
156-- $setup
124-- >>> import Servant.API
157-- >>> import Servant.API
servant/test/Servant/API/ResponseHeadersSpec.hs+6
@@ -22,3 +22,9 @@ spec = describe "Servant.API.ResponseHeaders" $ do
22 it "adds headers to the front of the list" $ do
22 it "adds headers to the front of the list" $ do
23 let val = addHeader 10 $ addHeader "b" 5 :: Headers '[Header "first" Int, Header "second" String] Int
23 let val = addHeader 10 $ addHeader "b" 5 :: Headers '[Header "first" Int, Header "second" String] Int
24 getHeaders val `shouldBe` [("first", "10"), ("second", "b")]
24 getHeaders val `shouldBe` [("first", "10"), ("second", "b")]
25+
26+ describe "noHeader" $ do
27+
28+ it "does not add a header" $ do
29+ let val = noHeader 5 :: Headers '[Header "test" Int] Int
30+ getHeaders val `shouldBe` []