@@ -26,6 +26,8 @@ module Servant.API.ResponseHeaders
2626 , AddHeader
2727 , addHeader
2828 , noHeader
29+ , HasResponseHeader
30+ , lookupResponseHeader
2931 , BuildHeadersTo(buildHeadersTo)
3032 , GetHeaders(getHeaders)
3133 , GetHeaders'
@@ -183,6 +185,33 @@ addHeader = addOptionalHeader . Header
183185noHeader :: AddHeader h v orig new => orig -> new
184186noHeader = addOptionalHeader MissingHeader
185187
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+
186215-- $setup
187216-- >>> import Servant.API
188217-- >>> import Data.Aeson