git.iko.soy/servant
on master help sign in
Merge pull request #1064 from DanBurton/lookup-response-header
db80f41Oleg Grenrus
servant/src/Servant/API.hs+1−1
compare with master
unifiedsplit
@@ -112,7 +112,7 @@ import Servant.API.ResponseHeaders
112 (AddHeader, BuildHeadersTo (buildHeadersTo),
112 (AddHeader, BuildHeadersTo (buildHeadersTo),
113 GetHeaders (getHeaders), HList (..), Headers (..),
113 GetHeaders (getHeaders), HList (..), Headers (..),
114 ResponseHeader (..), addHeader, getHeadersHList, getResponse,
114 ResponseHeader (..), addHeader, getHeadersHList, getResponse,
115− noHeader)
115+ noHeader, HasResponseHeader, lookupResponseHeader)
116import Servant.API.Stream
116import Servant.API.Stream
117 (FramingRender (..), FramingUnrender (..),
117 (FramingRender (..), FramingUnrender (..),
118 FromSourceIO (..), NetstringFraming, NewlineFraming,
118 FromSourceIO (..), NetstringFraming, NewlineFraming,
servant/src/Servant/API/ResponseHeaders.hs+29
@@ -26,6 +26,8 @@ module Servant.API.ResponseHeaders
26 , AddHeader
26 , AddHeader
27 , addHeader
27 , addHeader
28 , noHeader
28 , noHeader
29+ , HasResponseHeader
30+ , lookupResponseHeader
29 , BuildHeadersTo(buildHeadersTo)
31 , BuildHeadersTo(buildHeadersTo)
30 , GetHeaders(getHeaders)
32 , GetHeaders(getHeaders)
31 , GetHeaders'
33 , GetHeaders'
@@ -183,6 +185,33 @@ addHeader = addOptionalHeader . Header
183noHeader :: AddHeader h v orig new => orig -> new
185noHeader :: AddHeader h v orig new => orig -> new
184noHeader = addOptionalHeader MissingHeader
186noHeader = addOptionalHeader MissingHeader
185
187
188+class HasResponseHeader h a headers where
189+ hlistLookupHeader :: HList headers -> ResponseHeader h a
190+
191+instance {-# OVERLAPPING #-} HasResponseHeader h a (Header h a ': rest) where
192+ hlistLookupHeader (HCons ha _) = ha
193+
194+instance {-# OVERLAPPABLE #-} (HasResponseHeader h a rest) => HasResponseHeader h a (first ': rest) where
195+ hlistLookupHeader (HCons _ hs) = hlistLookupHeader hs
196+
197+-- | Look up a specific ResponseHeader,
198+-- without having to know what position it is in the HList.
199+--
200+-- >>> let example1 = addHeader 5 "hi" :: Headers '[Header "someheader" Int] String
201+-- >>> let example2 = addHeader True example1 :: Headers '[Header "1st" Bool, Header "someheader" Int] String
202+-- >>> lookupResponseHeader example2 :: ResponseHeader "someheader" Int
203+-- Header 5
204+-- >>> lookupResponseHeader example2 :: ResponseHeader "1st" Bool
205+-- Header True
206+--
207+-- Usage of this function relies on an explicit type annotation of the header to be looked up.
208+-- This can be done with type annotations on the result, or with an explicit type application.
209+-- e.g.
210+-- @lookupResponseHeader \@"someheader" example2@
211+lookupResponseHeader :: (HasResponseHeader h a headers)
212+ => Headers headers r -> ResponseHeader h a
213+lookupResponseHeader = hlistLookupHeader . getHeadersHList
214+
186-- $setup
215-- $setup
187-- >>> import Servant.API
216-- >>> import Servant.API
188-- >>> import Data.Aeson
217-- >>> import Data.Aeson