@@ -37,6 +37,10 @@ import Reflex.Dom
3737
3838import Web.HttpApiData
3939
40+data ReqResult e a = ResponseSuccess a XhrResponse
41+ | ResponseFailure String XhrResponse
42+ | RequestFailure e
43+
4044-- data ServantError
4145-- = FailureResponse
4246-- { responseStatus :: Status
@@ -187,16 +191,18 @@ performRequestNoBody reqMethod req reqHost trigger = do
187191
188192performRequestCT :: (MonadWidget t m, MimeUnrender ct a)
189193 => Proxy ct -> String -> Req t -> Dynamic t BaseUrl
190− -> Event t () -> m (Event t (Maybe a, XhrResponse))
194+ -> Event t () -> m (Event t (ReqResult e a))
191195performRequestCT ct reqMethod req reqHost trigger = do
192196 resp <- performRequest reqMethod req reqHost trigger
193− return $ ffor resp $ \xhr ->
194− (hushed (mimeUnrender ct . BL.fromStrict . TE.encodeUtf8)
195− =<< _xhrResponse_responseText xhr, xhr)
196− where hushed :: (x -> Either e y) -> x -> Maybe y
197− hushed f ea = case f ea of
198− Left _ -> Nothing
199− Right a -> Just a
197+ let decodes = ffor resp $ \xhr ->
198+ ((mimeUnrender ct . BL.fromStrict . TE.encodeUtf8)
199+ =<< note "No body text" (_xhrResponse_responseText xhr), xhr)
200+ return $ ffor decodes $ \case
201+ (Right a, resp) -> ResponseSuccess a resp
202+ (Left e, resp) -> ResponseFailure e resp
203+
204+note :: e -> Maybe a -> Either e a
205+note e = maybe (Left e) Right
200206
201207
202208 -- partialRequest <- liftIO $ reqToRequest req reqHost