caa1566 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Add status and status text to XhrResponse

commitcaa1566ee05141fb46113c1544dfbd4fa9af4d4a authorAli Abrar <aliabrar@gmail.com> dateSat 31 Oct 2015, 02:21 (11 years ago) parentcf4ba36

3 files changed+11−1

compare with develop

unifiedsplit

src-ghc/Reflex/Dom/Xhr/Foreign.hs+3 src-ghcjs/Reflex/Dom/Xhr/Foreign.hs+3 src/Reflex/Dom/Xhr.hs+5−1

src-ghc/Reflex/Dom/Xhr/Foreign.hs+3

@@ -29,6 +29,9 @@ toJSObject ctx args = do

2929responseTextToText :: Maybe String -> Maybe Text

3030responseTextToText = fmap T.pack

3131

32+statusTextToText :: String -> Text

33+statusTextToText = T.pack

34+

3235stringToJSValue :: JSContextRef -> String -> IO JSValueRef

3336stringToJSValue ctx s = jsvaluemakestring ctx =<< jsstringcreatewithutf8cstring s

3437

src-ghcjs/Reflex/Dom/Xhr/Foreign.hs+3

@@ -326,6 +326,9 @@ xmlHttpRequestGetResponseText self

326326responseTextToText :: (Maybe JSString) -> Maybe Text

327327responseTextToText r = fmap (T.pack . fromJSString) r

328328

329+statusTextToText :: Text -> Text

330+statusTextToText = id

331+

329332foreign import javascript unsafe "$1[\"responseXML\"]"

330333 ghcjs_dom_xml_http_request_get_response_xml ::

331334 JSRef XMLHttpRequest -> IO (JSRef Document)

src/Reflex/Dom/Xhr.hs+5−1

@@ -53,6 +53,8 @@ data XhrRequestConfig

5353

5454data XhrResponse

5555 = XhrResponse { _xhrResponse_body :: Maybe Text

56+ , _xhrResponse_status :: Word

57+ , _xhrResponse_statusText :: Text

5658 }

5759 deriving (Show, Read, Eq, Ord, Typeable)

5860

@@ -86,10 +88,12 @@ newXMLHttpRequest req cb = do

8688 maybe (return ()) (xmlHttpRequestSetResponseType xhr . toResponseType) (_xhrRequestConfig_responseType c)

8789 _ <- xmlHttpRequestOnreadystatechange xhr $ do

8890 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr

91+ status <- liftIO $ xmlHttpRequestGetStatus xhr

92+ statusText <- liftIO $ xmlHttpRequestGetStatusText xhr

8993 if readyState == 4

9094 then do

9195 r <- liftIO $ xmlHttpRequestGetResponseText xhr

92− _ <- liftIO $ postGui $ cb $ XhrResponse $ responseTextToText r

96+ _ <- liftIO $ postGui $ cb $ XhrResponse (responseTextToText r) status (statusTextToText statusText)

9397 return ()

9498 else return ()

9599 _ <- xmlHttpRequestSend xhr (_xhrRequestConfig_sendData c)