git.iko.soy/servant
on master help sign in
Merge pull request #971 from phadej/get-headers-no-overlap
e04735cOleg Grenrus
servant/src/Servant/API/ResponseHeaders.hs+35−17
compare with master
unifiedsplit
@@ -100,23 +100,41 @@ instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
100class GetHeaders ls where
100class GetHeaders ls where
101 getHeaders :: ls -> [HTTP.Header]
101 getHeaders :: ls -> [HTTP.Header]
102
102
103−instance OVERLAPPING_ GetHeaders (HList '[]) where
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
104− getHeaders _ = []
108+ getHeaders = getHeadersFromHList
105−
109+
110+instance GetHeadersFromHList '[] where
111+ getHeadersFromHList _ = []
112+
106−instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) )
113+instance (KnownSymbol h, ToHttpApiData x, GetHeadersFromHList xs)
107− => GetHeaders (HList (Header h x ': xs)) where
114+ => GetHeadersFromHList (Header h x ': xs)
115+ where
108− getHeaders hdrs = case hdrs of
116+ getHeadersFromHList hdrs = case hdrs of
109− Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest
117+ Header val `HCons` rest -> (headerName , toHeader val) : getHeadersFromHList rest
110− UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest
118+ UndecodableHeader h `HCons` rest -> (headerName, h) : getHeadersFromHList rest
111− MissingHeader `HCons` rest -> getHeaders rest
119+ MissingHeader `HCons` rest -> getHeadersFromHList rest
120+ where
112− where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
121+ headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
113−
122+
114−instance OVERLAPPING_ GetHeaders (Headers '[] a) where
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
115− getHeaders _ = []
128+ getHeaders = getHeaders'
116−
129+
130+-- | This instance is an optimisation
131+instance GetHeaders' '[] where
132+ getHeaders' _ = []
133+
117−instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v )
134+instance (KnownSymbol h, GetHeadersFromHList rest, ToHttpApiData v)
118− => GetHeaders (Headers (Header h v ': rest) a) where
135+ => GetHeaders' (Header h v ': rest)
136+ where
119− getHeaders hs = getHeaders $ getHeadersHList hs
137+ getHeaders' hs = getHeadersFromHList $ getHeadersHList hs
120
138
121-- * Adding
139-- * Adding
122
140