@@ -30,7 +30,7 @@ import Data.Either (Either(..), either, note)
30
30
import Data.Foldable (any )
31
31
import Data.FormURLEncoded as FormURLEncoded
32
32
import Data.Function (on )
33
- import Data.Function.Uncurried (Fn2 , runFn2 )
33
+ import Data.Function.Uncurried (Fn4 , runFn4 )
34
34
import Data.HTTP.Method (Method (..), CustomMethod )
35
35
import Data.HTTP.Method as Method
36
36
import Data.List.NonEmpty as NEL
@@ -88,15 +88,21 @@ defaultRequest =
88
88
data Error
89
89
= RequestContentError String
90
90
| ResponseBodyError ForeignError (Response Foreign )
91
- | XHRError Exn.Error
91
+ | TimeoutError
92
+ | RequestFailedError
93
+ | XHROtherError Exn.Error
92
94
93
95
printError :: Error -> String
94
96
printError = case _ of
95
97
RequestContentError err ->
96
98
" There was a problem with the request content: " <> err
97
99
ResponseBodyError err _ ->
98
100
" There was a problem with the response body: " <> renderForeignError err
99
- XHRError err ->
101
+ TimeoutError ->
102
+ " There was a problem making the request: timeout"
103
+ RequestFailedError ->
104
+ " There was a problem making the request: request failed"
105
+ XHROtherError err ->
100
106
" There was a problem making the request: " <> Exn .message err
101
107
102
108
-- | The type of records that represents a received HTTP response.
@@ -179,16 +185,19 @@ request req =
179
185
Left err ->
180
186
pure $ Left (RequestContentError err)
181
187
where
182
-
183
188
send :: Nullable Foreign -> Aff (Either Error (Response a ))
184
189
send content =
185
- try (AC .fromEffectFnAff (runFn2 _ajax ResponseHeader (ajaxRequest content))) <#> case _ of
190
+ try (AC .fromEffectFnAff (runFn4 _ajax timeoutErrorMessageIdent requestFailedMessageIdent ResponseHeader (ajaxRequest content))) <#> case _ of
186
191
Right res ->
187
192
case runExcept (fromResponse res.body) of
188
193
Left err -> Left (ResponseBodyError (NEL .head err) res)
189
194
Right body -> Right (res { body = body })
190
195
Left err ->
191
- Left (XHRError err)
196
+ let message = Exn .message err
197
+ in Left $
198
+ if message == timeoutErrorMessageIdent then TimeoutError
199
+ else if message == requestFailedMessageIdent then RequestFailedError
200
+ else XHROtherError err
192
201
193
202
ajaxRequest :: Nullable Foreign -> AjaxRequest a
194
203
ajaxRequest =
@@ -227,6 +236,12 @@ request req =
227
236
addHeader (Accept <$> ResponseFormat .toMediaType req.responseFormat)
228
237
req.headers
229
238
239
+ timeoutErrorMessageIdent :: String
240
+ timeoutErrorMessageIdent = " AffjaxTimeoutErrorMessageIdent"
241
+
242
+ requestFailedMessageIdent :: String
243
+ requestFailedMessageIdent = " AffjaxRequestFailedMessageIdent"
244
+
230
245
addHeader :: Maybe RequestHeader -> Array RequestHeader -> Array RequestHeader
231
246
addHeader mh hs = case mh of
232
247
Just h | not $ any (on eq RequestHeader .name h) hs -> hs `Arr.snoc` h
@@ -261,7 +276,9 @@ type AjaxRequest a =
261
276
262
277
foreign import _ajax
263
278
:: forall a
264
- . Fn2
279
+ . Fn4
280
+ String
281
+ String
265
282
(String -> String -> ResponseHeader )
266
283
(AjaxRequest a )
267
284
(AC.EffectFnAff (Response Foreign ))
0 commit comments