@@ -50,7 +50,7 @@ data XhrRequestConfig
5050 = XhrRequestConfig { _xhrRequestConfig_headers :: Map String String
5151 , _xhrRequestConfig_user :: Maybe String
5252 , _xhrRequestConfig_password :: Maybe String
53− , _xhrRequestConfig_responseType :: Maybe String
53+ , _xhrRequestConfig_responseType :: Maybe XhrResponseType
5454 , _xhrRequestConfig_sendData :: Maybe String
5555 }
5656 deriving (Show, Read, Eq, Ord, Typeable)
@@ -63,6 +63,21 @@ data XhrResponse
6363 }
6464 deriving (Eq, Typeable)
6565
66+data XhrResponseType = XhrResponseType_ArrayBuffer
67+ | XhrResponseType_Blob
68+ | XhrResponseType_Document
69+ | XhrResponseType_JSON
70+ | XhrResponseType_Text
71+ deriving (Show, Read, Eq, Ord, Typeable)
72+
73+responseTypeString :: XhrResponseType -> String
74+responseTypeString rt = case rt of
75+ XhrResponseType_ArrayBuffer -> "arraybuffer"
76+ XhrResponseType_Blob -> "blob"
77+ XhrResponseType_Document -> "document"
78+ XhrResponseType_JSON -> "json"
79+ XhrResponseType_Text -> "text"
80+
6681{-# DEPRECATED _xhrResponse_body "Use _xhrResponse_response or _xhrResponse_responseText instead." #-}
6782_xhrResponse_body :: XhrResponse -> Maybe Text
6883_xhrResponse_body = _xhrResponse_responseText
@@ -90,7 +105,7 @@ newXMLHttpRequest req cb = do
90105 liftIO $ do
91106 xhr <- xmlHttpRequestNew wv
92107 let c = _xhrRequest_config req
93− responseType = _xhrRequestConfig_responseType c
108+ rt = _xhrRequestConfig_responseType c
94109 xmlHttpRequestOpen
95110 xhr
96111 (_xhrRequest_method req)
@@ -99,14 +114,14 @@ newXMLHttpRequest req cb = do
99114 (fromMaybe "" $ _xhrRequestConfig_user c)
100115 (fromMaybe "" $ _xhrRequestConfig_password c)
101116 iforM_ (_xhrRequestConfig_headers c) $ xmlHttpRequestSetRequestHeader xhr
102− maybe (return ()) (xmlHttpRequestSetResponseType xhr . toResponseType) (_xhrRequestConfig_responseType c)
117+ maybe (return ()) (xmlHttpRequestSetResponseType xhr . toResponseType . responseTypeString) rt
103118 _ <- xmlHttpRequestOnreadystatechange xhr $ do
104119 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr
105120 status <- liftIO $ xmlHttpRequestGetStatus xhr
106121 statusText <- liftIO $ xmlHttpRequestGetStatusText xhr
107122 if readyState == 4
108123 then do
109− t <- if responseType == Just "text" || responseType == Nothing
124+ t <- if rt == Just XhrResponseType_Text || rt == Nothing
110125 then liftIO $ xmlHttpRequestGetResponseText xhr
111126 else return Nothing
112127 r <- liftIO $ xmlHttpRequestGetResponse xhr