@@ -27,7 +27,7 @@ import Data.Text (Text)
27import qualified Data.Text as T
27import qualified Data.Text as T
28import qualified Data.Text.Encoding as TE
28import qualified Data.Text.Encoding as TE
29import Data.Traversable (forM)
29import Data.Traversable (forM)
30−import Language.Javascript.JSaddle.Monad (JSM, MonadJSM)
30+import Language.Javascript.JSaddle.Monad (JSM, MonadJSM, liftJSM)
31import qualified Network.URI as N
31import qualified Network.URI as N
32import Reflex.Dom.Core hiding (tag)
32import Reflex.Dom.Core hiding (tag)
33import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,
33import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,
@@ -51,7 +51,7 @@ data ReqResult tag a
51 deriving (Functor)
51 deriving (Functor)
53data ClientOptions = ClientOptions
53data ClientOptions = ClientOptions
54− { optsRequestFixup :: forall a. Show a => XhrRequest a -> IO (XhrRequest a)
54+ { optsRequestFixup :: forall a. Show a => XhrRequest a -> JSM (XhrRequest a)
55 -- ^ Aribtrarily modify requests just before they are sent.
55 -- ^ Aribtrarily modify requests just before they are sent.
56 -- Warning: This escape hatch opens the possibility for your
56 -- Warning: This escape hatch opens the possibility for your
57 -- requests to diverge from what the server expects, when the
57 -- requests to diverge from what the server expects, when the
@@ -307,7 +307,7 @@ performSomeRequestsAsync opts =
307-- | A modified version or Reflex.Dom.Xhr.performRequestsAsync
307-- | A modified version or Reflex.Dom.Xhr.performRequestsAsync
308-- that accepts 'f (Either e (XhrRequestb))' events
308-- that accepts 'f (Either e (XhrRequestb))' events
309performSomeRequestsAsync'
309performSomeRequestsAsync'
310− :: (MonadIO (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, Show b)
310+ :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, Show b)
311 => ClientOptions
311 => ClientOptions
312 -> (XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)
312 -> (XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)
313 -> Event t (Performable m (f (Either Text (XhrRequest b)))) -> m (Event t (f (Either Text a)))
313 -> Event t (Performable m (f (Either Text (XhrRequest b)))) -> m (Event t (f (Either Text a)))
@@ -319,7 +319,7 @@ performSomeRequestsAsync' opts newXhr req = performEventAsync $ ffor req $ \hrs
319 return resp
319 return resp
320 Right r' -> do
320 Right r' -> do
321 resp <- liftIO newEmptyMVar
321 resp <- liftIO newEmptyMVar
322− r'' <- liftIO $ (optsRequestFixup opts) r'
322+ r'' <- liftJSM $ (optsRequestFixup opts) r'
323 _ <- newXhr r'' $ liftIO . putMVar resp . Right
323 _ <- newXhr r'' $ liftIO . putMVar resp . Right
324 return resp
324 return resp
325 _ <- liftIO $ forkIO $ cb =<< forM resps takeMVar
325 _ <- liftIO $ forkIO $ cb =<< forM resps takeMVar