From e1463cd02d6ccf9457fb5f4e408b22cefeefea81 Mon Sep 17 00:00:00 2001 From: Justin Sermeno Date: Mon, 21 Mar 2016 16:46:04 -0500 Subject: [PATCH] remove response header contains check --- servant/src/Servant/API/ResponseHeaders.hs | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/servant/src/Servant/API/ResponseHeaders.hs b/servant/src/Servant/API/ResponseHeaders.hs index cde14938..cdb7341e 100644 --- a/servant/src/Servant/API/ResponseHeaders.hs +++ b/servant/src/Servant/API/ResponseHeaders.hs @@ -68,8 +68,7 @@ class BuildHeadersTo hs where instance OVERLAPPING_ BuildHeadersTo '[] where buildHeadersTo _ = HNil -instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h - , Contains h xs ~ 'False) +instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h ) => BuildHeadersTo ((Header h v) ': xs) where buildHeadersTo headers = let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h) @@ -89,7 +88,7 @@ class GetHeaders ls where instance OVERLAPPING_ GetHeaders (HList '[]) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs)) +instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs) ) => GetHeaders (HList (Header h x ': xs)) where getHeaders hdrs = case hdrs of Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest @@ -100,7 +99,7 @@ instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs)) instance OVERLAPPING_ GetHeaders (Headers '[] a) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v) +instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v ) => GetHeaders (Headers (Header h v ': rest) a) where getHeaders hs = getHeaders $ getHeadersHList hs @@ -112,20 +111,15 @@ class AddHeader h v orig new addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times -instance OVERLAPPING_ ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False) +instance OVERLAPPING_ ( KnownSymbol h, ToByteString 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) instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v - , new ~ (Headers '[Header h v] a)) + , new ~ (Headers '[Header h v] a) ) => AddHeader h v a new where addHeader a resp = Headers resp (HCons (Header a) HNil) -type family Contains x xs where - Contains x ((Header x a) ': xs) = 'True - Contains x ((Header y a) ': xs) = Contains x xs - Contains x '[] = 'False - -- $setup -- >>> import Servant.API -- >>> import Data.Aeson