git.iko.soy/typeable/servant-reflex
on master help sign in
Merge pull request #53 from hamishmack/jsm-clientopts

Use JSM instead of IO in ClientOptions

commit6593c1ce806a2ac247fa786184c906616236dbd7 authorGreg Hale <ImAlsoGreg@gmail.com> dateThu 1 Feb 2018, 18:14 (9 years ago) parent3b6ce366b58ef3
1 file changed+4−4
src/Servant/Common/Req.hs+4−4
src/Servant/Common/Req.hs+4−4
@@ -27,7 +27,7 @@ import Data.Text (Text)
2727import qualified Data.Text as T
2828import qualified Data.Text.Encoding as TE
2929import Data.Traversable (forM)
30−import Language.Javascript.JSaddle.Monad (JSM, MonadJSM)
30+import Language.Javascript.JSaddle.Monad (JSM, MonadJSM, liftJSM)
3131import qualified Network.URI as N
3232import Reflex.Dom.Core hiding (tag)
3333import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,
@@ -51,7 +51,7 @@ data ReqResult tag a
5151 deriving (Functor)
5252
5353data ClientOptions = ClientOptions
54− { optsRequestFixup :: forall a. Show a => XhrRequest a -> IO (XhrRequest a)
54+ { optsRequestFixup :: forall a. Show a => XhrRequest a -> JSM (XhrRequest a)
5555 -- ^ Aribtrarily modify requests just before they are sent.
5656 -- Warning: This escape hatch opens the possibility for your
5757 -- requests to diverge from what the server expects, when the
@@ -307,7 +307,7 @@ performSomeRequestsAsync opts =
307307-- | A modified version or Reflex.Dom.Xhr.performRequestsAsync
308308-- that accepts 'f (Either e (XhrRequestb))' events
309309performSomeRequestsAsync'
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)
311311 => ClientOptions
312312 -> (XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)
313313 -> 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
319319 return resp
320320 Right r' -> do
321321 resp <- liftIO newEmptyMVar
322− r'' <- liftIO $ (optsRequestFixup opts) r'
322+ r'' <- liftJSM $ (optsRequestFixup opts) r'
323323 _ <- newXhr r'' $ liftIO . putMVar resp . Right
324324 return resp
325325 _ <- liftIO $ forkIO $ cb =<< forM resps takeMVar