e61e94b · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Add support for Blob and ArrayBuffer to XhrResponse

e61e94bAli Abrar11 years ago

src-ghc/Reflex/Dom/Internal/Foreign.hs+38−9

compare with develop

unifiedsplit

@@ -1,11 +1,16 @@

1{-# LANGUAGE CPP, ForeignFunctionInterface, ScopedTypeVariables, LambdaCase #-}

2module Reflex.Dom.Internal.Foreign where

4−import Control.Lens hiding (set)

5−import GHCJS.DOM hiding (runWebGUI)

6import Control.Concurrent

4import Control.Concurrent

5+import Control.Exception (bracket)

6+import Control.Lens hiding (set)

7+import Control.Monad

7import Control.Monad.State.Strict hiding (mapM, mapM_, forM, forM_, sequence, sequence_, get)

8import Control.Monad.State.Strict hiding (mapM, mapM_, forM, forM_, sequence, sequence_, get)

9+import Data.ByteString (ByteString)

10+import Data.List

11+import Foreign.Marshal hiding (void)

8import Foreign.Ptr

12import Foreign.Ptr

13+import GHCJS.DOM hiding (runWebGUI)

9import GHCJS.DOM.Navigator

14import GHCJS.DOM.Navigator

10import GHCJS.DOM.Window

15import GHCJS.DOM.Window

11import Graphics.UI.Gtk hiding (Widget)

16import Graphics.UI.Gtk hiding (Widget)

@@ -14,14 +19,14 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

14import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef

19import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef

15import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

20import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

16import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame

21import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame

17−import Graphics.UI.Gtk.WebKit.WebView

18import Graphics.UI.Gtk.WebKit.Types hiding (Event, Widget)

22import Graphics.UI.Gtk.WebKit.Types hiding (Event, Widget)

19−import Graphics.UI.Gtk.WebKit.WebSettings

20import Graphics.UI.Gtk.WebKit.WebFrame

23import Graphics.UI.Gtk.WebKit.WebFrame

21import Graphics.UI.Gtk.WebKit.WebInspector

24import Graphics.UI.Gtk.WebKit.WebInspector

22−import Data.List

25+import Graphics.UI.Gtk.WebKit.WebSettings

26+import Graphics.UI.Gtk.WebKit.WebView

23import System.Directory

27import System.Directory

24import System.Glib.FFI hiding (void)

28import System.Glib.FFI hiding (void)

29+import qualified Data.ByteString as BS

26#ifndef mingw32_HOST_OS

31#ifndef mingw32_HOST_OS

27import System.Posix.Signals

32import System.Posix.Signals

@@ -117,18 +122,42 @@ fromJSStringMaybe c t = do

117 return $ Just s

122 return $ Just s

118

123

119getLocationHost :: WebView -> IO String

124getLocationHost :: WebView -> IO String

120−getLocationHost wv = do

125+getLocationHost wv = withWebViewContext wv $ \c -> do

121− c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv

122 script <- jsstringcreatewithutf8cstring "location.host"

126 script <- jsstringcreatewithutf8cstring "location.host"

123 lh <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr

127 lh <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr

124 lh' <- fromJSStringMaybe c lh

128 lh' <- fromJSStringMaybe c lh

125 return $ maybe "" id lh'

129 return $ maybe "" id lh'

126

130

127getLocationProtocol :: WebView -> IO String

131getLocationProtocol :: WebView -> IO String

128−getLocationProtocol wv = do

132+getLocationProtocol wv = withWebViewContext wv $ \c -> do

129− c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv

130 script <- jsstringcreatewithutf8cstring "location.protocol"

133 script <- jsstringcreatewithutf8cstring "location.protocol"

131 lp <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr

134 lp <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr

132 lp' <- fromJSStringMaybe c lp

135 lp' <- fromJSStringMaybe c lp

133 return $ maybe "" id lp'

136 return $ maybe "" id lp'

134

137

138+bsToArrayBuffer :: JSContextRef -> ByteString -> IO JSValueRef

139+bsToArrayBuffer c bs = do

140+ elems <- forM (BS.unpack bs) $ \x -> jsvaluemakenumber c $ fromIntegral x

141+ let numElems = length elems

142+ bracket (mallocArray numElems) free $ \elemsArr -> do

143+ pokeArray elemsArr elems

144+ a <- jsobjectmakearray c (fromIntegral numElems) elemsArr nullPtr

145+ newUint8Array <- jsstringcreatewithutf8cstring "new Uint8Array(this)"

146+ jsevaluatescript c newUint8Array a nullPtr 1 nullPtr

147+

148+bsFromArrayBuffer :: JSContextRef -> JSValueRef -> IO ByteString

149+bsFromArrayBuffer c a = do

150+ let getIntegral = fmap round . (\x -> jsvaluetonumber c x nullPtr)

151+ getByteLength <- jsstringcreatewithutf8cstring "this.byteLength"

152+ byteLength <- getIntegral =<< jsevaluatescript c getByteLength a nullPtr 1 nullPtr

153+ toUint8Array <- jsstringcreatewithutf8cstring "new Uint8Array(this)"

154+ uint8Array <- jsevaluatescript c toUint8Array a nullPtr 1 nullPtr

155+ getIx <- jsstringcreatewithutf8cstring "this[0][this[1]]"

156+ let arrayLookup i = do

157+ i' <- jsvaluemakenumber c (fromIntegral i)

158+ args <- toJSObject c [uint8Array, i']

159+ getIntegral =<< jsevaluatescript c getIx args nullPtr 1 nullPtr

160+ fmap BS.pack $ forM [0..byteLength-1] arrayLookup

161+

162+withWebViewContext :: WebView -> (JSContextRef -> IO a) -> IO a

163+withWebViewContext wv f = f =<< webFrameGetGlobalContext =<< webViewGetMainFrame wv

src-ghc/Reflex/Dom/WebSocket/Foreign.hs+1−3

@@ -15,7 +15,6 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

15import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

16import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef

17import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

18−import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame

19import Graphics.UI.Gtk.WebKit.WebView

18import Graphics.UI.Gtk.WebKit.WebView

20import qualified Data.ByteString as BS

19import qualified Data.ByteString as BS

21import qualified Data.Text as T

20import qualified Data.Text as T

@@ -27,8 +26,7 @@ data JSWebSocket = JSWebSocket { wsValue :: JSValueRef

27 }

26 }

29newWebSocket :: WebView -> String -> (ByteString -> IO ()) -> IO () -> IO () -> IO JSWebSocket

28newWebSocket :: WebView -> String -> (ByteString -> IO ()) -> IO () -> IO () -> IO JSWebSocket

30−newWebSocket wv url onMessage onOpen onClose = do

29+newWebSocket wv url onMessage onOpen onClose = withWebViewContext wv $ \c -> do

31− c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv

32 url' <- jsvaluemakestring c =<< jsstringcreatewithutf8cstring url

30 url' <- jsvaluemakestring c =<< jsstringcreatewithutf8cstring url

33 newWSArgs <- toJSObject c [url']

31 newWSArgs <- toJSObject c [url']

34 newWS <- jsstringcreatewithutf8cstring "(function(that) { var ws = new WebSocket(that[0]); ws['binaryType'] = 'arraybuffer'; return ws; })(this)"

32 newWS <- jsstringcreatewithutf8cstring "(function(that) { var ws = new WebSocket(that[0]); ws['binaryType'] = 'arraybuffer'; return ws; })(this)"

src-ghc/Reflex/Dom/Xhr/Foreign.hs+31−24

@@ -1,6 +1,8 @@

1{-# LANGUAGE QuasiQuotes, ForeignFunctionInterface #-}

2module Reflex.Dom.Xhr.Foreign where

3module Reflex.Dom.Xhr.Foreign where

5+import Control.Monad

4import qualified Data.Text as T

6import qualified Data.Text as T

5import Data.Text (Text)

7import Data.Text (Text)

6import System.Glib.FFI

8import System.Glib.FFI

@@ -9,11 +11,11 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

9import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

11import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

10import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef

12import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef

11import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

13import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

12−import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame

13import Reflex.Dom.Xhr.ResponseType

14import Reflex.Dom.Xhr.ResponseType

14import Reflex.Dom.Xhr.Exception

15import Reflex.Dom.Xhr.Exception

15import Control.Concurrent.MVar

16import Control.Concurrent.MVar

16import Control.Exception.Base

17import Control.Exception.Base

18+import Graphics.UI.Gtk.WebKit.Types hiding (Text)

18import Reflex.Dom.Internal.Foreign

20import Reflex.Dom.Internal.Foreign

@@ -25,23 +27,24 @@ data XMLHttpRequest

25 }

27 }

26 deriving (Eq, Ord)

28 deriving (Eq, Ord)

28−data XhrResponseBody = XhrResponseBody { unXhrResponseBody :: JSValueRef }

29−

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

31stringToJSValue ctx s = jsvaluemakestring ctx =<< jsstringcreatewithutf8cstring s

33−toResponseType :: XhrResponseType -> String

33+fromResponseType :: XhrResponseType -> String

34−toResponseType XhrResponseType_Default = ""

34+fromResponseType XhrResponseType_Default = ""

35−toResponseType XhrResponseType_ArrayBuffer = "arraybuffer"

35+fromResponseType XhrResponseType_ArrayBuffer = "arraybuffer"

36−toResponseType XhrResponseType_Blob = "blob"

36+fromResponseType XhrResponseType_Blob = "blob"

37−toResponseType XhrResponseType_Document = "document"

37+fromResponseType XhrResponseType_Text = "text"

38−toResponseType XhrResponseType_JSON = "json"

38+

39−toResponseType XhrResponseType_Text = "text"

39+toResponseType :: String -> Maybe XhrResponseType

40+toResponseType "" = Just XhrResponseType_Default

41+toResponseType "arraybuffer" = Just XhrResponseType_ArrayBuffer

42+toResponseType "blob" = Just XhrResponseType_Blob

43+toResponseType "text" = Just XhrResponseType_Text

44+toResponseType _ = Nothing

41xmlHttpRequestNew :: WebView -> IO XMLHttpRequest

46xmlHttpRequestNew :: WebView -> IO XMLHttpRequest

42−xmlHttpRequestNew wv = do

47+xmlHttpRequestNew wv = withWebViewContext wv $ \jsContext -> do

43− wf <- webViewGetMainFrame wv

44− jsContext <- webFrameGetGlobalContext wf

45 xhrScript <- jsstringcreatewithutf8cstring "new XMLHttpRequest()"

48 xhrScript <- jsstringcreatewithutf8cstring "new XMLHttpRequest()"

46 xhr' <- jsevaluatescript jsContext xhrScript nullPtr nullPtr 1 nullPtr

49 xhr' <- jsevaluatescript jsContext xhrScript nullPtr nullPtr 1 nullPtr

47 jsvalueprotect jsContext xhr'

50 jsvalueprotect jsContext xhr'

@@ -80,31 +83,35 @@ xmlHttpRequestGetReadyState xhr = do

80 d <- jsvaluetonumber c rs nullPtr

83 d <- jsvaluetonumber c rs nullPtr

81 return $ truncate d

84 return $ truncate d

86+xmlHttpRequestGetResponseType :: XMLHttpRequest -> IO (Maybe XhrResponseType)

87+xmlHttpRequestGetResponseType xhr = do

88+ script <- jsstringcreatewithutf8cstring "this.responseType"

89+ rt <- jsevaluatescript (xhrContext xhr) script (xhrValue xhr) nullPtr 1 nullPtr

90+ ms <- fromJSStringMaybe (xhrContext xhr) rt

91+ return $ join $ fmap toResponseType ms

92+

83xmlHttpRequestGetResponse :: XMLHttpRequest -> IO (Maybe XhrResponseBody)

93xmlHttpRequestGetResponse :: XMLHttpRequest -> IO (Maybe XhrResponseBody)

84xmlHttpRequestGetResponse xhr = do

94xmlHttpRequestGetResponse xhr = do

85 let c = xhrContext xhr

95 let c = xhrContext xhr

96+ mrt <- xmlHttpRequestGetResponseType xhr

86 script <- jsstringcreatewithutf8cstring "this.response"

97 script <- jsstringcreatewithutf8cstring "this.response"

87 t <- jsevaluatescript c script (xhrValue xhr) nullPtr 1 nullPtr

98 t <- jsevaluatescript c script (xhrValue xhr) nullPtr 1 nullPtr

88 isNull <- jsvalueisnull c t

99 isNull <- jsvalueisnull c t

89 case isNull of

100 case isNull of

90 True -> return Nothing

101 True -> return Nothing

91− False -> return $ Just $ XhrResponseBody t

102+ False -> case mrt of

103+ Just XhrResponseType_ArrayBuffer -> Just . XhrResponseBody_ArrayBuffer <$> bsFromArrayBuffer c t

104+ Just XhrResponseType_Blob -> Just . XhrResponseBody_Blob . Blob . castForeignPtr <$> newForeignPtr_ t

105+ Just XhrResponseType_Default -> fmap (XhrResponseBody_Default . T.pack) <$> fromJSStringMaybe c t

106+ Just XhrResponseType_Text -> fmap (XhrResponseBody_Text . T.pack) <$> fromJSStringMaybe c t

107+ _ -> return Nothing

108

93xmlHttpRequestGetResponseText :: XMLHttpRequest -> IO (Maybe Text)

109xmlHttpRequestGetResponseText :: XMLHttpRequest -> IO (Maybe Text)

94xmlHttpRequestGetResponseText xhr = do

110xmlHttpRequestGetResponseText xhr = do

95 let c = xhrContext xhr

111 let c = xhrContext xhr

96 script <- jsstringcreatewithutf8cstring "this.responseText"

112 script <- jsstringcreatewithutf8cstring "this.responseText"

97 t <- jsevaluatescript c script (xhrValue xhr) nullPtr 1 nullPtr

113 t <- jsevaluatescript c script (xhrValue xhr) nullPtr 1 nullPtr

98− isNull <- jsvalueisnull c t

114+ fmap (fmap T.pack) $ fromJSStringMaybe c t

99− case isNull of

100− True -> return Nothing

101− False -> do

102− j <- jsvaluetostringcopy c t nullPtr

103− l <- jsstringgetmaximumutf8cstringsize j

104− s <- allocaBytes (fromIntegral l) $ \ps -> do

105− _ <- jsstringgetutf8cstring'_ j ps (fromIntegral l)

106− peekCString ps

107− return $ Just $ T.pack s

108

115

109xmlHttpRequestSend :: XMLHttpRequest -> Maybe String -> IO ()

116xmlHttpRequestSend :: XMLHttpRequest -> Maybe String -> IO ()

110xmlHttpRequestSend xhr payload = do

117xmlHttpRequestSend xhr payload = do

src-ghcjs/Reflex/Dom/Internal/Foreign.hs+21

@@ -4,9 +4,16 @@ module Reflex.Dom.Internal.Foreign ( module Reflex.Dom.Internal.Foreign

4 ) where

6import Control.Monad

7+import Data.ByteString (ByteString)

8+import Foreign

9+import Foreign.C

7import GHCJS.DOM

10import GHCJS.DOM

8import GHCJS.DOM.Types

11import GHCJS.DOM.Types

9import GHCJS.Types

12import GHCJS.Types

13+import JavaScript.TypedArray.ArrayBuffer as JS

14+import qualified Data.ByteString as BS

15+import qualified GHCJS.Buffer as JS

16+import qualified GHCJS.Marshal.Pure as JS

11quitWebView :: WebView -> IO ()

18quitWebView :: WebView -> IO ()

12quitWebView = error "quitWebView: unimplemented in GHCJS"

19quitWebView = error "quitWebView: unimplemented in GHCJS"

@@ -20,3 +27,17 @@ foreign import javascript unsafe "location['protocol']" getLocationProtocol_ ::

21getLocationProtocol :: FromJSString r => a -> IO r

28getLocationProtocol :: FromJSString r => a -> IO r

22getLocationProtocol _ = liftM fromJSString getLocationProtocol_

29getLocationProtocol _ = liftM fromJSString getLocationProtocol_

30+

31+withWebViewContext :: a -> (a -> IO b) -> IO b

32+withWebViewContext a f = f a

33+

34+foreign import javascript safe "new DataView($3,$1,$2)" js_dataView :: Int -> Int -> JSVal -> JSVal

35+

36+foreign import javascript unsafe "new Uint8Array($1_1.buf, $1_2, $2)[\"buffer\"]" extractByteArray :: Ptr CChar -> Int -> IO JSVal

37+

38+bsToArrayBuffer :: a -> ByteString -> IO JSVal

39+bsToArrayBuffer _ bs = BS.useAsCString bs $ \cStr -> do

40+ extractByteArray cStr $ BS.length bs

41+

42+bsFromArrayBuffer :: a -> JSVal -> IO ByteString

43+bsFromArrayBuffer _ ab = liftM (JS.toByteString 0 Nothing . JS.createFromArrayBuffer) $ JS.unsafeFreeze $ JS.pFromJSVal ab

src-ghcjs/Reflex/Dom/Xhr/Foreign.hs+24−14

@@ -15,14 +15,11 @@ import GHCJS.DOM.XMLHttpRequest

15import Data.Maybe (fromMaybe)

16import GHCJS.DOM.EventTarget (dispatchEvent)

17import GHCJS.DOM.EventM (EventM, on)

18−import GHCJS.DOM.JSFFI.XMLHttpRequest (XHRError(..))

18+import Reflex.Dom.Internal.Foreign

19−import GHCJS.Types

20import Reflex.Dom.Xhr.Exception

19import Reflex.Dom.Xhr.Exception

21import Reflex.Dom.Xhr.ResponseType

20import Reflex.Dom.Xhr.ResponseType

22import Control.Exception (catch, throwIO)

21import Control.Exception (catch, throwIO)

24−data XhrResponseBody = XhrResponseBody { unXhrResponseBody :: JSVal }

25−

26prepareWebView :: WebView -> IO ()

23prepareWebView :: WebView -> IO ()

27prepareWebView _ = return ()

24prepareWebView _ = return ()

@@ -114,16 +111,21 @@ xmlHttpRequestGetResponseXML = getResponseXML

114xmlHttpRequestSetResponseType :: XMLHttpRequest -> XMLHttpRequestResponseType -> IO ()

111xmlHttpRequestSetResponseType :: XMLHttpRequest -> XMLHttpRequestResponseType -> IO ()

115xmlHttpRequestSetResponseType = setResponseType

112xmlHttpRequestSetResponseType = setResponseType

116

113

117−toResponseType :: XhrResponseType -> XMLHttpRequestResponseType

114+fromResponseType :: XhrResponseType -> XMLHttpRequestResponseType

118−toResponseType XhrResponseType_Default = XMLHttpRequestResponseType

115+fromResponseType XhrResponseType_Default = XMLHttpRequestResponseType

119−toResponseType XhrResponseType_ArrayBuffer = XMLHttpRequestResponseTypeArraybuffer

116+fromResponseType XhrResponseType_ArrayBuffer = XMLHttpRequestResponseTypeArraybuffer

120−toResponseType XhrResponseType_Blob = XMLHttpRequestResponseTypeBlob

117+fromResponseType XhrResponseType_Blob = XMLHttpRequestResponseTypeBlob

121−toResponseType XhrResponseType_Document = XMLHttpRequestResponseTypeDocument

118+fromResponseType XhrResponseType_Text = XMLHttpRequestResponseTypeText

122−toResponseType XhrResponseType_JSON = XMLHttpRequestResponseTypeJson

119+

120+toResponseType :: XMLHttpRequestResponseType -> Maybe XhrResponseType

121+toResponseType XMLHttpRequestResponseType = Just XhrResponseType_Default

122+toResponseType XMLHttpRequestResponseTypeArraybuffer = Just XhrResponseType_ArrayBuffer

123+toResponseType XMLHttpRequestResponseTypeBlob = Just XhrResponseType_Blob

123−toResponseType XhrResponseType_Text = XMLHttpRequestResponseTypeText

124+toResponseType XMLHttpRequestResponseTypeText = Just XhrResponseType_Text

125+toResponseType _ = Nothing

124

126

125−xmlHttpRequestGetResponseType :: XMLHttpRequest -> IO XMLHttpRequestResponseType

127+xmlHttpRequestGetResponseType :: XMLHttpRequest -> IO (Maybe XhrResponseType)

126−xmlHttpRequestGetResponseType = getResponseType

128+xmlHttpRequestGetResponseType = fmap toResponseType . getResponseType

127

129

128xmlHttpRequestGetStatus :: XMLHttpRequest -> IO Word

130xmlHttpRequestGetStatus :: XMLHttpRequest -> IO Word

129xmlHttpRequestGetStatus = getStatus

131xmlHttpRequestGetStatus = getStatus

@@ -137,5 +139,13 @@ xmlHttpRequestGetResponseURL = getResponseURL

137xmlHttpRequestGetResponse :: XMLHttpRequest -> IO (Maybe XhrResponseBody)

139xmlHttpRequestGetResponse :: XMLHttpRequest -> IO (Maybe XhrResponseBody)

138xmlHttpRequestGetResponse xhr = do

140xmlHttpRequestGetResponse xhr = do

139 mr <- getResponse xhr

141 mr <- getResponse xhr

140− return $ fmap (\(GObject r) -> XhrResponseBody r) mr

142+ rt <- xmlHttpRequestGetResponseType xhr

143+ case rt of

144+ Just XhrResponseType_Blob -> return $ fmap (XhrResponseBody_Blob . castToBlob) mr

145+ Just XhrResponseType_Text -> fmap (Just . XhrResponseBody_Text) $ xmlHttpRequestGetStatusText xhr

146+ Just XhrResponseType_Default -> fmap (Just . XhrResponseBody_Text) $ xmlHttpRequestGetStatusText xhr

147+ Just XhrResponseType_ArrayBuffer -> case (fmap unGObject mr) of

148+ Nothing -> return Nothing

149+ Just ptr -> fmap (Just . XhrResponseBody_ArrayBuffer) $ bsFromArrayBuffer ptr ptr

150+ _ -> return Nothing

141

151

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

@@ -131,7 +131,7 @@ newXMLHttpRequestWithError req cb = do

131 (fromMaybe "" $ _xhrRequestConfig_user c)

132 (fromMaybe "" $ _xhrRequestConfig_password c)

133 iforM_ (_xhrRequestConfig_headers c) $ xmlHttpRequestSetRequestHeader xhr

134− maybe (return ()) (xmlHttpRequestSetResponseType xhr . toResponseType) rt

134+ maybe (return ()) (xmlHttpRequestSetResponseType xhr . fromResponseType) rt

135 _ <- xmlHttpRequestOnreadystatechange xhr $ do

136 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr

137 status <- liftIO $ xmlHttpRequestGetStatus xhr

@@ -226,3 +226,4 @@ decodeText = decode . BL.fromStrict . encodeUtf8

226-- | Convenience function to decode JSON-encoded responses.

227decodeXhrResponse :: FromJSON a => XhrResponse -> Maybe a

228decodeXhrResponse = join . fmap decodeText . _xhrResponse_responseText

229+

src/Reflex/Dom/Xhr/ResponseType.hs+9−2

@@ -3,12 +3,19 @@

3module Reflex.Dom.Xhr.ResponseType where

5import Data.Typeable

6+import Data.Text (Text)

7+import GHCJS.DOM.Blob (Blob)

8+import Data.ByteString (ByteString)

7data XhrResponseType = XhrResponseType_Default

10data XhrResponseType = XhrResponseType_Default

8 | XhrResponseType_ArrayBuffer

11 | XhrResponseType_ArrayBuffer

9 | XhrResponseType_Blob

12 | XhrResponseType_Blob

10− | XhrResponseType_Document

11− | XhrResponseType_JSON

12 | XhrResponseType_Text

13 | XhrResponseType_Text

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

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

16+data XhrResponseBody = XhrResponseBody_Default Text

17+ | XhrResponseBody_Text Text

18+ | XhrResponseBody_Blob Blob

19+ | XhrResponseBody_ArrayBuffer ByteString

20+ deriving (Eq)

21+