on develop help sign in
Pull xhr Foreign.hs with deduplicated functions for hlint
commit861da1e7789aa7cdbcaa162902c5967b3228f6a7 authorGreg Hale <imalsogreg@gmail.com> dateSat 27 Aug 2016, 21:05 (10 years ago) parentde78254
1 file changed+16−20
src-ghc/Reflex/Dom/Xhr/Foreign.hs+16−20
src-ghc/Reflex/Dom/Xhr/Foreign.hs+16−20
@@ -205,16 +205,8 @@ xmlHttpRequestGetStatus xhr = do
205205 return $ truncate d
206206
207207xmlHttpRequestGetStatusText :: XMLHttpRequest -> IO Text
208−xmlHttpRequestGetStatusText xhr = do
209− let c = xhrContext xhr
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
208+xmlHttpRequestGetStatusText xhr =
209+ xmlAuxHttpRequestGetWithJS xhr "this.statusText"
218210
219211xmlHttpRequestSetWithCredentials :: XMLHttpRequest -> Bool -> IO ()
220212xmlHttpRequestSetWithCredentials xhr b = do
@@ -226,16 +218,8 @@ xmlHttpRequestSetWithCredentials xhr b = do
226218 return ()
227219
228220xmlHttpRequestGetAllResponseHeaders :: XMLHttpRequest -> IO Text
229−xmlHttpRequestGetAllResponseHeaders xhr = do
230− let c = xhrContext xhr
231− script <- jsstringcreatewithutf8cstring "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
221+xmlHttpRequestGetAllResponseHeaders xhr =
222+ xmlAuxHttpRequestGetWithJS xhr "this.getAllResponseHeaders()"
239223
240224xmlHttpRequestGetResponseHeader :: XMLHttpRequest -> Text -> IO Text
241225xmlHttpRequestGetResponseHeader xhr hdr = do
@@ -244,9 +228,21 @@ xmlHttpRequestGetResponseHeader xhr hdr = do
244228 o <- toJSObject c [xhrValue xhr, t']
245229 script <- jsstringcreatewithutf8cstring "this[0].getResponseHeader(this[1])"
246230 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
247242 j <- jsvaluetostringcopy c t nullPtr
248243 l <- jsstringgetmaximumutf8cstringsize j
249244 s <- allocaBytes (fromIntegral l) $ \ps -> do
250245 _ <- jsstringgetutf8cstring'_ j ps (fromIntegral l)
251246 peekCString ps
252247 return $ T.pack s
248+