eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Review fixes

Browse source
This commit is contained in:
Julian K. Arni 2016-10-24 17:15:29 +02:00
parent ed82056052
commit 9ad2efe862
2 changed files with 11 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
servant/CHANGELOG.md
View file

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

12
servant/src/Servant/API/ResponseHeaders.hs
View file

@ -45,7 +45,7 @@ import Prelude ()
import Prelude.Compat import Prelude.Compat
-- | Response Header objects. You should never need to construct one directly. -- | Response Header objects. You should never need to construct one directly.
-- Instead, use 'addHeader'. -- Instead, use 'addOptionalHeader.
data Headers ls a = Headers { getResponse :: a data Headers ls a = Headers { getResponse :: a
-- ^ The underlying value of a 'Headers' -- ^ The underlying value of a 'Headers'
, getHeadersHList :: HList ls , getHeadersHList :: HList ls
@ -110,17 +110,17 @@ 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' :: Header h 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 ) 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' hdr (Headers resp heads) = Headers resp (HCons hdr heads) addOptionalHeader 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' hdr resp = Headers resp (HCons hdr HNil) addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)
-- | @addHeader@ adds a header to a response. Note that it changes the type of -- | @addHeader@ adds a header to a response. Note that it changes the type of
-- the value in the following ways: -- the value in the following ways:
@ -143,7 +143,7 @@ instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v
-- the type can be inferred from the API type, in other cases you may find -- the type can be inferred from the API type, in other cases you may find
-- yourself needing to add annotations. -- yourself needing to add annotations.
addHeader :: AddHeader h v orig new => v -> orig -> new addHeader :: AddHeader h v orig new => v -> orig -> new
addHeader = addHeader' . Header addHeader = addOptionalHeader . Header
-- | Deliberately do not add a header to a value. -- | Deliberately do not add a header to a value.
-- --
@ -151,7 +151,7 @@ addHeader = addHeader' . Header
-- >>> getHeaders example1 -- >>> getHeaders example1
-- [] -- []
noHeader :: AddHeader h v orig new => orig -> new noHeader :: AddHeader h v orig new => orig -> new
noHeader = addHeader' MissingHeader noHeader = addOptionalHeader MissingHeader
-- $setup -- $setup
-- >>> import Servant.API -- >>> import Servant.API