{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE OverloadedStrings #-}

module Reflex.Dom.Xhr.Foreign (
    XMLHttpRequest
  , XMLHttpRequestResponseType(..)
  , module Reflex.Dom.Xhr.Foreign
) where

import Control.Exception (throwIO)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.ByteString (ByteString)
import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)
import GHCJS.DOM.Enums
import GHCJS.DOM.EventM (EventM, on)
import GHCJS.DOM.EventTarget (dispatchEvent)
import GHCJS.DOM.Types (MonadJSM, ToJSString, FormData, Document, Blob (..), ArrayBuffer (..), JSVal, JSM, IsEvent, XMLHttpRequestProgressEvent, ProgressEvent, Event, XMLHttpRequestUpload, FromJSString, ArrayBufferView (..), liftJSM, castTo)
import GHCJS.DOM.XMLHttpRequest
import Language.Javascript.JSaddle.Helper (mutableArrayBufferFromJSVal)
import qualified Language.Javascript.JSaddle.Monad as JS (catch)
import Prelude hiding (error)
import Reflex.Dom.Xhr.Exception
import Reflex.Dom.Xhr.ResponseType

xmlHttpRequestNew :: MonadJSM m => m XMLHttpRequest
xmlHttpRequestNew :: m XMLHttpRequest
xmlHttpRequestNew = m XMLHttpRequest
forall (m :: * -> *). MonadDOM m => m XMLHttpRequest
newXMLHttpRequest

xmlHttpRequestOpen ::
                   (ToJSString method, ToJSString url, ToJSString user, ToJSString password, MonadJSM m) =>
                     XMLHttpRequest -> method -> url -> Bool -> user -> password -> m ()
xmlHttpRequestOpen :: XMLHttpRequest -> method -> url -> Bool -> user -> password -> m ()
xmlHttpRequestOpen request :: XMLHttpRequest
request method :: method
method url :: url
url async :: Bool
async user :: user
user password :: password
password = XMLHttpRequest
-> method -> url -> Bool -> Maybe user -> Maybe password -> m ()
forall (m :: * -> *) method url user password.
(MonadDOM m, ToJSString method, ToJSString url, ToJSString user,
 ToJSString password) =>
XMLHttpRequest
-> method -> url -> Bool -> Maybe user -> Maybe password -> m ()
open XMLHttpRequest
request method
method url
url Bool
async (user -> Maybe user
forall a. a -> Maybe a
Just user
user) (password -> Maybe password
forall a. a -> Maybe a
Just password
password)

convertException :: XHRError -> XhrException
convertException :: XHRError -> XhrException
convertException e :: XHRError
e = case XHRError
e of
  XHRError -> XhrException
XhrException_Error
  XHRAborted -> XhrException
XhrException_Aborted

class IsXhrPayload a where
  sendXhrPayload :: MonadJSM m => XMLHttpRequest -> a -> m ()

instance IsXhrPayload () where
  sendXhrPayload :: XMLHttpRequest -> () -> m ()
sendXhrPayload xhr :: XMLHttpRequest
xhr _ = XMLHttpRequest -> m ()
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> m ()
send XMLHttpRequest
xhr

instance IsXhrPayload String where
  sendXhrPayload :: XMLHttpRequest -> String -> m ()
sendXhrPayload = XMLHttpRequest -> String -> m ()
forall (m :: * -> *) str.
(MonadDOM m, ToJSString str) =>
XMLHttpRequest -> str -> m ()
sendString

instance IsXhrPayload Text where
  sendXhrPayload :: XMLHttpRequest -> Text -> m ()
sendXhrPayload = XMLHttpRequest -> Text -> m ()
forall (m :: * -> *) str.
(MonadDOM m, ToJSString str) =>
XMLHttpRequest -> str -> m ()
sendString

instance IsXhrPayload FormData where
  sendXhrPayload :: XMLHttpRequest -> FormData -> m ()
sendXhrPayload = XMLHttpRequest -> FormData -> m ()
forall (m :: * -> *).
MonadJSM m =>
XMLHttpRequest -> FormData -> m ()
sendFormData

instance IsXhrPayload Document where
  sendXhrPayload :: XMLHttpRequest -> Document -> m ()
sendXhrPayload = XMLHttpRequest -> Document -> m ()
forall (m :: * -> *) doc.
(MonadDOM m, IsDocument doc) =>
XMLHttpRequest -> doc -> m ()
sendDocument

instance IsXhrPayload Blob where
  sendXhrPayload :: XMLHttpRequest -> Blob -> m ()
sendXhrPayload = XMLHttpRequest -> Blob -> m ()
forall (m :: * -> *) blob.
(MonadDOM m, IsBlob blob) =>
XMLHttpRequest -> blob -> m ()
sendBlob

instance IsXhrPayload ArrayBuffer where
  sendXhrPayload :: XMLHttpRequest -> ArrayBuffer -> m ()
sendXhrPayload xhr :: XMLHttpRequest
xhr ab :: ArrayBuffer
ab = XMLHttpRequest -> ArrayBufferView -> m ()
forall (m :: * -> *) view.
(MonadDOM m, IsArrayBufferView view) =>
XMLHttpRequest -> view -> m ()
sendArrayBuffer XMLHttpRequest
xhr (JSVal -> ArrayBufferView
ArrayBufferView (JSVal -> ArrayBufferView) -> JSVal -> ArrayBufferView
forall a b. (a -> b) -> a -> b
$ ArrayBuffer -> JSVal
unArrayBuffer ArrayBuffer
ab)

instance IsXhrPayload ByteString where
  sendXhrPayload :: XMLHttpRequest -> ByteString -> m ()
sendXhrPayload xhr :: XMLHttpRequest
xhr bs :: ByteString
bs = XMLHttpRequest -> ArrayBuffer -> m ()
forall a (m :: * -> *).
(IsXhrPayload a, MonadJSM m) =>
XMLHttpRequest -> a -> m ()
sendXhrPayload XMLHttpRequest
xhr (ArrayBuffer -> m ()) -> m ArrayBuffer -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSM ArrayBuffer -> m ArrayBuffer
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (ByteString -> JSM ArrayBuffer
forall (m :: * -> *). MonadJSM m => ByteString -> m ArrayBuffer
bsToArrayBuffer ByteString
bs)

newtype XhrPayload = XhrPayload { XhrPayload -> JSVal
unXhrPayload :: JSVal }

-- This used to be a non blocking call, but now it uses an interruptible ffi
xmlHttpRequestSend :: IsXhrPayload payload => XMLHttpRequest -> payload -> JSM ()
xmlHttpRequestSend :: XMLHttpRequest -> payload -> JSM ()
xmlHttpRequestSend self :: XMLHttpRequest
self p :: payload
p = XMLHttpRequest -> payload -> JSM ()
forall a (m :: * -> *).
(IsXhrPayload a, MonadJSM m) =>
XMLHttpRequest -> a -> m ()
sendXhrPayload XMLHttpRequest
self payload
p JSM () -> (XHRError -> JSM ()) -> JSM ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`JS.catch` (IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (XHRError -> IO ()) -> XHRError -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XhrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (XhrException -> IO ())
-> (XHRError -> XhrException) -> XHRError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XHRError -> XhrException
convertException)


xmlHttpRequestSetRequestHeader :: (ToJSString header, ToJSString value, MonadJSM m)
                               => XMLHttpRequest -> header -> value -> m ()
xmlHttpRequestSetRequestHeader :: XMLHttpRequest -> header -> value -> m ()
xmlHttpRequestSetRequestHeader = XMLHttpRequest -> header -> value -> m ()
forall (m :: * -> *) header value.
(MonadDOM m, ToJSString header, ToJSString value) =>
XMLHttpRequest -> header -> value -> m ()
setRequestHeader

xmlHttpRequestAbort :: MonadJSM m => XMLHttpRequest -> m ()
xmlHttpRequestAbort :: XMLHttpRequest -> m ()
xmlHttpRequestAbort = XMLHttpRequest -> m ()
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> m ()
abort

xmlHttpRequestGetAllResponseHeaders :: MonadJSM m => XMLHttpRequest -> m Text
xmlHttpRequestGetAllResponseHeaders :: XMLHttpRequest -> m Text
xmlHttpRequestGetAllResponseHeaders = XMLHttpRequest -> m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
XMLHttpRequest -> m result
getAllResponseHeaders

xmlHttpRequestGetResponseHeader :: (ToJSString header, MonadJSM m)
                                => XMLHttpRequest -> header -> m Text
xmlHttpRequestGetResponseHeader :: XMLHttpRequest -> header -> m Text
xmlHttpRequestGetResponseHeader self :: XMLHttpRequest
self header :: header
header = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Text -> Text) -> m (Maybe Text) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLHttpRequest -> header -> m (Maybe Text)
forall (m :: * -> *) name result.
(MonadDOM m, ToJSString name, FromJSString result) =>
XMLHttpRequest -> name -> m (Maybe result)
getResponseHeader XMLHttpRequest
self header
header

xmlHttpRequestOverrideMimeType :: (ToJSString override, MonadJSM m) => XMLHttpRequest -> override -> m ()
xmlHttpRequestOverrideMimeType :: XMLHttpRequest -> override -> m ()
xmlHttpRequestOverrideMimeType = XMLHttpRequest -> override -> m ()
forall (m :: * -> *) str.
(MonadDOM m, ToJSString str) =>
XMLHttpRequest -> str -> m ()
overrideMimeType

xmlHttpRequestDispatchEvent :: (IsEvent evt, MonadJSM m) => XMLHttpRequest -> evt -> m Bool
xmlHttpRequestDispatchEvent :: XMLHttpRequest -> evt -> m Bool
xmlHttpRequestDispatchEvent = XMLHttpRequest -> evt -> m Bool
forall (m :: * -> *) self event.
(MonadDOM m, IsEventTarget self, IsEvent event) =>
self -> event -> m Bool
dispatchEvent

xmlHttpRequestOnabort :: XMLHttpRequest -> EventM XMLHttpRequest XMLHttpRequestProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnabort :: XMLHttpRequest
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
xmlHttpRequestOnabort = (XMLHttpRequest
-> EventName XMLHttpRequest XMLHttpRequestProgressEvent
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest XMLHttpRequestProgressEvent
forall self.
(IsXMLHttpRequestEventTarget self, IsEventTarget self) =>
EventName self XMLHttpRequestProgressEvent
abortEvent)

xmlHttpRequestOnerror :: XMLHttpRequest -> EventM XMLHttpRequest XMLHttpRequestProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnerror :: XMLHttpRequest
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
xmlHttpRequestOnerror = (XMLHttpRequest
-> EventName XMLHttpRequest XMLHttpRequestProgressEvent
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest XMLHttpRequestProgressEvent
forall self.
(IsXMLHttpRequestEventTarget self, IsEventTarget self) =>
EventName self XMLHttpRequestProgressEvent
error)

xmlHttpRequestOnload :: XMLHttpRequest -> EventM XMLHttpRequest XMLHttpRequestProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnload :: XMLHttpRequest
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
xmlHttpRequestOnload = (XMLHttpRequest
-> EventName XMLHttpRequest XMLHttpRequestProgressEvent
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest XMLHttpRequestProgressEvent
forall self.
(IsXMLHttpRequestEventTarget self, IsEventTarget self) =>
EventName self XMLHttpRequestProgressEvent
load)

xmlHttpRequestOnloadend :: XMLHttpRequest -> EventM XMLHttpRequest ProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnloadend :: XMLHttpRequest
-> EventM XMLHttpRequest ProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnloadend = (XMLHttpRequest
-> EventName XMLHttpRequest ProgressEvent
-> EventM XMLHttpRequest ProgressEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest ProgressEvent
forall self.
(IsXMLHttpRequestEventTarget self, IsEventTarget self) =>
EventName self ProgressEvent
loadEnd)

xmlHttpRequestOnloadstart :: XMLHttpRequest -> EventM XMLHttpRequest ProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnloadstart :: XMLHttpRequest
-> EventM XMLHttpRequest ProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnloadstart = (XMLHttpRequest
-> EventName XMLHttpRequest ProgressEvent
-> EventM XMLHttpRequest ProgressEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest ProgressEvent
forall self.
(IsXMLHttpRequestEventTarget self, IsEventTarget self) =>
EventName self ProgressEvent
loadStart)

xmlHttpRequestOnprogress :: XMLHttpRequest -> EventM XMLHttpRequest XMLHttpRequestProgressEvent () -> JSM (JSM ())
xmlHttpRequestOnprogress :: XMLHttpRequest
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
xmlHttpRequestOnprogress = (XMLHttpRequest
-> EventName XMLHttpRequest XMLHttpRequestProgressEvent
-> EventM XMLHttpRequest XMLHttpRequestProgressEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest XMLHttpRequestProgressEvent
forall self.
(IsXMLHttpRequestEventTarget self, IsEventTarget self) =>
EventName self XMLHttpRequestProgressEvent
progress)

xmlHttpRequestOntimeout :: XMLHttpRequest -> EventM XMLHttpRequest ProgressEvent () -> JSM (JSM ())
xmlHttpRequestOntimeout :: XMLHttpRequest
-> EventM XMLHttpRequest ProgressEvent () -> JSM (JSM ())
xmlHttpRequestOntimeout = (XMLHttpRequest
-> EventName XMLHttpRequest ProgressEvent
-> EventM XMLHttpRequest ProgressEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest ProgressEvent
forall self.
(IsXMLHttpRequestEventTarget self, IsEventTarget self) =>
EventName self ProgressEvent
timeout)

xmlHttpRequestOnreadystatechange :: XMLHttpRequest -> EventM XMLHttpRequest Event () -> JSM (JSM ())
xmlHttpRequestOnreadystatechange :: XMLHttpRequest -> EventM XMLHttpRequest Event () -> JSM (JSM ())
xmlHttpRequestOnreadystatechange = (XMLHttpRequest
-> EventName XMLHttpRequest Event
-> EventM XMLHttpRequest Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName XMLHttpRequest Event
readyStateChange)

xmlHttpRequestSetTimeout :: MonadJSM m => XMLHttpRequest -> Word -> m ()
xmlHttpRequestSetTimeout :: XMLHttpRequest -> Word -> m ()
xmlHttpRequestSetTimeout = XMLHttpRequest -> Word -> m ()
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> Word -> m ()
setTimeout

xmlHttpRequestGetTimeout :: MonadJSM m => XMLHttpRequest -> m Word
xmlHttpRequestGetTimeout :: XMLHttpRequest -> m Word
xmlHttpRequestGetTimeout = XMLHttpRequest -> m Word
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> m Word
getTimeout

xmlHttpRequestGetReadyState :: MonadJSM m => XMLHttpRequest -> m Word
xmlHttpRequestGetReadyState :: XMLHttpRequest -> m Word
xmlHttpRequestGetReadyState = XMLHttpRequest -> m Word
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> m Word
getReadyState

xmlHttpRequestSetWithCredentials :: MonadJSM m => XMLHttpRequest -> Bool -> m ()
xmlHttpRequestSetWithCredentials :: XMLHttpRequest -> Bool -> m ()
xmlHttpRequestSetWithCredentials = XMLHttpRequest -> Bool -> m ()
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> Bool -> m ()
setWithCredentials

xmlHttpRequestGetWithCredentials :: MonadJSM m => XMLHttpRequest -> m Bool
xmlHttpRequestGetWithCredentials :: XMLHttpRequest -> m Bool
xmlHttpRequestGetWithCredentials = XMLHttpRequest -> m Bool
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> m Bool
getWithCredentials

xmlHttpRequestGetUpload :: MonadJSM m => XMLHttpRequest -> m (Maybe XMLHttpRequestUpload)
xmlHttpRequestGetUpload :: XMLHttpRequest -> m (Maybe XMLHttpRequestUpload)
xmlHttpRequestGetUpload = (XMLHttpRequestUpload -> Maybe XMLHttpRequestUpload)
-> m XMLHttpRequestUpload -> m (Maybe XMLHttpRequestUpload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XMLHttpRequestUpload -> Maybe XMLHttpRequestUpload
forall a. a -> Maybe a
Just (m XMLHttpRequestUpload -> m (Maybe XMLHttpRequestUpload))
-> (XMLHttpRequest -> m XMLHttpRequestUpload)
-> XMLHttpRequest
-> m (Maybe XMLHttpRequestUpload)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMLHttpRequest -> m XMLHttpRequestUpload
forall (m :: * -> *).
MonadDOM m =>
XMLHttpRequest -> m XMLHttpRequestUpload
getUpload

xmlHttpRequestGetResponseText :: (FromJSString result, MonadJSM m) => XMLHttpRequest -> m (Maybe result)
xmlHttpRequestGetResponseText :: XMLHttpRequest -> m (Maybe result)
xmlHttpRequestGetResponseText = XMLHttpRequest -> m (Maybe result)
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
XMLHttpRequest -> m (Maybe result)
getResponseText

xmlHttpRequestGetResponseXML :: MonadJSM m => XMLHttpRequest -> m (Maybe Document)
xmlHttpRequestGetResponseXML :: XMLHttpRequest -> m (Maybe Document)
xmlHttpRequestGetResponseXML = XMLHttpRequest -> m (Maybe Document)
forall (m :: * -> *).
MonadDOM m =>
XMLHttpRequest -> m (Maybe Document)
getResponseXML

xmlHttpRequestSetResponseType :: MonadJSM m => XMLHttpRequest -> XMLHttpRequestResponseType -> m ()
xmlHttpRequestSetResponseType :: XMLHttpRequest -> XMLHttpRequestResponseType -> m ()
xmlHttpRequestSetResponseType = XMLHttpRequest -> XMLHttpRequestResponseType -> m ()
forall (m :: * -> *).
MonadDOM m =>
XMLHttpRequest -> XMLHttpRequestResponseType -> m ()
setResponseType

fromResponseType :: XhrResponseType -> XMLHttpRequestResponseType
fromResponseType :: XhrResponseType -> XMLHttpRequestResponseType
fromResponseType XhrResponseType_Default = XMLHttpRequestResponseType
XMLHttpRequestResponseType
fromResponseType XhrResponseType_ArrayBuffer = XMLHttpRequestResponseType
XMLHttpRequestResponseTypeArraybuffer
fromResponseType XhrResponseType_Blob = XMLHttpRequestResponseType
XMLHttpRequestResponseTypeBlob
fromResponseType XhrResponseType_Text = XMLHttpRequestResponseType
XMLHttpRequestResponseTypeText

toResponseType :: XMLHttpRequestResponseType -> Maybe XhrResponseType
toResponseType :: XMLHttpRequestResponseType -> Maybe XhrResponseType
toResponseType XMLHttpRequestResponseType = XhrResponseType -> Maybe XhrResponseType
forall a. a -> Maybe a
Just XhrResponseType
XhrResponseType_Default
toResponseType XMLHttpRequestResponseTypeArraybuffer = XhrResponseType -> Maybe XhrResponseType
forall a. a -> Maybe a
Just XhrResponseType
XhrResponseType_ArrayBuffer
toResponseType XMLHttpRequestResponseTypeBlob = XhrResponseType -> Maybe XhrResponseType
forall a. a -> Maybe a
Just XhrResponseType
XhrResponseType_Blob
toResponseType XMLHttpRequestResponseTypeText = XhrResponseType -> Maybe XhrResponseType
forall a. a -> Maybe a
Just XhrResponseType
XhrResponseType_Text
toResponseType _ = Maybe XhrResponseType
forall a. Maybe a
Nothing

xmlHttpRequestGetResponseType :: MonadJSM m => XMLHttpRequest -> m (Maybe XhrResponseType)
xmlHttpRequestGetResponseType :: XMLHttpRequest -> m (Maybe XhrResponseType)
xmlHttpRequestGetResponseType = (XMLHttpRequestResponseType -> Maybe XhrResponseType)
-> m XMLHttpRequestResponseType -> m (Maybe XhrResponseType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XMLHttpRequestResponseType -> Maybe XhrResponseType
toResponseType (m XMLHttpRequestResponseType -> m (Maybe XhrResponseType))
-> (XMLHttpRequest -> m XMLHttpRequestResponseType)
-> XMLHttpRequest
-> m (Maybe XhrResponseType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMLHttpRequest -> m XMLHttpRequestResponseType
forall (m :: * -> *).
MonadDOM m =>
XMLHttpRequest -> m XMLHttpRequestResponseType
getResponseType

xmlHttpRequestGetStatus :: MonadJSM m => XMLHttpRequest -> m Word
xmlHttpRequestGetStatus :: XMLHttpRequest -> m Word
xmlHttpRequestGetStatus = XMLHttpRequest -> m Word
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> m Word
getStatus

xmlHttpRequestGetStatusText :: MonadJSM m => FromJSString result => XMLHttpRequest -> m result
xmlHttpRequestGetStatusText :: XMLHttpRequest -> m result
xmlHttpRequestGetStatusText = XMLHttpRequest -> m result
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
XMLHttpRequest -> m result
getStatusText

xmlHttpRequestGetResponseURL :: (FromJSString result, MonadJSM m) => XMLHttpRequest -> m result
xmlHttpRequestGetResponseURL :: XMLHttpRequest -> m result
xmlHttpRequestGetResponseURL = XMLHttpRequest -> m result
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
XMLHttpRequest -> m result
getResponseURL

xmlHttpRequestGetResponse :: MonadJSM m => XMLHttpRequest -> m (Maybe XhrResponseBody)
xmlHttpRequestGetResponse :: XMLHttpRequest -> m (Maybe XhrResponseBody)
xmlHttpRequestGetResponse xhr :: XMLHttpRequest
xhr = do
  JSVal
mr <- XMLHttpRequest -> m JSVal
forall (m :: * -> *). MonadDOM m => XMLHttpRequest -> m JSVal
getResponse XMLHttpRequest
xhr
  Maybe XhrResponseType
rt <- XMLHttpRequest -> m (Maybe XhrResponseType)
forall (m :: * -> *).
MonadJSM m =>
XMLHttpRequest -> m (Maybe XhrResponseType)
xmlHttpRequestGetResponseType XMLHttpRequest
xhr
  case Maybe XhrResponseType
rt of
       Just XhrResponseType_Blob -> (Blob -> XhrResponseBody) -> Maybe Blob -> Maybe XhrResponseBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Blob -> XhrResponseBody
XhrResponseBody_Blob (Maybe Blob -> Maybe XhrResponseBody)
-> m (Maybe Blob) -> m (Maybe XhrResponseBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSVal -> Blob) -> JSVal -> m (Maybe Blob)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
castTo JSVal -> Blob
Blob JSVal
mr
       Just XhrResponseType_Text -> XhrResponseBody -> Maybe XhrResponseBody
forall a. a -> Maybe a
Just (XhrResponseBody -> Maybe XhrResponseBody)
-> (Text -> XhrResponseBody) -> Text -> Maybe XhrResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XhrResponseBody
XhrResponseBody_Text (Text -> Maybe XhrResponseBody)
-> m Text -> m (Maybe XhrResponseBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLHttpRequest -> m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
XMLHttpRequest -> m result
xmlHttpRequestGetStatusText XMLHttpRequest
xhr
       Just XhrResponseType_Default -> XhrResponseBody -> Maybe XhrResponseBody
forall a. a -> Maybe a
Just (XhrResponseBody -> Maybe XhrResponseBody)
-> (Text -> XhrResponseBody) -> Text -> Maybe XhrResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XhrResponseBody
XhrResponseBody_Text (Text -> Maybe XhrResponseBody)
-> m Text -> m (Maybe XhrResponseBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLHttpRequest -> m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
XMLHttpRequest -> m result
xmlHttpRequestGetStatusText XMLHttpRequest
xhr
       Just XhrResponseType_ArrayBuffer -> do
           MutableArrayBuffer
ab <- JSM MutableArrayBuffer -> m MutableArrayBuffer
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM MutableArrayBuffer -> m MutableArrayBuffer)
-> JSM MutableArrayBuffer -> m MutableArrayBuffer
forall a b. (a -> b) -> a -> b
$ JSVal -> JSM MutableArrayBuffer
mutableArrayBufferFromJSVal JSVal
mr
           XhrResponseBody -> Maybe XhrResponseBody
forall a. a -> Maybe a
Just (XhrResponseBody -> Maybe XhrResponseBody)
-> (ByteString -> XhrResponseBody)
-> ByteString
-> Maybe XhrResponseBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> XhrResponseBody
XhrResponseBody_ArrayBuffer (ByteString -> Maybe XhrResponseBody)
-> m ByteString -> m (Maybe XhrResponseBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArrayBuffer -> m ByteString
forall (m :: * -> *).
MonadJSM m =>
MutableArrayBuffer -> m ByteString
bsFromMutableArrayBuffer MutableArrayBuffer
ab
       _ -> Maybe XhrResponseBody -> m (Maybe XhrResponseBody)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe XhrResponseBody
forall a. Maybe a
Nothing