commit
438912f6c5
1 changed files with 5 additions and 11 deletions
|
@ -68,8 +68,7 @@ class BuildHeadersTo hs where
|
||||||
instance OVERLAPPING_ BuildHeadersTo '[] where
|
instance OVERLAPPING_ BuildHeadersTo '[] where
|
||||||
buildHeadersTo _ = HNil
|
buildHeadersTo _ = HNil
|
||||||
|
|
||||||
instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h
|
instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h )
|
||||||
, Contains h xs ~ 'False)
|
|
||||||
=> BuildHeadersTo ((Header h v) ': xs) where
|
=> BuildHeadersTo ((Header h v) ': xs) where
|
||||||
buildHeadersTo headers =
|
buildHeadersTo headers =
|
||||||
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
||||||
|
@ -89,7 +88,7 @@ class GetHeaders ls where
|
||||||
instance OVERLAPPING_ GetHeaders (HList '[]) where
|
instance OVERLAPPING_ GetHeaders (HList '[]) where
|
||||||
getHeaders _ = []
|
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 (HList (Header h x ': xs)) where
|
||||||
getHeaders hdrs = case hdrs of
|
getHeaders hdrs = case hdrs of
|
||||||
Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest
|
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
|
instance OVERLAPPING_ GetHeaders (Headers '[] a) where
|
||||||
getHeaders _ = []
|
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 (Headers (Header h v ': rest) a) where
|
||||||
getHeaders hs = getHeaders $ getHeadersHList hs
|
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
|
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 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)
|
addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)
|
||||||
|
|
||||||
instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v
|
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 h v a new where
|
||||||
addHeader a resp = Headers resp (HCons (Header a) HNil)
|
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
|
-- $setup
|
||||||
-- >>> import Servant.API
|
-- >>> import Servant.API
|
||||||
-- >>> import Data.Aeson
|
-- >>> import Data.Aeson
|
||||||
|
|
Loading…
Reference in a new issue