jsaddle 0.8.3.2 → 0.9.0.0

raw patch · 7 files changed

+240/−75 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• jsaddle.cabal +1/−1
• src-ghc/JavaScript/Array/Internal.hs +0/−2
• src/Language/Javascript/JSaddle/Native/Internal.hs +15/−6
• src/Language/Javascript/JSaddle/Object.hs +29/−6
• src/Language/Javascript/JSaddle/Run.hs +56/−25
• src/Language/Javascript/JSaddle/Run/Files.hs +90/−14
• src/Language/Javascript/JSaddle/Types.hs +49/−21

@@ -1,5 +1,5 @@ name: jsaddle-version: 0.8.3.2+version: 0.9.0.0 cabal-version: >=1.10 build-type: Simple license: MIT

@@ -21,8 +21,6 @@ import Language.Javascript.JSaddle.Types (JSM, SomeJSArray(..), JSArray, MutableJSArray, STJSArray, Object(..), GHCJSPure(..)) import Language.Javascript.JSaddle.Native.Internal        (newArray, getPropertyByName, getPropertyAtIndex, callAsFunction, valueToNumber)-import Language.Javascript.JSaddle.Run-       (Command(..), Result(..), AsyncCommand(..), sendCommand, sendLazyCommand)  create :: JSM MutableJSArray create = SomeJSArray <$> newArray []

@@ -27,7 +27,8 @@   , callAsFunction   , callAsConstructor   , newEmptyObject-  , newCallback+  , newAsyncCallback+  , newSyncCallback   , newArray   , evaluateScript   , deRefVal@@ -54,7 +55,7 @@         JSStringReceived(..), JSStringForSend(..), JSObjectForSend(..)) import Language.Javascript.JSaddle.Monad (askJSM) import Language.Javascript.JSaddle.Run-       (Command(..), AsyncCommand(..), Result(..), sendCommand,+       (Command(..), Result(..), sendCommand,         sendAsyncCommand, sendLazyCommand, wrapJSVal)  wrapJSString :: MonadIO m => JSStringReceived -> m JSString@@ -136,13 +137,21 @@ newEmptyObject = Object <$> sendLazyCommand NewEmptyObject {-# INLINE newEmptyObject #-} -newCallback :: JSCallAsFunction -> JSM Object-newCallback f = do-    object <- Object <$> sendLazyCommand NewCallback+newAsyncCallback :: JSCallAsFunction -> JSM Object+newAsyncCallback f = do+    object <- Object <$> sendLazyCommand NewAsyncCallback     add <- addCallback <$> askJSM     liftIO $ add object f     return object-{-# INLINE newCallback #-}+{-# INLINE newAsyncCallback #-}++newSyncCallback :: JSCallAsFunction -> JSM Object+newSyncCallback f = do+    object <- Object <$> sendLazyCommand NewSyncCallback+    add <- addCallback <$> askJSM+    liftIO $ add object f+    return object+{-# INLINE newSyncCallback #-}  newArray :: [JSVal] -> JSM JSVal newArray xs = withJSVals xs $ \xs' -> sendLazyCommand (NewArray xs')

@@ -66,6 +66,7 @@   -- * Calling Haskell From JavaScript   , Function(..)   , function+  , asyncFunction   , freeFunction   , fun   , JSCallAsFunction@@ -102,7 +103,7 @@ #ifdef ghcjs_HOST_OS import GHCJS.Types (nullRef) import GHCJS.Foreign.Callback-       (releaseCallback, syncCallback2, OnBlocked(..), Callback)+       (releaseCallback, syncCallback2, asyncCallback2, OnBlocked(..), Callback) import GHCJS.Marshal (ToJSVal(..)) import JavaScript.Array (MutableJSArray) import qualified JavaScript.Array as Array (toListIO, fromListIO)@@ -115,7 +116,7 @@ #else import GHCJS.Marshal.Internal (ToJSVal(..)) import Language.Javascript.JSaddle.Native-       (newCallback, callAsFunction, callAsConstructor)+       (newAsyncCallback, newSyncCallback, callAsFunction, callAsConstructor) import Language.Javascript.JSaddle.Monad (askJSM, JSM) import Language.Javascript.JSaddle.Types        (JSString, Object(..), SomeJSArray(..),@@ -435,9 +436,16 @@ #endif  +#ifdef ghcjs_HOST_OS+foreign import javascript unsafe "$r = function () { $1(this, arguments); }"+    makeFunctionWithCallback :: Callback (JSVal -> JSVal -> IO ()) -> IO Object+#endif+ -- ^ Make a JavaScript function object that wraps a Haskell function.+-- Calls made to the function will be synchronous where possible+-- (on GHCJS it uses on `syncCallback2` with `ContinueAsync`). function :: JSCallAsFunction -- ^ Haskell function to call-         -> JSM Function       -- ^ Returns a JavaScript function object that will+         -> JSM Function     -- ^ Returns a JavaScript function object that will                              --   call the Haskell one when it is called #ifdef ghcjs_HOST_OS function f = do@@ -445,11 +453,26 @@         rargs <- Array.toListIO (coerce args)         f this this rargs -- TODO pass function object through     Function callback <$> makeFunctionWithCallback callback-foreign import javascript unsafe "$r = function () { $1(this, arguments); }"-    makeFunctionWithCallback :: Callback (JSVal -> JSVal -> IO ()) -> IO Object #else function f = do-    object <- newCallback f+    object <- newSyncCallback f+    return $ Function object+#endif++-- ^ Make a JavaScript function object that wraps a Haskell function.+-- Calls made to the function will be Asynchronous.+asyncFunction :: JSCallAsFunction -- ^ Haskell function to call+              -> JSM Function     -- ^ Returns a JavaScript function object that will+                                  --   call the Haskell one when it is called+#ifdef ghcjs_HOST_OS+asyncFunction f = do+    callback <- asyncCallback2 $ \this args -> do+        rargs <- Array.toListIO (coerce args)+        f this this rargs -- TODO pass function object through+    Function callback <$> makeFunctionWithCallback callback+#else+asyncFunction f = do+    object <- newAsyncCallback f     return $ Function object #endif 

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -49,7 +50,7 @@ import Control.Concurrent.STM.TVar        (writeTVar, readTVar, readTVarIO, modifyTVar', newTVarIO) import Control.Concurrent.MVar-       (MVar, MVar, putMVar, takeMVar, newEmptyMVar)+       (tryTakeMVar, MVar, putMVar, takeMVar, newEmptyMVar, readMVar)  import System.IO.Unsafe (unsafeInterleaveIO) import System.Mem.Weak (addFinalizer)@@ -61,12 +62,14 @@ import Data.IORef (newIORef, atomicWriteIORef, readIORef)  import Language.Javascript.JSaddle.Types-       (Command(..), AsyncCommand(..), Result(..), Results(..), JSContextRef(..), JSVal(..),+       (Command(..), AsyncCommand(..), Result(..), BatchResults(..), Results(..), JSContextRef(..), JSVal(..),         Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..)) import Language.Javascript.JSaddle.Exception (JSException(..)) -- import Language.Javascript.JSaddle.Native.Internal (wrapJSVal) import Control.DeepSeq (deepseq) import GHC.Stats (getGCStatsEnabled, getGCStats, GCStats(..))+import Data.Maybe (isJust)+import Data.Foldable (forM_) #endif  -- | Enable (or disable) JSaddle logging@@ -146,10 +149,11 @@     s <- doSendAsyncCommand <$> JSM ask     liftIO $ s cmd -runJavaScript :: (Batch -> IO ()) -> JSM () -> IO (Results -> IO (), IO ())+runJavaScript :: (Batch -> IO ()) -> JSM () -> IO (Results -> IO (), Results -> IO Batch, IO ()) runJavaScript sendBatch entryPoint = do     startTime' <- getCurrentTime     recvMVar <- newEmptyMVar+    lastAsyncBatch <- newEmptyMVar     commandChan <- newTChanIO     callbacks <- newTVarIO M.empty     nextRef' <- newTVarIO 0@@ -169,17 +173,33 @@       , nextRef = nextRef'       , doEnableLogging = atomicWriteIORef loggingEnabled       }-    let processResults = \case+    let processResults :: Bool -> Results -> IO ()+        processResults syncCallbacks = \case             (ProtocolError err) -> error $ "Protocol error : " <> T.unpack err-            (Callback f this a) -> do-                logInfo ("Call " <>)+            (Callback n br f this a) -> do+                putMVar recvMVar (n, br)                 f'@(JSVal fNumber) <- runReaderT (unJSM $ wrapJSVal f) ctx                 this' <- runReaderT  (unJSM $ wrapJSVal this) ctx                 args <- runReaderT (unJSM $ mapM wrapJSVal a) ctx+                logInfo (("Call " <> show fNumber <> " ") <>)                 (M.lookup fNumber <$> liftIO (readTVarIO callbacks)) >>= \case                     Nothing -> liftIO $ putStrLn "Callback called after it was freed"-                    Just cb -> void . forkIO $ runReaderT (unJSM $ cb f' this' args) ctx-            m                   -> putMVar recvMVar m+                    Just cb -> void . forkIO $ do+                        runReaderT (unJSM $ cb f' this' args) ctx+                        when syncCallbacks $+                            doSendAsyncCommand ctx EndSyncBlock+            Duplicate nBatch nExpected -> do+                putStrLn $ "Error : Unexpected Duplicate. syncCallbacks=" <> show syncCallbacks <>+                    " nBatch=" <> show nBatch <> " nExpected=" <> show nExpected+                void $ doSendCommand ctx Sync+            BatchResults n br -> putMVar recvMVar (n, br)+        asyncResults :: Results -> IO ()+        asyncResults results =+            void . forkIO $ processResults False results+        syncResults :: Results -> IO Batch+        syncResults results = do+            void . forkIO $ processResults True results+            readMVar lastAsyncBatch         logInfo s =             readIORef loggingEnabled >>= \case                 True -> do@@ -189,23 +209,34 @@                     cbCount <- M.size <$> readTVarIO callbacks                     putStrLn . s $ "M " <> currentBytesUsedStr <> "CB " <> show cbCount                 False -> return ()-    _ <- forkIO . forever $ readBatch commandChan >>= \case-            (batch@(Batch cmds _), resultMVars) -> do+    _ <- forkIO . numberForeverFromM_ 1 $ \nBatch ->+        readBatch nBatch commandChan >>= \case+            (batch@(Batch cmds _ _), resultMVars) -> do                 logInfo (\x -> "Sync " <> x <> show (length cmds, last cmds))+                _ <- tryTakeMVar lastAsyncBatch+                putMVar lastAsyncBatch batch                 sendBatch batch-                takeMVar recvMVar >>= \case-                    Success results | length results /= length resultMVars -> error "Unexpected number of jsaddle results"-                                    | otherwise -> zipWithM_ putMVar resultMVars results-                    Failure results exception -> do-                        -- The exception will only be rethrown in Haskell if/when one of the-                        -- missing results (if any) is evaluated.-                        putStrLn "A JavaScript exception was thrown! (may not reach Haskell code)"-                        zipWithM_ putMVar resultMVars $ results <> repeat (ThrowJSValue exception)-                    _ -> error "Unexpected jsaddle results"-    return (processResults, runReaderT (unJSM entryPoint) ctx)+                takeResult recvMVar nBatch >>= \case+                        (n, _) | n /= nBatch -> error $ "Unexpected jsaddle results (expected batch " <> show nBatch <> ", got batch " <> show n <> ")"+                        (_, Success results) | length results /= length resultMVars -> error "Unexpected number of jsaddle results"+                                             | otherwise -> zipWithM_ putMVar resultMVars results+                        (_, Failure results exception) -> do+                            -- The exception will only be rethrown in Haskell if/when one of the+                            -- missing results (if any) is evaluated.+                            putStrLn "A JavaScript exception was thrown! (may not reach Haskell code)"+                            zipWithM_ putMVar resultMVars $ results <> repeat (ThrowJSValue exception)+    return (asyncResults, syncResults, runReaderT (unJSM entryPoint) ctx)   where-    readBatch :: TChan (Either AsyncCommand (Command, MVar Result)) -> IO (Batch, [MVar Result])-    readBatch chan = do+    numberForeverFromM_ :: (Monad m, Enum n) => n -> (n -> m a) -> m ()+    numberForeverFromM_ !n f = do+      f n+      numberForeverFromM_ (succ n) f+    takeResult recvMVar nBatch =+        takeMVar recvMVar >>= \case+            (n, _) | n < nBatch -> takeResult recvMVar nBatch+            r -> return r+    readBatch :: Int -> TChan (Either AsyncCommand (Command, MVar Result)) -> IO (Batch, [MVar Result])+    readBatch nBatch chan = do         first <- atomically $ readTChan chan -- We want at least one command to send         loop first ([], [])       where@@ -216,17 +247,17 @@             let cmds = Right syncCmd:cmds'                 resultMVars = resultMVar:resultMVars'             atomically (tryReadTChan chan) >>= \case-                Nothing -> return (Batch (reverse cmds) False, reverse resultMVars)+                Nothing -> return (Batch (reverse cmds) False nBatch, reverse resultMVars)                 Just cmd -> loop cmd (cmds, resultMVars)         loop (Left asyncCmd) (cmds', resultMVars) = do             let cmds = Left asyncCmd:cmds'             atomically (tryReadTChan chan) >>= \case-                Nothing -> return (Batch (reverse cmds) False, reverse resultMVars)+                Nothing -> return (Batch (reverse cmds) False nBatch, reverse resultMVars)                 Just cmd -> loop cmd (cmds, resultMVars)         -- When we have seen a SyncWithAnimationFrame command only a synchronous command should end the batch         loopAnimation :: Either AsyncCommand (Command, MVar Result) -> ([Either AsyncCommand Command], [MVar Result]) -> IO (Batch, [MVar Result])         loopAnimation (Right (Sync, resultMVar)) (cmds, resultMVars) =-            return (Batch (reverse (Right Sync:cmds)) True, reverse (resultMVar:resultMVars))+            return (Batch (reverse (Right Sync:cmds)) True nBatch, reverse (resultMVar:resultMVars))         loopAnimation (Right (syncCmd, resultMVar)) (cmds, resultMVars) =             atomically (readTChan chan) >>= \cmd -> loopAnimation cmd (Right syncCmd:cmds, resultMVar:resultMVars)         loopAnimation (Left asyncCmd) (cmds, resultMVars) =

@@ -43,13 +43,23 @@     \        jsaddle_values.set(3, true);\n\     \        jsaddle_values.set(4, window);\n\     \        var jsaddle_index = 100;\n\+    \        var expectedBatch = 1;\n\+    \        var lastResults = [0, {}];\n\+    \        var inCallback = 0;\n\     \" -runBatch :: (ByteString -> ByteString) -> ByteString-runBatch send = "\+runBatch :: (ByteString -> ByteString) -> Maybe (ByteString -> ByteString) -> ByteString+runBatch send sendSync = "\+    \  var runBatch = function(firstBatch, initialSyncDepth) {\n\     \    var processBatch = function(timestamp) {\n\-    \        var results = [];\n\-    \        try {\n\+    \      var batch = firstBatch;\n\+    \      var results = [];\n\+    \      inCallback++;\n\+    \      try {\n\+    \        syncDepth = initialSyncDepth || 0;\n\+    \        for(;;){\n\+    \          if(batch[2] === expectedBatch) {\n\+    \            expectedBatch++;\n\     \            var nCommandsLength = batch[0].length;\n\     \            for (var nCommand = 0; nCommand != nCommandsLength; nCommand++) {\n\     \                var cmd = batch[0][nCommand];\n\@@ -89,7 +99,7 @@     \                                var n = d.contents;\n\     \                                jsaddle_values.set(n, {});\n\     \                                break;\n\-    \                            case \"NewCallback\":\n\+    \                            case \"NewAsyncCallback\":\n\     \                                (function() {\n\     \                                    var nFunction = d.contents;\n\     \                                    jsaddle_values.set(nFunction, function() {\n\@@ -101,9 +111,33 @@     \                                            jsaddle_values.set(nArg, arguments[i]);\n\     \                                            args[i] = nArg;\n\     \                                        }\n\-    \                                        " <> send "{\"tag\": \"Callback\", \"contents\": [nFunction, nThis, args]}" <> "\n\+    \                                        " <> send "{\"tag\": \"Callback\", \"contents\": [lastResults[0], lastResults[1], nFunction, nThis, args]}" <> "\n\     \                                    })})();\n\     \                                break;\n\+    \                            case \"NewSyncCallback\":\n\+    \                                (function() {\n\+    \                                    var nFunction = d.contents;\n\+    \                                    jsaddle_values.set(nFunction, function() {\n\+    \                                        var nThis = ++jsaddle_index;\n\+    \                                        jsaddle_values.set(nThis, this);\n\+    \                                        var args = [];\n\+    \                                        for (var i = 0; i != arguments.length; i++) {\n\+    \                                            var nArg = ++jsaddle_index;\n\+    \                                            jsaddle_values.set(nArg, arguments[i]);\n\+    \                                            args[i] = nArg;\n\+    \                                        }\n" <> (+    case sendSync of+      Just s  ->+        "                                        if(inCallback > 0) {\n\+        \                                          " <> send "{\"tag\": \"Callback\", \"contents\": [lastResults[0], lastResults[1], nFunction, nThis, args]}" <> "\n\+        \                                        } else {\n\+        \                                          runBatch(" <> s "{\"tag\": \"Callback\", \"contents\": [lastResults[0], lastResults[1], nFunction, nThis, args]}" <> ", 1);\n\+        \                                        }\n"+      Nothing ->+        "                                        " <> send "{\"tag\": \"Callback\", \"contents\": [lastResults[0], lastResults[1], nFunction, nThis, args]}" <> "\n"+    ) <>+    "                                    })})();\n\+    \                                break;\n\     \                            case \"CallAsFunction\":\n\     \                                var n = d.contents[3];\n\     \                                jsaddle_values.set(n,\n\@@ -148,6 +182,12 @@     \                                var n = d.contents[0];\n\     \                                jsaddle_values.set(n, timestamp);\n\     \                                break;\n\+    \                            case \"StartSyncBlock\":\n\+    \                                syncDepth++;\n\+    \                                break;\n\+    \                            case \"EndSyncBlock\":\n\+    \                                syncDepth--;\n\+    \                                break;\n\     \                            default:\n\     \                                " <> send "{\"tag\": \"ProtocolError\", \"contents\": e.data}" <> "\n\     \                                return;\n\@@ -210,20 +250,56 @@     \                        }\n\     \                }\n\     \            }\n\-    \            " <> send "{\"tag\": \"Success\", \"contents\": results}" <> "\n\-    \        }\n\-    \        catch (err) {\n\-    \            var n = ++jsaddle_index;\n\-    \            jsaddle_values.set(n, err);\n\-    \            " <> send "{\"tag\": \"Failure\", \"contents\": [results,n]}" <> "\n\+    \            if(syncDepth <= 0) {\n\+    \              lastResults = [batch[2], {\"tag\": \"Success\", \"contents\": results}];\n\+    \              " <> send "{\"tag\": \"BatchResults\", \"contents\": [lastResults[0], lastResults[1]]}" <> "\n\+    \              break;\n\+    \            } else {\n" <> (+    case sendSync of+      Just s  ->+        "              lastResults = [batch[2], {\"tag\": \"Success\", \"contents\": results}];\n\+        \              batch = " <> s "{\"tag\": \"BatchResults\", \"contents\": [lastResults[0], lastResults[1]]}" <> ";\n\+        \              results = [];\n"+      Nothing ->+        "              " <> send "{\"tag\": \"BatchResults\", \"contents\": [batch[2], {\"tag\": \"Success\", \"contents\": results}]}" <> "\n\+        \              break;\n"+    ) <>+    "            }\n\+    \          } else {\n\+    \            if(syncDepth <= 0) {\n\+    \              break;\n\+    \            } else {\n" <> (+    case sendSync of+      Just s  ->+        "              if(batch[2] === expectedBatch - 1) {\n\+        \                batch = " <> s "{\"tag\": \"BatchResults\", \"contents\": [lastResults[0], lastResults[1]]}" <> ";\n\+        \              } else {\n\+        \                batch = " <> s "{\"tag\": \"Duplicate\", \"contents\": [batch[2], expectedBatch]}" <> ";\n\+        \              }\n\+        \              results = [];\n"+      Nothing ->+        "              " <> send "{\"tag\": \"Duplicate\", \"contents\": [batch[2], expectedBatch]}" <> "\n\+        \              break;\n"+    ) <>+    "            }\n\+    \          }\n\     \        }\n\+    \      }\n\+    \      catch (err) {\n\+    \        var n = ++jsaddle_index;\n\+    \        jsaddle_values.set(n, err);\n\+    \        " <> send "{\"tag\": \"BatchResults\", \"contents\": [batch[2], {\"tag\": \"Failure\", \"contents\": [results, n]}]}" <> "\n\+    \      }\n\+    \      inCallback--;\n\     \    };\n\-    \    if(batch[1]) {\n\+    \    if(batch[1] && (initialSyncDepth || 0) === 0) {\n\     \        window.requestAnimationFrame(processBatch);\n\     \    }\n\     \    else {\n\     \        processBatch(window.performance ? window.performance.now() : null);\n\     \    }\n\+    \  };\n\+    \  runBatch(batch);\n\     \"  -- Use this to generate this string for embedding@@ -249,7 +325,7 @@     \        ws.onmessage = function(e) {\n\     \            var batch = JSON.parse(e.data);\n\     \\n\-    \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));") <> "\+    \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));") Nothing <> "\     \        };\n\     \    };\n\     \    ws.onerror = function() {\n\

@@ -14,6 +14,7 @@ #endif {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE KindSignatures             #-}+{-# LANGUAGE AllowAmbiguousTypes        #-} ----------------------------------------------------------------------------- -- -- Module      :  Language.Javascript.JSaddle.Types@@ -73,6 +74,7 @@   , Command(..)   , Batch(..)   , Result(..)+  , BatchResults(..)   , Results(..) #endif ) where@@ -87,10 +89,19 @@ import GHCJS.Prim.Internal (JSVal(..), JSValueRef) import Data.JSString.Internal.Type (JSString(..)) import Control.DeepSeq (NFData(..))+import Control.Monad.Trans.Cont (ContT(..))+import Control.Monad.Trans.Error (Error(..), ErrorT(..))+import Control.Monad.Trans.Except (ExceptT(..))+import Control.Monad.Trans.Identity (IdentityT(..))+import Control.Monad.Trans.List (ListT(..))+import Control.Monad.Trans.Maybe (MaybeT(..)) import Control.Monad.Trans.Reader (ReaderT(..))-import Control.Monad.Trans.State.Lazy (StateT(..))-import qualified Control.Monad.Trans.State.Strict as Strict-       (StateT(..))+import Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..))+import Control.Monad.Trans.RWS.Strict as Strict (RWST(..))+import Control.Monad.Trans.State.Lazy as Lazy (StateT(..))+import Control.Monad.Trans.State.Strict as Strict (StateT(..))+import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..))+import Control.Monad.Trans.Writer.Strict as Strict (WriterT(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Fix (MonadFix) import Control.Monad.Ref (MonadAtomicRef(..), MonadRef(..))@@ -191,23 +202,28 @@ #else class (Applicative m, MonadIO m) => MonadJSM m where     liftJSM' :: JSM a -> m a-    {-# MINIMAL liftJSM' #-} -instance MonadJSM JSM where-    liftJSM' = id-    {-# INLINE liftJSM' #-}--instance MonadJSM m => MonadJSM (ReaderT e m) where-    liftJSM' = lift . liftJSM'+    default liftJSM' :: (MonadJSM m', MonadTrans t) => JSM a' -> t m' a'+    liftJSM' = lift . (liftJSM' :: MonadJSM m' => JSM a -> m' a)     {-# INLINE liftJSM' #-} -instance MonadJSM m => MonadJSM (StateT r m) where-    liftJSM' = lift . liftJSM'+instance MonadJSM JSM where+    liftJSM' = id     {-# INLINE liftJSM' #-} -instance MonadJSM m => MonadJSM (Strict.StateT r m) where-    liftJSM' = lift . liftJSM'-    {-# INLINE liftJSM' #-}+instance (MonadJSM m) => MonadJSM (ContT r m)+instance (Error e, MonadJSM m) => MonadJSM (ErrorT e m)+instance (MonadJSM m) => MonadJSM (ExceptT e m)+instance (MonadJSM m) => MonadJSM (IdentityT m)+instance (MonadJSM m) => MonadJSM (ListT m)+instance (MonadJSM m) => MonadJSM (MaybeT m)+instance (MonadJSM m) => MonadJSM (ReaderT r m)+instance (Monoid w, MonadJSM m) => MonadJSM (Lazy.RWST r w s m)+instance (Monoid w, MonadJSM m) => MonadJSM (Strict.RWST r w s m)+instance (MonadJSM m) => MonadJSM (Lazy.StateT s m)+instance (MonadJSM m) => MonadJSM (Strict.StateT s m)+instance (Monoid w, MonadJSM m) => MonadJSM (Lazy.WriterT w m)+instance (Monoid w, MonadJSM m) => MonadJSM (Strict.WriterT w m)  instance MonadRef JSM where     type Ref JSM = Ref IO@@ -315,11 +331,14 @@                   | CallAsFunction JSObjectForSend JSObjectForSend [JSValueForSend] JSValueForSend                   | CallAsConstructor JSObjectForSend [JSValueForSend] JSValueForSend                   | NewEmptyObject JSValueForSend-                  | NewCallback JSValueForSend+                  | NewAsyncCallback JSValueForSend+                  | NewSyncCallback JSValueForSend                   | NewArray [JSValueForSend] JSValueForSend                   | EvaluateScript JSStringForSend JSValueForSend                   | SyncWithAnimationFrame JSValueForSend-                  deriving (Show, Generic)+                  | StartSyncBlock+                  | EndSyncBlock+                   deriving (Show, Generic)  instance ToJSON AsyncCommand where     toEncoding = genericToEncoding defaultOptions@@ -351,7 +370,7 @@ instance NFData Command  -- | Batch of commands that can be sent together to the JavaScript context-data Batch = Batch [Either AsyncCommand Command] Bool+data Batch = Batch [Either AsyncCommand Command] Bool Int              deriving (Show, Generic)  instance ToJSON Batch where@@ -382,9 +401,18 @@  instance FromJSON Result -data Results = Success [Result]-             | Failure [Result] JSValueReceived-             | Callback JSValueReceived JSValueReceived [JSValueReceived]+data BatchResults = Success [Result]+                  | Failure [Result] JSValueReceived+             deriving (Show, Generic)++instance ToJSON BatchResults where+    toEncoding = genericToEncoding defaultOptions++instance FromJSON BatchResults++data Results = BatchResults Int BatchResults+             | Duplicate Int Int+             | Callback Int BatchResults JSValueReceived JSValueReceived [JSValueReceived]              | ProtocolError Text              deriving (Show, Generic)