git.iko.soy/reflex-dom
on develop help sign in
Merge pull request #348 from lpsmith/ls-case-insensitive-headers
4ef3c1fElliot Cameron
reflex-dom-core/reflex-dom-core.cabal+1
compare with develop
unifiedsplit
@@ -53,6 +53,7 @@ library
53 bimap >= 0.3 && < 0.4,
53 bimap >= 0.3 && < 0.4,
54 blaze-builder,
54 blaze-builder,
55 bytestring == 0.10.*,
55 bytestring == 0.10.*,
56+ case-insensitive,
56 containers >= 0.6 && < 0.7,
57 containers >= 0.6 && < 0.7,
57 constraints >= 0.9 && < 0.12,
58 constraints >= 0.9 && < 0.12,
58 contravariant >= 1.4 && < 1.6,
59 contravariant >= 1.4 && < 1.6,
reflex-dom-core/src/Reflex/Dom/Xhr.hs+7−5
@@ -159,6 +159,8 @@ import Data.Aeson.Text
159import Data.Aeson.Encode
159import Data.Aeson.Encode
160#endif
160#endif
161import qualified Data.ByteString.Lazy as BL
161import qualified Data.ByteString.Lazy as BL
162+import Data.CaseInsensitive (CI)
163+import qualified Data.CaseInsensitive as CI
162import Data.Default
164import Data.Default
163import qualified Data.List as L
165import qualified Data.List as L
164import Data.Map (Map)
166import Data.Map (Map)
@@ -198,12 +200,12 @@ data XhrResponse
198 , _xhrResponse_statusText :: Text
200 , _xhrResponse_statusText :: Text
199 , _xhrResponse_response :: Maybe XhrResponseBody
201 , _xhrResponse_response :: Maybe XhrResponseBody
200 , _xhrResponse_responseText :: Maybe Text
202 , _xhrResponse_responseText :: Maybe Text
201− , _xhrResponse_headers :: Map Text Text
203+ , _xhrResponse_headers :: Map (CI Text) Text
202 }
204 }
203 deriving (Typeable)
205 deriving (Typeable)
204
206
205data XhrResponseHeaders =
207data XhrResponseHeaders =
206− OnlyHeaders (Set.Set Text) -- ^ Parse a subset of headers from the XHR Response
208+ OnlyHeaders (Set.Set (CI Text)) -- ^ Parse a subset of headers from the XHR Response
207 | AllHeaders -- ^ Parse all headers from the XHR Response
209 | AllHeaders -- ^ Parse all headers from the XHR Response
208 deriving (Show, Read, Eq, Ord, Typeable)
210 deriving (Show, Read, Eq, Ord, Typeable)
209
211
@@ -275,7 +277,7 @@ newXMLHttpRequestWithError req cb = do
275 AllHeaders -> parseAllHeadersString <$>
277 AllHeaders -> parseAllHeadersString <$>
276 xmlHttpRequestGetAllResponseHeaders xhr
278 xmlHttpRequestGetAllResponseHeaders xhr
277 OnlyHeaders xs -> traverse (xmlHttpRequestGetResponseHeader xhr)
279 OnlyHeaders xs -> traverse (xmlHttpRequestGetResponseHeader xhr)
278− (Map.fromSet id xs)
280+ (Map.fromSet CI.original xs)
279 _ <- liftJSM $ cb $ Right
281 _ <- liftJSM $ cb $ Right
280 XhrResponse { _xhrResponse_status = status
282 XhrResponse { _xhrResponse_status = status
281 , _xhrResponse_statusText = statusText
283 , _xhrResponse_statusText = statusText
@@ -288,10 +290,10 @@ newXMLHttpRequestWithError req cb = do
288 return ()
290 return ()
289 return xhr
291 return xhr
290
292
291−parseAllHeadersString :: Text -> Map Text Text
293+parseAllHeadersString :: Text -> Map (CI Text) Text
292parseAllHeadersString s = Map.fromList $ fmap (stripBoth . T.span (/=':')) $
294parseAllHeadersString s = Map.fromList $ fmap (stripBoth . T.span (/=':')) $
293 L.dropWhileEnd T.null $ T.splitOn (T.pack "\r\n") s
295 L.dropWhileEnd T.null $ T.splitOn (T.pack "\r\n") s
294− where stripBoth (txt1, txt2) = (T.strip txt1, T.strip $ T.drop 1 txt2)
296+ where stripBoth (txt1, txt2) = (CI.mk $ T.strip txt1, T.strip $ T.drop 1 txt2)
295
297
296newXMLHttpRequest :: (HasJSContext m, MonadJSM m, IsXhrPayload a) => XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
298newXMLHttpRequest :: (HasJSContext m, MonadJSM m, IsXhrPayload a) => XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
297newXMLHttpRequest req cb = newXMLHttpRequestWithError req $ mapM_ cb
299newXMLHttpRequest req cb = newXMLHttpRequestWithError req $ mapM_ cb