git.iko.soy/typeable/servant
on master help sign in
Merge pull request #971 from phadej/get-headers-no-overlap

Implement GetHeaders instances without overlapping

commite04735c2800a1258840fdad630dba1c78db0be9a authorOleg Grenrus <oleg.grenrus@iki.fi> dateFri 8 Jun 2018, 16:18 (8 years ago) parente1b848fbe42f3d
1 file changed+35−17
servant/src/Servant/API/ResponseHeaders.hs+35−17
servant/src/Servant/API/ResponseHeaders.hs+35−17
@@ -100,23 +100,41 @@ instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
100100class GetHeaders ls where
101101 getHeaders :: ls -> [HTTP.Header]
102102
103−instance OVERLAPPING_ GetHeaders (HList '[]) where
104− getHeaders _ = []
105−
106−instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) )
107− => GetHeaders (HList (Header h x ': xs)) where
108− getHeaders hdrs = case hdrs of
109− Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest
110− UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest
111− MissingHeader `HCons` rest -> getHeaders rest
112− where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
113−
114−instance OVERLAPPING_ GetHeaders (Headers '[] a) where
115− getHeaders _ = []
116−
117−instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v )
118− => GetHeaders (Headers (Header h v ': rest) a) where
119− getHeaders hs = getHeaders $ getHeadersHList hs
103+-- | Auxiliary class for @'GetHeaders' ('HList' hs)@ instance
104+class GetHeadersFromHList hs where
105+ getHeadersFromHList :: HList hs -> [HTTP.Header]
106+
107+instance GetHeadersFromHList hs => GetHeaders (HList hs) where
108+ getHeaders = getHeadersFromHList
109+
110+instance GetHeadersFromHList '[] where
111+ getHeadersFromHList _ = []
112+
113+instance (KnownSymbol h, ToHttpApiData x, GetHeadersFromHList xs)
114+ => GetHeadersFromHList (Header h x ': xs)
115+ where
116+ getHeadersFromHList hdrs = case hdrs of
117+ Header val `HCons` rest -> (headerName , toHeader val) : getHeadersFromHList rest
118+ UndecodableHeader h `HCons` rest -> (headerName, h) : getHeadersFromHList rest
119+ MissingHeader `HCons` rest -> getHeadersFromHList rest
120+ where
121+ headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
122+
123+-- | Auxiliary class for @'GetHeaders' ('Headers' hs a)@ instance
124+class GetHeaders' hs where
125+ getHeaders' :: Headers hs a -> [HTTP.Header]
126+
127+instance GetHeaders' hs => GetHeaders (Headers hs a) where
128+ getHeaders = getHeaders'
129+
130+-- | This instance is an optimisation
131+instance GetHeaders' '[] where
132+ getHeaders' _ = []
133+
134+instance (KnownSymbol h, GetHeadersFromHList rest, ToHttpApiData v)
135+ => GetHeaders' (Header h v ': rest)
136+ where
137+ getHeaders' hs = getHeadersFromHList $ getHeadersHList hs
120138
121139-- * Adding
122140