git.iko.soy/reflex-dom
on develop help sign in
Pull xhr Foreign.hs with deduplicated functions for hlint
861da1eGreg Hale
src-ghc/Reflex/Dom/Xhr/Foreign.hs+16−20
compare with develop
unifiedsplit
@@ -205,16 +205,8 @@ xmlHttpRequestGetStatus xhr = do
205 return $ truncate d
205 return $ truncate d
206
206
207xmlHttpRequestGetStatusText :: XMLHttpRequest -> IO Text
207xmlHttpRequestGetStatusText :: XMLHttpRequest -> IO Text
208−xmlHttpRequestGetStatusText xhr = do
208+xmlHttpRequestGetStatusText xhr =
209− let c = xhrContext xhr
209+ xmlAuxHttpRequestGetWithJS xhr "this.statusText"
210− script <- jsstringcreatewithutf8cstring "this.statusText"
211− t <- jsevaluatescript c script (xhrValue xhr) nullPtr 1 nullPtr
212− j <- jsvaluetostringcopy c t nullPtr
213− l <- jsstringgetmaximumutf8cstringsize j
214− s <- allocaBytes (fromIntegral l) $ \ps -> do
215− _ <- jsstringgetutf8cstring'_ j ps (fromIntegral l)
216− peekCString ps
217− return $ T.pack s
218
210
219xmlHttpRequestSetWithCredentials :: XMLHttpRequest -> Bool -> IO ()
211xmlHttpRequestSetWithCredentials :: XMLHttpRequest -> Bool -> IO ()
220xmlHttpRequestSetWithCredentials xhr b = do
212xmlHttpRequestSetWithCredentials xhr b = do
@@ -226,16 +218,8 @@ xmlHttpRequestSetWithCredentials xhr b = do
226 return ()
218 return ()
227
219
228xmlHttpRequestGetAllResponseHeaders :: XMLHttpRequest -> IO Text
220xmlHttpRequestGetAllResponseHeaders :: XMLHttpRequest -> IO Text
229−xmlHttpRequestGetAllResponseHeaders xhr = do
221+xmlHttpRequestGetAllResponseHeaders xhr =
230− let c = xhrContext xhr
231− script <- jsstringcreatewithutf8cstring "this.getAllResponseHeaders()"
222+ xmlAuxHttpRequestGetWithJS xhr "this.getAllResponseHeaders()"
232− t <- jsevaluatescript c script (xhrValue xhr) nullPtr 1 nullPtr
233− j <- jsvaluetostringcopy c t nullPtr
234− l <- jsstringgetmaximumutf8cstringsize j
235− s <- allocaBytes (fromIntegral l) $ \ps -> do
236− _ <- jsstringgetutf8cstring'_ j ps (fromIntegral l)
237− peekCString ps
238− return $ T.pack s
239
223
240xmlHttpRequestGetResponseHeader :: XMLHttpRequest -> Text -> IO Text
224xmlHttpRequestGetResponseHeader :: XMLHttpRequest -> Text -> IO Text
241xmlHttpRequestGetResponseHeader xhr hdr = do
225xmlHttpRequestGetResponseHeader xhr hdr = do
@@ -244,9 +228,21 @@ xmlHttpRequestGetResponseHeader xhr hdr = do
244 o <- toJSObject c [xhrValue xhr, t']
228 o <- toJSObject c [xhrValue xhr, t']
245 script <- jsstringcreatewithutf8cstring "this[0].getResponseHeader(this[1])"
229 script <- jsstringcreatewithutf8cstring "this[0].getResponseHeader(this[1])"
246 t <- jsevaluatescript c script o nullPtr 1 nullPtr
230 t <- jsevaluatescript c script o nullPtr 1 nullPtr
231+ xmlAuxJsGetString c t
232+
233+xmlAuxHttpRequestGetWithJS :: XMLHttpRequest -> String -> IO Text
234+xmlAuxHttpRequestGetWithJS xhr jsScript = do
235+ let c = xhrContext xhr
236+ script <- jsstringcreatewithutf8cstring jsScript
237+ t <- jsevaluatescript c script (xhrValue xhr) nullPtr 1 nullPtr
238+ xmlAuxJsGetString c t
239+
240+xmlAuxJsGetString :: JSContextRef -> JSValueRef -> IO Text
241+xmlAuxJsGetString c t = do
247 j <- jsvaluetostringcopy c t nullPtr
242 j <- jsvaluetostringcopy c t nullPtr
248 l <- jsstringgetmaximumutf8cstringsize j
243 l <- jsstringgetmaximumutf8cstringsize j
249 s <- allocaBytes (fromIntegral l) $ \ps -> do
244 s <- allocaBytes (fromIntegral l) $ \ps -> do
250 _ <- jsstringgetutf8cstring'_ j ps (fromIntegral l)
245 _ <- jsstringgetutf8cstring'_ j ps (fromIntegral l)
251 peekCString ps
246 peekCString ps
252 return $ T.pack s
247 return $ T.pack s
248+