{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
#ifdef USE_TEMPLATE_HASKELL
{-# LANGUAGE TemplateHaskell #-}
#endif

-- | A module for performing asynchronous HTTP calls from JavaScript
-- using the
-- <https://developer.mozilla.org/en-US/docs/Web/API/XMLHttpRequest XMLHttpRequest>
-- API (essentially AJAX). Despite the name, there is nothing whatsoever specific to XML.
--
-- The API has two components:
--
--  * convenient functions for common usecases like GET and POST
--    requests to APIs using JSON.
--
--  * a flexible set of functions for creating and executing arbitrary
--    requests and handling responses.
--
module Reflex.Dom.Xhr
  ( -- * Common Patterns

    -- | Functions that conveniently expose common uses like GET and
    -- POST to JSON APIs.
    getAndDecode
  , getMay
  , postJson

  , decodeXhrResponse
  , decodeText

  -- * General Request API

  -- | This is the most general flow for sending XHR requests:
  --
  --   1. Create an 'Event' stream of 'XhrRequest' records (ie
  --   @Event t (XhrRequest a)@). The records configure the request,
  --   and the 'Event' controls when the request or requests are
  --   actually sent.
  --
  --   2. Plug the @Event t (XhrRequest a)@ into one of the functions
  --   for performing requests like 'performRequestAsync'.
  --
  --   3. Consume the resulting stream of 'XhrResponse' events,
  --   parsing the body of the response however appropriate. A really
  --   common pattern is turning the 'Event' into a 'Dynamic' with
  --   'holdDyn' or a related function.
  --
  -- Here is an example of calling a search API whenever the user
  -- types in a text input field and printing the result on the page:
  --
  -- @
  -- url query = "http:\/\/example.com\/search?query=" \<> query
  --
  -- search queries = do
  --   responses \<- performRequestAsync $ toRequest \<$> queries
  --   return $ view xhrResponse_responseText \<$> responses
  --   where toRequest query = XhrRequest \"GET" (url query) def
  --
  -- main = mainWidget $ do
  --   input \<- textInput def
  --   let queries = updated $ input ^. textInput_value
  --   results \<- search queries
  --   asText \<- holdDyn "No results." $ pack . show \<$> results
  --   dynText asText
  -- @

  -- ** XHR Requests
  , XhrRequest (..)
  , XhrRequestConfig (..)

  , xhrRequest
  , xhrRequestConfig_headers
  , xhrRequestConfig_password
  , xhrRequestConfig_responseType
  , xhrRequestConfig_sendData
  , xhrRequestConfig_user
  , xhrRequestConfig_withCredentials
  , xhrRequestConfig_responseHeaders
  , xhrRequest_config
  , xhrRequest_method
  , xhrRequest_url

  -- ** Performing Requests
  , performMkRequestAsync
  , performMkRequestsAsync
  , performRequestAsync
  , performRequestAsyncWithError
  , performRequestsAsync
  , performRequestsAsyncWithError

  -- ** XHR Responses
  , XhrResponse (..)
  , XhrResponseBody (..)
  , XhrResponseHeaders (..)
  , XhrResponseType (..)

  , xhrResponse_response
  , xhrResponse_responseText
  , xhrResponse_status
  , xhrResponse_statusText
  , xhrResponse_headers

  -- *** Deprecated
  , xhrResponse_body
  , _xhrResponse_body

  -- ** Error Handling
  , XhrException (..)
  , IsXhrPayload (..)

  -- * JavaScript XMLHttpRequest Objects

  -- | 'XMLHttpRequest' is the type of JavaScript's underlying runtime
  -- objects that represent XHR requests.
  --
  -- Chances are you shouldn't need these in day-to-day code.
  , XMLHttpRequest

  -- ** Constructors
  , newXMLHttpRequest
  , newXMLHttpRequestWithError

  -- ** Fields
  , xmlHttpRequestGetReadyState
  , xmlHttpRequestGetResponseText
  , xmlHttpRequestGetStatus
  , xmlHttpRequestGetStatusText
  , xmlHttpRequestNew
  , xmlHttpRequestOnreadystatechange
  , xmlHttpRequestOpen
  , xmlHttpRequestSetRequestHeader
  , xmlHttpRequestSetResponseType
  )
where

import Reflex.Class
import Reflex.Dom.Class
import Reflex.PerformEvent.Class
import Reflex.TriggerEvent.Class
import Reflex.Dom.Xhr.Exception
import Reflex.Dom.Xhr.Foreign
import Reflex.Dom.Xhr.ResponseType

import Control.Concurrent
import Control.Exception (handle)
import Control.Lens
import Control.Monad hiding (forM)
import Control.Monad.IO.Class
import Data.Aeson
#if MIN_VERSION_aeson(1,0,0)
import Data.Aeson.Text
#else
import Data.Aeson.Encode
#endif
import qualified Data.ByteString.Lazy as BL
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Data.Default
import qualified Data.List as L
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as B
import Data.Traversable
import Data.Typeable

import Language.Javascript.JSaddle.Monad (JSM, askJSM, runJSM, MonadJSM, liftJSM)

data XhrRequest a
   = XhrRequest { XhrRequest a -> Text
_xhrRequest_method :: Text
                , XhrRequest a -> Text
_xhrRequest_url :: Text
                , XhrRequest a -> XhrRequestConfig a
_xhrRequest_config :: XhrRequestConfig a
                }
   deriving (Int -> XhrRequest a -> ShowS
[XhrRequest a] -> ShowS
XhrRequest a -> String
(Int -> XhrRequest a -> ShowS)
-> (XhrRequest a -> String)
-> ([XhrRequest a] -> ShowS)
-> Show (XhrRequest a)
forall a. Show a => Int -> XhrRequest a -> ShowS
forall a. Show a => [XhrRequest a] -> ShowS
forall a. Show a => XhrRequest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XhrRequest a] -> ShowS
$cshowList :: forall a. Show a => [XhrRequest a] -> ShowS
show :: XhrRequest a -> String
$cshow :: forall a. Show a => XhrRequest a -> String
showsPrec :: Int -> XhrRequest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> XhrRequest a -> ShowS
Show, ReadPrec [XhrRequest a]
ReadPrec (XhrRequest a)
Int -> ReadS (XhrRequest a)
ReadS [XhrRequest a]
(Int -> ReadS (XhrRequest a))
-> ReadS [XhrRequest a]
-> ReadPrec (XhrRequest a)
-> ReadPrec [XhrRequest a]
-> Read (XhrRequest a)
forall a. Read a => ReadPrec [XhrRequest a]
forall a. Read a => ReadPrec (XhrRequest a)
forall a. Read a => Int -> ReadS (XhrRequest a)
forall a. Read a => ReadS [XhrRequest a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XhrRequest a]
$creadListPrec :: forall a. Read a => ReadPrec [XhrRequest a]
readPrec :: ReadPrec (XhrRequest a)
$creadPrec :: forall a. Read a => ReadPrec (XhrRequest a)
readList :: ReadS [XhrRequest a]
$creadList :: forall a. Read a => ReadS [XhrRequest a]
readsPrec :: Int -> ReadS (XhrRequest a)
$creadsPrec :: forall a. Read a => Int -> ReadS (XhrRequest a)
Read, XhrRequest a -> XhrRequest a -> Bool
(XhrRequest a -> XhrRequest a -> Bool)
-> (XhrRequest a -> XhrRequest a -> Bool) -> Eq (XhrRequest a)
forall a. Eq a => XhrRequest a -> XhrRequest a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XhrRequest a -> XhrRequest a -> Bool
$c/= :: forall a. Eq a => XhrRequest a -> XhrRequest a -> Bool
== :: XhrRequest a -> XhrRequest a -> Bool
$c== :: forall a. Eq a => XhrRequest a -> XhrRequest a -> Bool
Eq, Eq (XhrRequest a)
Eq (XhrRequest a) =>
(XhrRequest a -> XhrRequest a -> Ordering)
-> (XhrRequest a -> XhrRequest a -> Bool)
-> (XhrRequest a -> XhrRequest a -> Bool)
-> (XhrRequest a -> XhrRequest a -> Bool)
-> (XhrRequest a -> XhrRequest a -> Bool)
-> (XhrRequest a -> XhrRequest a -> XhrRequest a)
-> (XhrRequest a -> XhrRequest a -> XhrRequest a)
-> Ord (XhrRequest a)
XhrRequest a -> XhrRequest a -> Bool
XhrRequest a -> XhrRequest a -> Ordering
XhrRequest a -> XhrRequest a -> XhrRequest a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (XhrRequest a)
forall a. Ord a => XhrRequest a -> XhrRequest a -> Bool
forall a. Ord a => XhrRequest a -> XhrRequest a -> Ordering
forall a. Ord a => XhrRequest a -> XhrRequest a -> XhrRequest a
min :: XhrRequest a -> XhrRequest a -> XhrRequest a
$cmin :: forall a. Ord a => XhrRequest a -> XhrRequest a -> XhrRequest a
max :: XhrRequest a -> XhrRequest a -> XhrRequest a
$cmax :: forall a. Ord a => XhrRequest a -> XhrRequest a -> XhrRequest a
>= :: XhrRequest a -> XhrRequest a -> Bool
$c>= :: forall a. Ord a => XhrRequest a -> XhrRequest a -> Bool
> :: XhrRequest a -> XhrRequest a -> Bool
$c> :: forall a. Ord a => XhrRequest a -> XhrRequest a -> Bool
<= :: XhrRequest a -> XhrRequest a -> Bool
$c<= :: forall a. Ord a => XhrRequest a -> XhrRequest a -> Bool
< :: XhrRequest a -> XhrRequest a -> Bool
$c< :: forall a. Ord a => XhrRequest a -> XhrRequest a -> Bool
compare :: XhrRequest a -> XhrRequest a -> Ordering
$ccompare :: forall a. Ord a => XhrRequest a -> XhrRequest a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (XhrRequest a)
Ord, Typeable, a -> XhrRequest b -> XhrRequest a
(a -> b) -> XhrRequest a -> XhrRequest b
(forall a b. (a -> b) -> XhrRequest a -> XhrRequest b)
-> (forall a b. a -> XhrRequest b -> XhrRequest a)
-> Functor XhrRequest
forall a b. a -> XhrRequest b -> XhrRequest a
forall a b. (a -> b) -> XhrRequest a -> XhrRequest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> XhrRequest b -> XhrRequest a
$c<$ :: forall a b. a -> XhrRequest b -> XhrRequest a
fmap :: (a -> b) -> XhrRequest a -> XhrRequest b
$cfmap :: forall a b. (a -> b) -> XhrRequest a -> XhrRequest b
Functor)

data XhrRequestConfig a
   = XhrRequestConfig { XhrRequestConfig a -> Map Text Text
_xhrRequestConfig_headers :: Map Text Text
                      , XhrRequestConfig a -> Maybe Text
_xhrRequestConfig_user :: Maybe Text
                      , XhrRequestConfig a -> Maybe Text
_xhrRequestConfig_password :: Maybe Text
                      , XhrRequestConfig a -> Maybe XhrResponseType
_xhrRequestConfig_responseType :: Maybe XhrResponseType
                      , XhrRequestConfig a -> a
_xhrRequestConfig_sendData :: a
                      , XhrRequestConfig a -> Bool
_xhrRequestConfig_withCredentials :: Bool
                      , XhrRequestConfig a -> XhrResponseHeaders
_xhrRequestConfig_responseHeaders :: XhrResponseHeaders
                      }
   deriving (Int -> XhrRequestConfig a -> ShowS
[XhrRequestConfig a] -> ShowS
XhrRequestConfig a -> String
(Int -> XhrRequestConfig a -> ShowS)
-> (XhrRequestConfig a -> String)
-> ([XhrRequestConfig a] -> ShowS)
-> Show (XhrRequestConfig a)
forall a. Show a => Int -> XhrRequestConfig a -> ShowS
forall a. Show a => [XhrRequestConfig a] -> ShowS
forall a. Show a => XhrRequestConfig a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XhrRequestConfig a] -> ShowS
$cshowList :: forall a. Show a => [XhrRequestConfig a] -> ShowS
show :: XhrRequestConfig a -> String
$cshow :: forall a. Show a => XhrRequestConfig a -> String
showsPrec :: Int -> XhrRequestConfig a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> XhrRequestConfig a -> ShowS
Show, ReadPrec [XhrRequestConfig a]
ReadPrec (XhrRequestConfig a)
Int -> ReadS (XhrRequestConfig a)
ReadS [XhrRequestConfig a]
(Int -> ReadS (XhrRequestConfig a))
-> ReadS [XhrRequestConfig a]
-> ReadPrec (XhrRequestConfig a)
-> ReadPrec [XhrRequestConfig a]
-> Read (XhrRequestConfig a)
forall a. Read a => ReadPrec [XhrRequestConfig a]
forall a. Read a => ReadPrec (XhrRequestConfig a)
forall a. Read a => Int -> ReadS (XhrRequestConfig a)
forall a. Read a => ReadS [XhrRequestConfig a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XhrRequestConfig a]
$creadListPrec :: forall a. Read a => ReadPrec [XhrRequestConfig a]
readPrec :: ReadPrec (XhrRequestConfig a)
$creadPrec :: forall a. Read a => ReadPrec (XhrRequestConfig a)
readList :: ReadS [XhrRequestConfig a]
$creadList :: forall a. Read a => ReadS [XhrRequestConfig a]
readsPrec :: Int -> ReadS (XhrRequestConfig a)
$creadsPrec :: forall a. Read a => Int -> ReadS (XhrRequestConfig a)
Read, XhrRequestConfig a -> XhrRequestConfig a -> Bool
(XhrRequestConfig a -> XhrRequestConfig a -> Bool)
-> (XhrRequestConfig a -> XhrRequestConfig a -> Bool)
-> Eq (XhrRequestConfig a)
forall a. Eq a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XhrRequestConfig a -> XhrRequestConfig a -> Bool
$c/= :: forall a. Eq a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
== :: XhrRequestConfig a -> XhrRequestConfig a -> Bool
$c== :: forall a. Eq a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
Eq, Eq (XhrRequestConfig a)
Eq (XhrRequestConfig a) =>
(XhrRequestConfig a -> XhrRequestConfig a -> Ordering)
-> (XhrRequestConfig a -> XhrRequestConfig a -> Bool)
-> (XhrRequestConfig a -> XhrRequestConfig a -> Bool)
-> (XhrRequestConfig a -> XhrRequestConfig a -> Bool)
-> (XhrRequestConfig a -> XhrRequestConfig a -> Bool)
-> (XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a)
-> (XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a)
-> Ord (XhrRequestConfig a)
XhrRequestConfig a -> XhrRequestConfig a -> Bool
XhrRequestConfig a -> XhrRequestConfig a -> Ordering
XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (XhrRequestConfig a)
forall a. Ord a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
forall a.
Ord a =>
XhrRequestConfig a -> XhrRequestConfig a -> Ordering
forall a.
Ord a =>
XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a
min :: XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a
$cmin :: forall a.
Ord a =>
XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a
max :: XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a
$cmax :: forall a.
Ord a =>
XhrRequestConfig a -> XhrRequestConfig a -> XhrRequestConfig a
>= :: XhrRequestConfig a -> XhrRequestConfig a -> Bool
$c>= :: forall a. Ord a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
> :: XhrRequestConfig a -> XhrRequestConfig a -> Bool
$c> :: forall a. Ord a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
<= :: XhrRequestConfig a -> XhrRequestConfig a -> Bool
$c<= :: forall a. Ord a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
< :: XhrRequestConfig a -> XhrRequestConfig a -> Bool
$c< :: forall a. Ord a => XhrRequestConfig a -> XhrRequestConfig a -> Bool
compare :: XhrRequestConfig a -> XhrRequestConfig a -> Ordering
$ccompare :: forall a.
Ord a =>
XhrRequestConfig a -> XhrRequestConfig a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (XhrRequestConfig a)
Ord, Typeable, a -> XhrRequestConfig b -> XhrRequestConfig a
(a -> b) -> XhrRequestConfig a -> XhrRequestConfig b
(forall a b. (a -> b) -> XhrRequestConfig a -> XhrRequestConfig b)
-> (forall a b. a -> XhrRequestConfig b -> XhrRequestConfig a)
-> Functor XhrRequestConfig
forall a b. a -> XhrRequestConfig b -> XhrRequestConfig a
forall a b. (a -> b) -> XhrRequestConfig a -> XhrRequestConfig b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> XhrRequestConfig b -> XhrRequestConfig a
$c<$ :: forall a b. a -> XhrRequestConfig b -> XhrRequestConfig a
fmap :: (a -> b) -> XhrRequestConfig a -> XhrRequestConfig b
$cfmap :: forall a b. (a -> b) -> XhrRequestConfig a -> XhrRequestConfig b
Functor)

data XhrResponse
   = XhrResponse { XhrResponse -> Word
_xhrResponse_status :: Word
                 , XhrResponse -> Text
_xhrResponse_statusText :: Text
                 , XhrResponse -> Maybe XhrResponseBody
_xhrResponse_response :: Maybe XhrResponseBody
                 , XhrResponse -> Maybe Text
_xhrResponse_responseText :: Maybe Text
                 , XhrResponse -> Map (CI Text) Text
_xhrResponse_headers :: Map (CI Text) Text
                 }
   deriving (Typeable)

data XhrResponseHeaders =
    OnlyHeaders (Set.Set (CI Text)) -- ^ Parse a subset of headers from the XHR Response
  | AllHeaders -- ^ Parse all headers from the XHR Response
  deriving (Int -> XhrResponseHeaders -> ShowS
[XhrResponseHeaders] -> ShowS
XhrResponseHeaders -> String
(Int -> XhrResponseHeaders -> ShowS)
-> (XhrResponseHeaders -> String)
-> ([XhrResponseHeaders] -> ShowS)
-> Show XhrResponseHeaders
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XhrResponseHeaders] -> ShowS
$cshowList :: [XhrResponseHeaders] -> ShowS
show :: XhrResponseHeaders -> String
$cshow :: XhrResponseHeaders -> String
showsPrec :: Int -> XhrResponseHeaders -> ShowS
$cshowsPrec :: Int -> XhrResponseHeaders -> ShowS
Show, ReadPrec [XhrResponseHeaders]
ReadPrec XhrResponseHeaders
Int -> ReadS XhrResponseHeaders
ReadS [XhrResponseHeaders]
(Int -> ReadS XhrResponseHeaders)
-> ReadS [XhrResponseHeaders]
-> ReadPrec XhrResponseHeaders
-> ReadPrec [XhrResponseHeaders]
-> Read XhrResponseHeaders
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XhrResponseHeaders]
$creadListPrec :: ReadPrec [XhrResponseHeaders]
readPrec :: ReadPrec XhrResponseHeaders
$creadPrec :: ReadPrec XhrResponseHeaders
readList :: ReadS [XhrResponseHeaders]
$creadList :: ReadS [XhrResponseHeaders]
readsPrec :: Int -> ReadS XhrResponseHeaders
$creadsPrec :: Int -> ReadS XhrResponseHeaders
Read, XhrResponseHeaders -> XhrResponseHeaders -> Bool
(XhrResponseHeaders -> XhrResponseHeaders -> Bool)
-> (XhrResponseHeaders -> XhrResponseHeaders -> Bool)
-> Eq XhrResponseHeaders
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
$c/= :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
== :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
$c== :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
Eq, Eq XhrResponseHeaders
Eq XhrResponseHeaders =>
(XhrResponseHeaders -> XhrResponseHeaders -> Ordering)
-> (XhrResponseHeaders -> XhrResponseHeaders -> Bool)
-> (XhrResponseHeaders -> XhrResponseHeaders -> Bool)
-> (XhrResponseHeaders -> XhrResponseHeaders -> Bool)
-> (XhrResponseHeaders -> XhrResponseHeaders -> Bool)
-> (XhrResponseHeaders -> XhrResponseHeaders -> XhrResponseHeaders)
-> (XhrResponseHeaders -> XhrResponseHeaders -> XhrResponseHeaders)
-> Ord XhrResponseHeaders
XhrResponseHeaders -> XhrResponseHeaders -> Bool
XhrResponseHeaders -> XhrResponseHeaders -> Ordering
XhrResponseHeaders -> XhrResponseHeaders -> XhrResponseHeaders
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XhrResponseHeaders -> XhrResponseHeaders -> XhrResponseHeaders
$cmin :: XhrResponseHeaders -> XhrResponseHeaders -> XhrResponseHeaders
max :: XhrResponseHeaders -> XhrResponseHeaders -> XhrResponseHeaders
$cmax :: XhrResponseHeaders -> XhrResponseHeaders -> XhrResponseHeaders
>= :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
$c>= :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
> :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
$c> :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
<= :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
$c<= :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
< :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
$c< :: XhrResponseHeaders -> XhrResponseHeaders -> Bool
compare :: XhrResponseHeaders -> XhrResponseHeaders -> Ordering
$ccompare :: XhrResponseHeaders -> XhrResponseHeaders -> Ordering
$cp1Ord :: Eq XhrResponseHeaders
Ord, Typeable)

instance Default XhrResponseHeaders where
  def :: XhrResponseHeaders
def = Set (CI Text) -> XhrResponseHeaders
OnlyHeaders Set (CI Text)
forall a. Monoid a => a
mempty

{-# DEPRECATED _xhrResponse_body "Use _xhrResponse_response or _xhrResponse_responseText instead." #-}
_xhrResponse_body :: XhrResponse -> Maybe Text
_xhrResponse_body :: XhrResponse -> Maybe Text
_xhrResponse_body = XhrResponse -> Maybe Text
_xhrResponse_responseText

{-# DEPRECATED xhrResponse_body "Use xhrResponse_response or xhrResponse_responseText instead." #-}
xhrResponse_body :: Lens' XhrResponse (Maybe Text)
xhrResponse_body :: (Maybe Text -> f (Maybe Text)) -> XhrResponse -> f XhrResponse
xhrResponse_body = (XhrResponse -> Maybe Text)
-> (XhrResponse -> Maybe Text -> XhrResponse)
-> Lens XhrResponse XhrResponse (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens XhrResponse -> Maybe Text
_xhrResponse_responseText (\r :: XhrResponse
r t :: Maybe Text
t -> XhrResponse
r { _xhrResponse_responseText :: Maybe Text
_xhrResponse_responseText = Maybe Text
t })

instance a ~ () => Default (XhrRequestConfig a) where
  def :: XhrRequestConfig a
def = XhrRequestConfig :: forall a.
Map Text Text
-> Maybe Text
-> Maybe Text
-> Maybe XhrResponseType
-> a
-> Bool
-> XhrResponseHeaders
-> XhrRequestConfig a
XhrRequestConfig { _xhrRequestConfig_headers :: Map Text Text
_xhrRequestConfig_headers = Map Text Text
forall k a. Map k a
Map.empty
                         , _xhrRequestConfig_user :: Maybe Text
_xhrRequestConfig_user = Maybe Text
forall a. Maybe a
Nothing
                         , _xhrRequestConfig_password :: Maybe Text
_xhrRequestConfig_password  = Maybe Text
forall a. Maybe a
Nothing
                         , _xhrRequestConfig_responseType :: Maybe XhrResponseType
_xhrRequestConfig_responseType  = Maybe XhrResponseType
forall a. Maybe a
Nothing
                         , _xhrRequestConfig_sendData :: a
_xhrRequestConfig_sendData  = ()
                         , _xhrRequestConfig_withCredentials :: Bool
_xhrRequestConfig_withCredentials = Bool
False
                         , _xhrRequestConfig_responseHeaders :: XhrResponseHeaders
_xhrRequestConfig_responseHeaders = XhrResponseHeaders
forall a. Default a => a
def
                         }

-- | Construct a request object from method, URL, and config record.
xhrRequest :: Text -> Text -> XhrRequestConfig a -> XhrRequest a
xhrRequest :: Text -> Text -> XhrRequestConfig a -> XhrRequest a
xhrRequest = Text -> Text -> XhrRequestConfig a -> XhrRequest a
forall a. Text -> Text -> XhrRequestConfig a -> XhrRequest a
XhrRequest

-- | Make a new asyncronous XHR request. This does not block (it forks),
-- and returns an XHR object immediately (which you can use to abort
-- the XHR connection), and will pass an exception ('XhrException') to the
-- continuation if the connection cannot be made (or is aborted).
newXMLHttpRequestWithError
    :: (HasJSContext m, MonadJSM m, IsXhrPayload a)
    => XhrRequest a
    -- ^ The request to make.
    -> (Either XhrException XhrResponse -> JSM ())
    -- ^ A continuation to be called once a response comes back, or in
    -- case of error.
    -> m XMLHttpRequest
    -- ^ The XHR request, which could for example be aborted.
newXMLHttpRequestWithError :: XhrRequest a
-> (Either XhrException XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequestWithError req :: XhrRequest a
req cb :: Either XhrException XhrResponse -> JSM ()
cb = do
  XMLHttpRequest
xhr <- m XMLHttpRequest
forall (m :: * -> *). MonadJSM m => m XMLHttpRequest
xmlHttpRequestNew
  JSContextRef
ctx <- m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId) -> IO ThreadId -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (XhrException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ())
-> (XhrException -> JSM ()) -> XhrException -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either XhrException XhrResponse -> JSM ()
cb (Either XhrException XhrResponse -> JSM ())
-> (XhrException -> Either XhrException XhrResponse)
-> XhrException
-> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XhrException -> Either XhrException XhrResponse
forall a b. a -> Either a b
Left) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> (JSM () -> IO ()) -> JSM () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> JSM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let c :: XhrRequestConfig a
c = XhrRequest a -> XhrRequestConfig a
forall a. XhrRequest a -> XhrRequestConfig a
_xhrRequest_config XhrRequest a
req
        rt :: Maybe XhrResponseType
rt = XhrRequestConfig a -> Maybe XhrResponseType
forall a. XhrRequestConfig a -> Maybe XhrResponseType
_xhrRequestConfig_responseType XhrRequestConfig a
c
        creds :: Bool
creds = XhrRequestConfig a -> Bool
forall a. XhrRequestConfig a -> Bool
_xhrRequestConfig_withCredentials XhrRequestConfig a
c
    XMLHttpRequest -> Text -> Text -> Bool -> Text -> Text -> JSM ()
forall method url user password (m :: * -> *).
(ToJSString method, ToJSString url, ToJSString user,
 ToJSString password, MonadJSM m) =>
XMLHttpRequest -> method -> url -> Bool -> user -> password -> m ()
xmlHttpRequestOpen
      XMLHttpRequest
xhr
      (XhrRequest a -> Text
forall a. XhrRequest a -> Text
_xhrRequest_method XhrRequest a
req)
      (XhrRequest a -> Text
forall a. XhrRequest a -> Text
_xhrRequest_url XhrRequest a
req)
      Bool
True
      (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ XhrRequestConfig a -> Maybe Text
forall a. XhrRequestConfig a -> Maybe Text
_xhrRequestConfig_user XhrRequestConfig a
c)
      (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ XhrRequestConfig a -> Maybe Text
forall a. XhrRequestConfig a -> Maybe Text
_xhrRequestConfig_password XhrRequestConfig a
c)
    Map Text Text -> (Text -> Text -> JSM ()) -> JSM ()
forall i (t :: * -> *) (m :: * -> *) a b.
(FoldableWithIndex i t, Monad m) =>
t a -> (i -> a -> m b) -> m ()
iforM_ (XhrRequestConfig a -> Map Text Text
forall a. XhrRequestConfig a -> Map Text Text
_xhrRequestConfig_headers XhrRequestConfig a
c) ((Text -> Text -> JSM ()) -> JSM ())
-> (Text -> Text -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ XMLHttpRequest -> Text -> Text -> JSM ()
forall header value (m :: * -> *).
(ToJSString header, ToJSString value, MonadJSM m) =>
XMLHttpRequest -> header -> value -> m ()
xmlHttpRequestSetRequestHeader XMLHttpRequest
xhr
    JSM ()
-> (XhrResponseType -> JSM ()) -> Maybe XhrResponseType -> JSM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (XMLHttpRequest -> XMLHttpRequestResponseType -> JSM ()
forall (m :: * -> *).
MonadJSM m =>
XMLHttpRequest -> XMLHttpRequestResponseType -> m ()
xmlHttpRequestSetResponseType XMLHttpRequest
xhr (XMLHttpRequestResponseType -> JSM ())
-> (XhrResponseType -> XMLHttpRequestResponseType)
-> XhrResponseType
-> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XhrResponseType -> XMLHttpRequestResponseType
fromResponseType) Maybe XhrResponseType
rt
    XMLHttpRequest -> Bool -> JSM ()
forall (m :: * -> *). MonadJSM m => XMLHttpRequest -> Bool -> m ()
xmlHttpRequestSetWithCredentials XMLHttpRequest
xhr Bool
creds
    JSM ()
_ <- XMLHttpRequest -> EventM XMLHttpRequest Event () -> JSM (JSM ())
xmlHttpRequestOnreadystatechange XMLHttpRequest
xhr (EventM XMLHttpRequest Event () -> JSM (JSM ()))
-> EventM XMLHttpRequest Event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
      Word
readyState <- XMLHttpRequest -> ReaderT Event DOM Word
forall (m :: * -> *). MonadJSM m => XMLHttpRequest -> m Word
xmlHttpRequestGetReadyState XMLHttpRequest
xhr
      Word
status <- XMLHttpRequest -> ReaderT Event DOM Word
forall (m :: * -> *). MonadJSM m => XMLHttpRequest -> m Word
xmlHttpRequestGetStatus XMLHttpRequest
xhr
      Text
statusText <- XMLHttpRequest -> ReaderT Event DOM Text
forall (m :: * -> *) result.
(MonadJSM m, FromJSString result) =>
XMLHttpRequest -> m result
xmlHttpRequestGetStatusText XMLHttpRequest
xhr
      Bool
-> EventM XMLHttpRequest Event () -> EventM XMLHttpRequest Event ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
readyState Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== 4) (EventM XMLHttpRequest Event () -> EventM XMLHttpRequest Event ())
-> EventM XMLHttpRequest Event () -> EventM XMLHttpRequest Event ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe Text
t <- if Maybe XhrResponseType
rt Maybe XhrResponseType -> Maybe XhrResponseType -> Bool
forall a. Eq a => a -> a -> Bool
== XhrResponseType -> Maybe XhrResponseType
forall a. a -> Maybe a
Just XhrResponseType
XhrResponseType_Text Bool -> Bool -> Bool
|| Maybe XhrResponseType -> Bool
forall a. Maybe a -> Bool
isNothing Maybe XhrResponseType
rt
             then XMLHttpRequest -> ReaderT Event DOM (Maybe Text)
forall result (m :: * -> *).
(FromJSString result, MonadJSM m) =>
XMLHttpRequest -> m (Maybe result)
xmlHttpRequestGetResponseText XMLHttpRequest
xhr
             else Maybe Text -> ReaderT Event DOM (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        Maybe XhrResponseBody
r <- XMLHttpRequest -> ReaderT Event DOM (Maybe XhrResponseBody)
forall (m :: * -> *).
MonadJSM m =>
XMLHttpRequest -> m (Maybe XhrResponseBody)
xmlHttpRequestGetResponse XMLHttpRequest
xhr
        Map (CI Text) Text
h <- case XhrRequestConfig a -> XhrResponseHeaders
forall a. XhrRequestConfig a -> XhrResponseHeaders
_xhrRequestConfig_responseHeaders XhrRequestConfig a
c of
          AllHeaders -> Text -> Map (CI Text) Text
parseAllHeadersString (Text -> Map (CI Text) Text)
-> ReaderT Event DOM Text -> ReaderT Event DOM (Map (CI Text) Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            XMLHttpRequest -> ReaderT Event DOM Text
forall (m :: * -> *). MonadJSM m => XMLHttpRequest -> m Text
xmlHttpRequestGetAllResponseHeaders XMLHttpRequest
xhr
          OnlyHeaders xs :: Set (CI Text)
xs -> (Text -> ReaderT Event DOM Text)
-> Map (CI Text) Text -> ReaderT Event DOM (Map (CI Text) Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (XMLHttpRequest -> Text -> ReaderT Event DOM Text
forall header (m :: * -> *).
(ToJSString header, MonadJSM m) =>
XMLHttpRequest -> header -> m Text
xmlHttpRequestGetResponseHeader XMLHttpRequest
xhr)
            ((CI Text -> Text) -> Set (CI Text) -> Map (CI Text) Text
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet CI Text -> Text
forall s. CI s -> s
CI.original Set (CI Text)
xs)
        ()
_ <- JSM () -> EventM XMLHttpRequest Event ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> EventM XMLHttpRequest Event ())
-> JSM () -> EventM XMLHttpRequest Event ()
forall a b. (a -> b) -> a -> b
$ Either XhrException XhrResponse -> JSM ()
cb (Either XhrException XhrResponse -> JSM ())
-> Either XhrException XhrResponse -> JSM ()
forall a b. (a -> b) -> a -> b
$ XhrResponse -> Either XhrException XhrResponse
forall a b. b -> Either a b
Right
             XhrResponse :: Word
-> Text
-> Maybe XhrResponseBody
-> Maybe Text
-> Map (CI Text) Text
-> XhrResponse
XhrResponse { _xhrResponse_status :: Word
_xhrResponse_status = Word
status
                         , _xhrResponse_statusText :: Text
_xhrResponse_statusText = Text
statusText
                         , _xhrResponse_response :: Maybe XhrResponseBody
_xhrResponse_response = Maybe XhrResponseBody
r
                         , _xhrResponse_responseText :: Maybe Text
_xhrResponse_responseText = Maybe Text
t
                         , _xhrResponse_headers :: Map (CI Text) Text
_xhrResponse_headers = Map (CI Text) Text
h
                         }
        () -> EventM XMLHttpRequest Event ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ()
_ <- XMLHttpRequest -> a -> JSM ()
forall payload.
IsXhrPayload payload =>
XMLHttpRequest -> payload -> JSM ()
xmlHttpRequestSend XMLHttpRequest
xhr (XhrRequestConfig a -> a
forall a. XhrRequestConfig a -> a
_xhrRequestConfig_sendData XhrRequestConfig a
c)
    () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  XMLHttpRequest -> m XMLHttpRequest
forall (m :: * -> *) a. Monad m => a -> m a
return XMLHttpRequest
xhr

parseAllHeadersString :: Text -> Map (CI Text) Text
parseAllHeadersString :: Text -> Map (CI Text) Text
parseAllHeadersString s :: Text
s = [(CI Text, Text)] -> Map (CI Text) Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(CI Text, Text)] -> Map (CI Text) Text)
-> [(CI Text, Text)] -> Map (CI Text) Text
forall a b. (a -> b) -> a -> b
$ (Text -> (CI Text, Text)) -> [Text] -> [(CI Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text, Text) -> (CI Text, Text)
stripBoth ((Text, Text) -> (CI Text, Text))
-> (Text -> (Text, Text)) -> Text -> (CI Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=':')) ([Text] -> [(CI Text, Text)]) -> [Text] -> [(CI Text, Text)]
forall a b. (a -> b) -> a -> b
$
  (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Text -> Bool
T.null ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn (String -> Text
T.pack "\r\n") Text
s
  where stripBoth :: (Text, Text) -> (CI Text, Text)
stripBoth (txt1 :: Text
txt1, txt2 :: Text
txt2) = (Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> Text -> CI Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
txt1, Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop 1 Text
txt2)

newXMLHttpRequest :: (HasJSContext m, MonadJSM m, IsXhrPayload a) => XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequest :: XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequest req :: XhrRequest a
req cb :: XhrResponse -> JSM ()
cb = XhrRequest a
-> (Either XhrException XhrResponse -> JSM ()) -> m XMLHttpRequest
forall (m :: * -> *) a.
(HasJSContext m, MonadJSM m, IsXhrPayload a) =>
XhrRequest a
-> (Either XhrException XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequestWithError XhrRequest a
req ((Either XhrException XhrResponse -> JSM ()) -> m XMLHttpRequest)
-> (Either XhrException XhrResponse -> JSM ()) -> m XMLHttpRequest
forall a b. (a -> b) -> a -> b
$ (XhrResponse -> JSM ())
-> Either XhrException XhrResponse -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ XhrResponse -> JSM ()
cb

-- | Given Event of requests, issue them when the Event fires.
-- Returns Event of corresponding responses.
--
-- The request is processed asynchronously, therefore handling does
-- not block or cause a delay while creating the connection.
performRequestAsyncWithError
    :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a)
    => Event t (XhrRequest a)
    -> m (Event t (Either XhrException XhrResponse))
performRequestAsyncWithError :: Event t (XhrRequest a)
-> m (Event t (Either XhrException XhrResponse))
performRequestAsyncWithError = (XhrRequest a
 -> (Either XhrException XhrResponse -> JSM ())
 -> Performable m XMLHttpRequest)
-> Event t (Performable m (XhrRequest a))
-> m (Event t (Either XhrException XhrResponse))
forall (m :: * -> *) t p a.
(MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m) =>
(XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (XhrRequest p)) -> m (Event t a)
performRequestAsync' XhrRequest a
-> (Either XhrException XhrResponse -> JSM ())
-> Performable m XMLHttpRequest
forall (m :: * -> *) a.
(HasJSContext m, MonadJSM m, IsXhrPayload a) =>
XhrRequest a
-> (Either XhrException XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequestWithError (Event t (Performable m (XhrRequest a))
 -> m (Event t (Either XhrException XhrResponse)))
-> (Event t (XhrRequest a)
    -> Event t (Performable m (XhrRequest a)))
-> Event t (XhrRequest a)
-> m (Event t (Either XhrException XhrResponse))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XhrRequest a -> Performable m (XhrRequest a))
-> Event t (XhrRequest a) -> Event t (Performable m (XhrRequest a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XhrRequest a -> Performable m (XhrRequest a)
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Given Event of request, issue them when the Event fires.  Returns Event of corresponding response.
performRequestAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a) => Event t (XhrRequest a) -> m (Event t XhrResponse)
performRequestAsync :: Event t (XhrRequest a) -> m (Event t XhrResponse)
performRequestAsync = (XhrRequest a
 -> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (XhrRequest a))
-> m (Event t XhrResponse)
forall (m :: * -> *) t p a.
(MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m) =>
(XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (XhrRequest p)) -> m (Event t a)
performRequestAsync' XhrRequest a
-> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest
forall (m :: * -> *) a.
(HasJSContext m, MonadJSM m, IsXhrPayload a) =>
XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequest (Event t (Performable m (XhrRequest a)) -> m (Event t XhrResponse))
-> (Event t (XhrRequest a)
    -> Event t (Performable m (XhrRequest a)))
-> Event t (XhrRequest a)
-> m (Event t XhrResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XhrRequest a -> Performable m (XhrRequest a))
-> Event t (XhrRequest a) -> Event t (Performable m (XhrRequest a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XhrRequest a -> Performable m (XhrRequest a)
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Given Event with an action that creates a request, build and issue the request when the Event fires.  Returns Event of corresponding response.
performMkRequestAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, IsXhrPayload a) => Event t (Performable m (XhrRequest a)) -> m (Event t XhrResponse)
performMkRequestAsync :: Event t (Performable m (XhrRequest a)) -> m (Event t XhrResponse)
performMkRequestAsync = (XhrRequest a
 -> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (XhrRequest a))
-> m (Event t XhrResponse)
forall (m :: * -> *) t p a.
(MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m) =>
(XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (XhrRequest p)) -> m (Event t a)
performRequestAsync' XhrRequest a
-> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest
forall (m :: * -> *) a.
(HasJSContext m, MonadJSM m, IsXhrPayload a) =>
XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequest

performRequestAsync' :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m) => (XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest) -> Event t (Performable m (XhrRequest p)) -> m (Event t a)
performRequestAsync' :: (XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (XhrRequest p)) -> m (Event t a)
performRequestAsync' newXhr :: XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest
newXhr req :: Event t (Performable m (XhrRequest p))
req = Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
performEventAsync (Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a))
-> Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ Event t (Performable m (XhrRequest p))
-> (Performable m (XhrRequest p)
    -> (a -> IO ()) -> Performable m ())
-> Event t ((a -> IO ()) -> Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Performable m (XhrRequest p))
req ((Performable m (XhrRequest p) -> (a -> IO ()) -> Performable m ())
 -> Event t ((a -> IO ()) -> Performable m ()))
-> (Performable m (XhrRequest p)
    -> (a -> IO ()) -> Performable m ())
-> Event t ((a -> IO ()) -> Performable m ())
forall a b. (a -> b) -> a -> b
$ \hr :: Performable m (XhrRequest p)
hr cb :: a -> IO ()
cb -> do
  XhrRequest p
r <- Performable m (XhrRequest p)
hr
  XMLHttpRequest
_ <- XhrRequest p -> (a -> JSM ()) -> Performable m XMLHttpRequest
newXhr XhrRequest p
r ((a -> JSM ()) -> Performable m XMLHttpRequest)
-> (a -> JSM ()) -> Performable m XMLHttpRequest
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (a -> IO ()) -> a -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
cb
  () -> Performable m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Issues a collection of requests when the supplied Event fires.
-- When ALL requests from a given firing complete, the results are
-- collected and returned via the return Event.
--
-- The requests are processed asynchronously, therefore handling does
-- not block or cause a delay while creating the connection.
--
-- Order of request execution and completion is not guaranteed, but
-- order of creation and the collection result is preserved.
performRequestsAsyncWithError
    :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a)
    => Event t (f (XhrRequest a)) -> m (Event t (f (Either XhrException XhrResponse)))
performRequestsAsyncWithError :: Event t (f (XhrRequest a))
-> m (Event t (f (Either XhrException XhrResponse)))
performRequestsAsyncWithError = (XhrRequest a
 -> (Either XhrException XhrResponse -> JSM ())
 -> Performable m XMLHttpRequest)
-> Event t (Performable m (f (XhrRequest a)))
-> m (Event t (f (Either XhrException XhrResponse)))
forall (m :: * -> *) t (f :: * -> *) b a.
(MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m,
 Traversable f) =>
(XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (f (XhrRequest b))) -> m (Event t (f a))
performRequestsAsync' XhrRequest a
-> (Either XhrException XhrResponse -> JSM ())
-> Performable m XMLHttpRequest
forall (m :: * -> *) a.
(HasJSContext m, MonadJSM m, IsXhrPayload a) =>
XhrRequest a
-> (Either XhrException XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequestWithError (Event t (Performable m (f (XhrRequest a)))
 -> m (Event t (f (Either XhrException XhrResponse))))
-> (Event t (f (XhrRequest a))
    -> Event t (Performable m (f (XhrRequest a))))
-> Event t (f (XhrRequest a))
-> m (Event t (f (Either XhrException XhrResponse)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (XhrRequest a) -> Performable m (f (XhrRequest a)))
-> Event t (f (XhrRequest a))
-> Event t (Performable m (f (XhrRequest a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (XhrRequest a) -> Performable m (f (XhrRequest a))
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Issues a collection of requests when the supplied Event fires.  When ALL requests from a given firing complete, the results are collected and returned via the return Event.
performRequestsAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a) => Event t (f (XhrRequest a)) -> m (Event t (f XhrResponse))
performRequestsAsync :: Event t (f (XhrRequest a)) -> m (Event t (f XhrResponse))
performRequestsAsync = (XhrRequest a
 -> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (f (XhrRequest a)))
-> m (Event t (f XhrResponse))
forall (m :: * -> *) t (f :: * -> *) b a.
(MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m,
 Traversable f) =>
(XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (f (XhrRequest b))) -> m (Event t (f a))
performRequestsAsync' XhrRequest a
-> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest
forall (m :: * -> *) a.
(HasJSContext m, MonadJSM m, IsXhrPayload a) =>
XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequest (Event t (Performable m (f (XhrRequest a)))
 -> m (Event t (f XhrResponse)))
-> (Event t (f (XhrRequest a))
    -> Event t (Performable m (f (XhrRequest a))))
-> Event t (f (XhrRequest a))
-> m (Event t (f XhrResponse))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (XhrRequest a) -> Performable m (f (XhrRequest a)))
-> Event t (f (XhrRequest a))
-> Event t (Performable m (f (XhrRequest a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (XhrRequest a) -> Performable m (f (XhrRequest a))
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Builds and issues a collection of requests when the supplied Event fires.  When ALL requests from a given firing complete, the results are collected and returned via the return Event.
performMkRequestsAsync :: (MonadJSM (Performable m), HasJSContext (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, IsXhrPayload a) => Event t (Performable m (f (XhrRequest a))) -> m (Event t (f XhrResponse))
performMkRequestsAsync :: Event t (Performable m (f (XhrRequest a)))
-> m (Event t (f XhrResponse))
performMkRequestsAsync = (XhrRequest a
 -> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (f (XhrRequest a)))
-> m (Event t (f XhrResponse))
forall (m :: * -> *) t (f :: * -> *) b a.
(MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m,
 Traversable f) =>
(XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (f (XhrRequest b))) -> m (Event t (f a))
performRequestsAsync' XhrRequest a
-> (XhrResponse -> JSM ()) -> Performable m XMLHttpRequest
forall (m :: * -> *) a.
(HasJSContext m, MonadJSM m, IsXhrPayload a) =>
XhrRequest a -> (XhrResponse -> JSM ()) -> m XMLHttpRequest
newXMLHttpRequest

performRequestsAsync' :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f) => (XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest) -> Event t (Performable m (f (XhrRequest b))) -> m (Event t (f a))
performRequestsAsync' :: (XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)
-> Event t (Performable m (f (XhrRequest b))) -> m (Event t (f a))
performRequestsAsync' newXhr :: XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest
newXhr req :: Event t (Performable m (f (XhrRequest b)))
req = Event t ((f a -> IO ()) -> Performable m ()) -> m (Event t (f a))
forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
performEventAsync (Event t ((f a -> IO ()) -> Performable m ()) -> m (Event t (f a)))
-> Event t ((f a -> IO ()) -> Performable m ())
-> m (Event t (f a))
forall a b. (a -> b) -> a -> b
$ Event t (Performable m (f (XhrRequest b)))
-> (Performable m (f (XhrRequest b))
    -> (f a -> IO ()) -> Performable m ())
-> Event t ((f a -> IO ()) -> Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Performable m (f (XhrRequest b)))
req ((Performable m (f (XhrRequest b))
  -> (f a -> IO ()) -> Performable m ())
 -> Event t ((f a -> IO ()) -> Performable m ()))
-> (Performable m (f (XhrRequest b))
    -> (f a -> IO ()) -> Performable m ())
-> Event t ((f a -> IO ()) -> Performable m ())
forall a b. (a -> b) -> a -> b
$ \hrs :: Performable m (f (XhrRequest b))
hrs cb :: f a -> IO ()
cb -> do
  f (XhrRequest b)
rs <- Performable m (f (XhrRequest b))
hrs
  f (MVar a)
resps <- f (XhrRequest b)
-> (XhrRequest b -> Performable m (MVar a))
-> Performable m (f (MVar a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM f (XhrRequest b)
rs ((XhrRequest b -> Performable m (MVar a))
 -> Performable m (f (MVar a)))
-> (XhrRequest b -> Performable m (MVar a))
-> Performable m (f (MVar a))
forall a b. (a -> b) -> a -> b
$ \r :: XhrRequest b
r -> do
    MVar a
resp <- IO (MVar a) -> Performable m (MVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
    XMLHttpRequest
_ <- XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest
newXhr XhrRequest b
r ((a -> JSM ()) -> Performable m XMLHttpRequest)
-> (a -> JSM ()) -> Performable m XMLHttpRequest
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (a -> IO ()) -> a -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
resp
    MVar a -> Performable m (MVar a)
forall (m :: * -> *) a. Monad m => a -> m a
return MVar a
resp
  ThreadId
_ <- IO ThreadId -> Performable m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> Performable m ThreadId)
-> IO ThreadId -> Performable m ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ f a -> IO ()
cb (f a -> IO ()) -> IO (f a) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< f (MVar a) -> (MVar a -> IO a) -> IO (f a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM f (MVar a)
resps MVar a -> IO a
forall a. MVar a -> IO a
takeMVar
  () -> Performable m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Simplified interface to "GET" URLs and return decoded results.
getAndDecode :: (MonadIO m, MonadJSM (Performable m), PerformEvent t m, HasJSContext (Performable m), TriggerEvent t m, FromJSON a) => Event t Text -> m (Event t (Maybe a))
getAndDecode :: Event t Text -> m (Event t (Maybe a))
getAndDecode url :: Event t Text
url = do
  Event t XhrResponse
r <- Event t (XhrRequest ()) -> m (Event t XhrResponse)
forall (m :: * -> *) t a.
(MonadJSM (Performable m), HasJSContext (Performable m),
 PerformEvent t m, TriggerEvent t m, IsXhrPayload a) =>
Event t (XhrRequest a) -> m (Event t XhrResponse)
performRequestAsync (Event t (XhrRequest ()) -> m (Event t XhrResponse))
-> Event t (XhrRequest ()) -> m (Event t XhrResponse)
forall a b. (a -> b) -> a -> b
$ (Text -> XhrRequest ()) -> Event t Text -> Event t (XhrRequest ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: Text
x -> Text -> Text -> XhrRequestConfig () -> XhrRequest ()
forall a. Text -> Text -> XhrRequestConfig a -> XhrRequest a
XhrRequest "GET" Text
x XhrRequestConfig ()
forall a. Default a => a
def) Event t Text
url
  Event t (Maybe a) -> m (Event t (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t (Maybe a) -> m (Event t (Maybe a)))
-> Event t (Maybe a) -> m (Event t (Maybe a))
forall a b. (a -> b) -> a -> b
$ (XhrResponse -> Maybe a)
-> Event t XhrResponse -> Event t (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XhrResponse -> Maybe a
forall a. FromJSON a => XhrResponse -> Maybe a
decodeXhrResponse Event t XhrResponse
r

-- | Create a "POST" request from an URL and thing with a JSON representation
postJson :: (ToJSON a) => Text -> a -> XhrRequest Text
postJson :: Text -> a -> XhrRequest Text
postJson url :: Text
url a :: a
a =
  Text -> Text -> XhrRequestConfig Text -> XhrRequest Text
forall a. Text -> Text -> XhrRequestConfig a -> XhrRequest a
XhrRequest "POST" Text
url (XhrRequestConfig Text -> XhrRequest Text)
-> XhrRequestConfig Text -> XhrRequest Text
forall a b. (a -> b) -> a -> b
$ XhrRequestConfig ()
forall a. Default a => a
def { _xhrRequestConfig_headers :: Map Text Text
_xhrRequestConfig_headers = Map Text Text
headerUrlEnc
                              , _xhrRequestConfig_sendData :: Text
_xhrRequestConfig_sendData = Text
body
                              }
  where headerUrlEnc :: Map Text Text
headerUrlEnc = "Content-type" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: "application/json"
        body :: Text
body = Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
B.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToTextBuilder (Value -> Builder) -> Value -> Builder
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a

getMay :: (Monad m, Reflex t) => (Event t a -> m (Event t b)) -> Event t (Maybe a) -> m (Event t (Maybe b))
getMay :: (Event t a -> m (Event t b))
-> Event t (Maybe a) -> m (Event t (Maybe b))
getMay f :: Event t a -> m (Event t b)
f e :: Event t (Maybe a)
e = do
    Event t b
e' <- Event t a -> m (Event t b)
f ((Maybe a -> Maybe a) -> Event t (Maybe a) -> Event t a
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe a -> Maybe a
forall a. a -> a
id Event t (Maybe a)
e)
    Event t (Maybe b) -> m (Event t (Maybe b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t (Maybe b) -> m (Event t (Maybe b)))
-> Event t (Maybe b) -> m (Event t (Maybe b))
forall a b. (a -> b) -> a -> b
$ [Event t (Maybe b)] -> Event t (Maybe b)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [(b -> Maybe b) -> Event t b -> Event t (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just Event t b
e', (Maybe a -> Maybe (Maybe b))
-> Event t (Maybe a) -> Event t (Maybe b)
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe (Maybe (Maybe b)
-> (a -> Maybe (Maybe b)) -> Maybe a -> Maybe (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> Maybe (Maybe b)
forall a. a -> Maybe a
Just Maybe b
forall a. Maybe a
Nothing) (Maybe (Maybe b) -> a -> Maybe (Maybe b)
forall a b. a -> b -> a
const Maybe (Maybe b)
forall a. Maybe a
Nothing)) Event t (Maybe a)
e]

decodeText :: FromJSON a => Text -> Maybe a
decodeText :: Text -> Maybe a
decodeText = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe a) -> (Text -> ByteString) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Convenience function to decode JSON-encoded responses.
decodeXhrResponse :: FromJSON a => XhrResponse -> Maybe a
decodeXhrResponse :: XhrResponse -> Maybe a
decodeXhrResponse = Text -> Maybe a
forall a. FromJSON a => Text -> Maybe a
decodeText (Text -> Maybe a)
-> (XhrResponse -> Maybe Text) -> XhrResponse -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< XhrResponse -> Maybe Text
_xhrResponse_responseText

#ifdef USE_TEMPLATE_HASKELL
concat <$> mapM makeLenses
  [ ''XhrRequest
  , ''XhrRequestConfig
  , ''XhrResponse
  ]
#else

xhrRequest_method :: Lens' (XhrRequest a) Text
xhrRequest_method f (XhrRequest x1 x2 x3) = (\y -> XhrRequest y x2 x3) <$> f x1
{-# INLINE xhrRequest_method #-}

xhrRequest_url :: Lens' (XhrRequest a) Text
xhrRequest_url f (XhrRequest x1 x2 x3) = (\y -> XhrRequest x1 y x3) <$> f x2
{-# INLINE xhrRequest_url #-}

xhrRequest_config :: Lens' (XhrRequest a) (XhrRequestConfig a)
xhrRequest_config f (XhrRequest x1 x2 x3) = (\y -> XhrRequest x1 x2 y) <$> f x3
{-# INLINE xhrRequest_config #-}

xhrRequestConfig_headers :: Lens' (XhrRequestConfig a) (Map Text Text)
xhrRequestConfig_headers f (XhrRequestConfig x1 x2 x3 x4 x5 x6 x7) = (\y -> XhrRequestConfig y x2 x3 x4 x5 x6 x7) <$> f x1
{-# INLINE xhrRequestConfig_headers #-}

xhrRequestConfig_user :: Lens' (XhrRequestConfig a) (Maybe Text)
xhrRequestConfig_user f (XhrRequestConfig x1 x2 x3 x4 x5 x6 x7) = (\y -> XhrRequestConfig x1 y x3 x4 x5 x6 x7) <$> f x2
{-# INLINE xhrRequestConfig_user #-}

xhrRequestConfig_password :: Lens' (XhrRequestConfig a) (Maybe Text)
xhrRequestConfig_password f (XhrRequestConfig x1 x2 x3 x4 x5 x6 x7) = (\y -> XhrRequestConfig x1 x2 y x4 x5 x6 x7) <$> f x3
{-# INLINE xhrRequestConfig_password #-}

xhrRequestConfig_responseType :: Lens' (XhrRequestConfig a) (Maybe XhrResponseType)
xhrRequestConfig_responseType f (XhrRequestConfig x1 x2 x3 x4 x5 x6 x7) = (\y -> XhrRequestConfig x1 x2 x3 y x5 x6 x7) <$> f x4
{-# INLINE xhrRequestConfig_responseType #-}

xhrRequestConfig_sendData :: Lens (XhrRequestConfig a) (XhrRequestConfig b) a b
xhrRequestConfig_sendData f (XhrRequestConfig x1 x2 x3 x4 x5 x6 x7) = (\y -> XhrRequestConfig x1 x2 x3 x4 y x6 x7) <$> f x5
{-# INLINE xhrRequestConfig_sendData #-}

xhrRequestConfig_withCredentials :: Lens' (XhrRequestConfig a) Bool
xhrRequestConfig_withCredentials f (XhrRequestConfig x1 x2 x3 x4 x5 x6 x7) = (\y -> XhrRequestConfig x1 x2 x3 x4 x5 y x7) <$> f x6
{-# INLINE xhrRequestConfig_withCredentials #-}

xhrRequestConfig_responseHeaders :: Lens' (XhrRequestConfig a) XhrResponseHeaders
xhrRequestConfig_responseHeaders f (XhrRequestConfig x1 x2 x3 x4 x5 x6 x7) = (\y -> XhrRequestConfig x1 x2 x3 x4 x5 x6 y) <$> f x7
{-# INLINE xhrRequestConfig_responseHeaders #-}

xhrResponse_status :: Lens' XhrResponse Word
xhrResponse_status f (XhrResponse x1 x2 x3 x4 x5) = (\y -> XhrResponse y x2 x3 x4 x5) <$> f x1
{-# INLINE xhrResponse_status #-}

xhrResponse_statusText :: Lens' XhrResponse Text
xhrResponse_statusText f (XhrResponse x1 x2 x3 x4 x5) = (\y -> XhrResponse x1 y x3 x4 x5) <$> f x2
{-# INLINE xhrResponse_statusText #-}

xhrResponse_response :: Lens' XhrResponse (Maybe XhrResponseBody)
xhrResponse_response f (XhrResponse x1 x2 x3 x4 x5) = (\y -> XhrResponse x1 x2 y x4 x5) <$> f x3
{-# INLINE xhrResponse_response #-}

xhrResponse_responseText :: Lens' XhrResponse (Maybe Text)
xhrResponse_responseText f (XhrResponse x1 x2 x3 x4 x5) = (\y -> XhrResponse x1 x2 x3 y x5) <$> f x4
{-# INLINE xhrResponse_responseText #-}

xhrResponse_headers :: Lens' XhrResponse (Map (CI Text) Text)
xhrResponse_headers f (XhrResponse x1 x2 x3 x4 x5) = (\y -> XhrResponse x1 x2 x3 x4 y) <$> f x5
{-# INLINE xhrResponse_headers #-}

#endif