git.iko.soy/reflex-dom
on develop help sign in
Replace String with XhrResponseType in XhrRequestConfig
4f31254Ali Abrar
src/Reflex/Dom/Xhr.hs+19−4
compare with develop
unifiedsplit
@@ -50,7 +50,7 @@ data XhrRequestConfig
50 = XhrRequestConfig { _xhrRequestConfig_headers :: Map String String
50 = XhrRequestConfig { _xhrRequestConfig_headers :: Map String String
51 , _xhrRequestConfig_user :: Maybe String
51 , _xhrRequestConfig_user :: Maybe String
52 , _xhrRequestConfig_password :: Maybe String
52 , _xhrRequestConfig_password :: Maybe String
53− , _xhrRequestConfig_responseType :: Maybe String
53+ , _xhrRequestConfig_responseType :: Maybe XhrResponseType
54 , _xhrRequestConfig_sendData :: Maybe String
54 , _xhrRequestConfig_sendData :: Maybe String
55 }
55 }
56 deriving (Show, Read, Eq, Ord, Typeable)
56 deriving (Show, Read, Eq, Ord, Typeable)
@@ -63,6 +63,21 @@ data XhrResponse
63 }
63 }
64 deriving (Eq, Typeable)
64 deriving (Eq, Typeable)
65
65
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+
66{-# DEPRECATED _xhrResponse_body "Use _xhrResponse_response or _xhrResponse_responseText instead." #-}
81{-# DEPRECATED _xhrResponse_body "Use _xhrResponse_response or _xhrResponse_responseText instead." #-}
67_xhrResponse_body :: XhrResponse -> Maybe Text
82_xhrResponse_body :: XhrResponse -> Maybe Text
68_xhrResponse_body = _xhrResponse_responseText
83_xhrResponse_body = _xhrResponse_responseText
@@ -90,7 +105,7 @@ newXMLHttpRequest req cb = do
90 liftIO $ do
105 liftIO $ do
91 xhr <- xmlHttpRequestNew wv
106 xhr <- xmlHttpRequestNew wv
92 let c = _xhrRequest_config req
107 let c = _xhrRequest_config req
93− responseType = _xhrRequestConfig_responseType c
108+ rt = _xhrRequestConfig_responseType c
94 xmlHttpRequestOpen
109 xmlHttpRequestOpen
95 xhr
110 xhr
96 (_xhrRequest_method req)
111 (_xhrRequest_method req)
@@ -99,14 +114,14 @@ newXMLHttpRequest req cb = do
99 (fromMaybe "" $ _xhrRequestConfig_user c)
114 (fromMaybe "" $ _xhrRequestConfig_user c)
100 (fromMaybe "" $ _xhrRequestConfig_password c)
115 (fromMaybe "" $ _xhrRequestConfig_password c)
101 iforM_ (_xhrRequestConfig_headers c) $ xmlHttpRequestSetRequestHeader xhr
116 iforM_ (_xhrRequestConfig_headers c) $ xmlHttpRequestSetRequestHeader xhr
102− maybe (return ()) (xmlHttpRequestSetResponseType xhr . toResponseType) (_xhrRequestConfig_responseType c)
117+ maybe (return ()) (xmlHttpRequestSetResponseType xhr . toResponseType . responseTypeString) rt
103 _ <- xmlHttpRequestOnreadystatechange xhr $ do
118 _ <- xmlHttpRequestOnreadystatechange xhr $ do
104 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr
119 readyState <- liftIO $ xmlHttpRequestGetReadyState xhr
105 status <- liftIO $ xmlHttpRequestGetStatus xhr
120 status <- liftIO $ xmlHttpRequestGetStatus xhr
106 statusText <- liftIO $ xmlHttpRequestGetStatusText xhr
121 statusText <- liftIO $ xmlHttpRequestGetStatusText xhr
107 if readyState == 4
122 if readyState == 4
108 then do
123 then do
109− t <- if responseType == Just "text" || responseType == Nothing
124+ t <- if rt == Just XhrResponseType_Text || rt == Nothing
110 then liftIO $ xmlHttpRequestGetResponseText xhr
125 then liftIO $ xmlHttpRequestGetResponseText xhr
111 else return Nothing
126 else return Nothing
112 r <- liftIO $ xmlHttpRequestGetResponse xhr
127 r <- liftIO $ xmlHttpRequestGetResponse xhr