diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for jsaddle-wasm +## 0.0.1.0 -- 2024-10-26 + + * Added `runWorker` and `jsaddleScript` for running JSaddle and WASM logic in different execution environments. See the README for details on how to use this. + ## 0.0.0.0 -- 2024-10-20 * First version. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # jsaddle-wasm -[![CI](https://github.com/amesgen/jsaddle-wasm/workflows/ci-wasm/badge.svg)](https://github.com/amesgen/jsaddle-wasm/actions) -[![Hackage](https://img.shields.io/hackage/v/jsaddle-wasm)](https://hackage.haskell.org/package/jsaddle-wasm -[![Haddocks](https://img.shields.io/badge/documentation-Haddocks-purple)](https://hackage.haskell.org/package/jsaddle-wasm/docs/Language-Javascript-JSaddle-Wasm.html)) +[![CI](https://github.com/amesgen/jsaddle-wasm/workflows/CI/badge.svg)](https://github.com/amesgen/jsaddle-wasm/actions) +[![Hackage](https://img.shields.io/hackage/v/jsaddle-wasm)](https://hackage.haskell.org/package/jsaddle-wasm) +[![Haddocks](https://img.shields.io/badge/documentation-Haddocks-purple)](https://hackage.haskell.org/package/jsaddle-wasm/docs/Language-Javascript-JSaddle-Wasm.html) Run [JSaddle][] `JSM` actions with the [GHC WASM backend][]. @@ -12,9 +12,9 @@ ## Examples -### Miso + - Several Miso examples: https://github.com/tweag/ghc-wasm-miso-examples -Several Miso examples: https://github.com/tweag/ghc-wasm-miso-examples + - Reflex TodoMVC example: https://github.com/tweag/ghc-wasm-miso-examples/pull/18 ## How to use @@ -62,15 +62,53 @@ await instance.exports.hs_start(); ``` +### Separating execution environments + +It is also possible to run the WASM worker in a different execution environment (e.g. a web worker) than the JSaddle JavaScript code that dispatches the JSaddle command messages. + +An advantage of this approach is that computationally expensive operations in WASM do not block the UI thread. A disadvantage is that there is some overhead for copying the data back and forth, and everything relying on synchronous callbacks (e.g. `stopPropagation`/`preventDefault`) definitely no longer works. + + - Instead of the `run` function above, you need to use `runWorker`: + + ```haskell + import Language.Javascript.JSaddle.Wasm qualified as JSaddle.Wasm + + foreign export javascript "hs_runWorker" runWorker :: JSVal -> IO () + + runWorker :: JSVal -> IO () + runWorker = JSaddle.Wasm.runWorker Ormolu.Live.app + ``` + + The argument to `runWorker` here can be any message port in the sense of the [Channel Messaging API][]. In particular, it must provide a `postMessage` function and a `message` event. + + For example, in a web worker, you can initialize the WASM module as above, and then run + ```javascript + await instance.exports.hs_runWorker(globalThis); + ``` + as `globalThis` (or `self`) in a web worker is a message port. + + - Additionally, you need to run the JSaddle command dispatching logic on the other end of the message port. + + The necessary chunk of JavaScript is available as `jsaddleScript` both from `Language.Javascript.JSaddle.Wasm` from the main library, and also from `Language.Javascript.JSaddle.Wasm.JS` from the `js` public sublibrary, where the latter has the advantage to not depend on any JSFFI, so you can build a normal WASI command module or even a native executable while still depending on it. + + It provides a function `runJSaddle` taking a single argument, a message port. + + One way to invoke it is to save `jsaddleScript` to some file, include it via a `script` tag in your HTML file, and then run + ```javascript + const worker = new Worker("my-worker.js"); + runJSaddle(worker); + ``` + ## Potential future work - - Take a closer look at synchronous callbacks (no special handling currently, but basic things like `stopPropagation` already seem to work fine). + - Take a closer look at synchronous callbacks. We have no special handling currently, but basic things like `stopPropagation`/`preventDefault` already seem to work fine with `run` (but not with `runWorker`, as expected). - Testing (e.g. via Selenium). - Add logging/stats. - Performance/benchmarking (not clear that this is actually a bottleneck for most applications). - Optimize existing command-based implementation. - Reuse buffers - Use a serialization format more efficient than JSON. + - Patch `jsaddle` to not go through commands, by using the WASM JS FFI. - Implement `ghcjs-dom` API directly via the WASM JS FFI. This would involve creating a `ghcjs-dom-wasm` package by adapting the FFI import syntax from `ghcjs-dom-jsffi`/`ghcjs-dom-javascript` appropriately. @@ -89,3 +127,4 @@ [browser_wasi_shim]: https://github.com/bjorn3/browser_wasi_shim [ghc-users-guide-js-api]: https://ghc.gitlab.haskell.org/ghc/doc/users_guide/wasm.html#the-javascript-api [WebGHC]: https://webghc.github.io +[Channel Messaging API]: https://developer.mozilla.org/en-US/docs/Web/API/Channel_Messaging_API diff --git a/jsaddle-wasm.cabal b/jsaddle-wasm.cabal --- a/jsaddle-wasm.cabal +++ b/jsaddle-wasm.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: jsaddle-wasm -version: 0.0.0.0 -synopsis: Run JSaddle @JSM@ with the GHC WASM backend +version: 0.0.1.0 +synopsis: Run JSaddle JSM with the GHC WASM backend description: Run JSaddle @JSM@ with the GHC WASM backend. category: Web, Javascript homepage: https://github.com/amesgen/jsaddle-wasm @@ -28,6 +28,18 @@ BlockArguments OverloadedStrings +library js + import: common + visibility: public + hs-source-dirs: src-js + exposed-modules: + Language.Javascript.JSaddle.Wasm.JS + + build-depends: + base >=4.16 && <5, + bytestring >=0.11 && <0.13, + jsaddle ^>=0.9, + library import: common hs-source-dirs: src @@ -40,11 +52,11 @@ build-depends: base >=4.16 && <5, jsaddle ^>=0.9, + jsaddle-wasm:js, if arch(wasm32) build-depends: aeson >=2 && <2.3, - async ^>=2.2, bytestring >=0.11 && <0.13, ghc-experimental ^>=0.1, stm ^>=2.5, diff --git a/src-js/Language/Javascript/JSaddle/Wasm/JS.hs b/src-js/Language/Javascript/JSaddle/Wasm/JS.hs new file mode 100644 --- /dev/null +++ b/src-js/Language/Javascript/JSaddle/Wasm/JS.hs @@ -0,0 +1,29 @@ +-- | The JSaddle command interpreter. This lives in a sublibrary as it does not +-- depend on JSFFI as the rest of jsaddle-wasm, and hence does not induce this +-- property on downstream packages. +module Language.Javascript.JSaddle.Wasm.JS (jsaddleScript) where + +import Data.ByteString.Lazy.Char8 qualified as BLC8 +import Language.Javascript.JSaddle.Run.Files qualified as JSaddle.Files + +-- | A chunk of JavaScript that defines a function @runJSaddle@, a function that +-- takes a message port (e.g. a web worker) as its single argument, and then +-- processes incoming JSaddle commands. +jsaddleScript :: BLC8.ByteString +jsaddleScript = + BLC8.unlines + [ JSaddle.Files.ghcjsHelpers, + JSaddle.Files.initState, + "function runJSaddle(worker) {", + " worker.addEventListener('message', e => {", + " const d = e.data;", + " if (d && typeof d === 'object' && d.tag === 'jsaddle') {", + " const batch = JSON.parse(d.msg);", + JSaddle.Files.runBatch + (\r -> "worker.postMessage({tag: 'jsaddle', msg: JSON.stringify(" <> r <> ")});") + -- not clear how to support synchronous dispatch here + Nothing, + " }", + " });", + "}" + ] diff --git a/src-native/Language/Javascript/JSaddle/Wasm/Internal.hs b/src-native/Language/Javascript/JSaddle/Wasm/Internal.hs --- a/src-native/Language/Javascript/JSaddle/Wasm/Internal.hs +++ b/src-native/Language/Javascript/JSaddle/Wasm/Internal.hs @@ -1,6 +1,18 @@ -module Language.Javascript.JSaddle.Wasm.Internal (run) where +module Language.Javascript.JSaddle.Wasm.Internal + ( run, + runWorker, + JSVal, + ) +where import Language.Javascript.JSaddle.Types (JSM) run :: JSM () -> IO () -run _ = fail "Language.Javascript.JSaddle.Wasm.run: only works on WASM backend" +run _ = + fail "Language.Javascript.JSaddle.Wasm.run: only works on WASM backend" + +runWorker :: JSM () -> JSVal -> IO () +runWorker _ _ = + fail "Language.Javascript.JSaddle.Wasm.runWorker: only works on WASM backend" + +data JSVal diff --git a/src-wasm/Language/Javascript/JSaddle/Wasm/Internal.hs b/src-wasm/Language/Javascript/JSaddle/Wasm/Internal.hs --- a/src-wasm/Language/Javascript/JSaddle/Wasm/Internal.hs +++ b/src-wasm/Language/Javascript/JSaddle/Wasm/Internal.hs @@ -1,8 +1,13 @@ -module Language.Javascript.JSaddle.Wasm.Internal (run) where +module Language.Javascript.JSaddle.Wasm.Internal + ( run, + runWorker, + JSVal, + ) +where -import Control.Concurrent.Async qualified as Async import Control.Concurrent.STM import Control.Exception (evaluate) +import Control.Monad ((<=<)) import Data.Aeson qualified as A import Data.ByteString (ByteString) import Data.ByteString.Internal qualified as BI @@ -15,29 +20,23 @@ import Language.Javascript.JSaddle.Run.Files qualified as JSaddle.Files import Language.Javascript.JSaddle.Types (Batch, JSM) +-- Note: It is also possible to implement this succinctly on top of 'runWorker' +-- and 'jsaddleScript', but then e.g. @stopPropagation@/@preventDefault@ +-- definitely don't work, whereas they work (at least in simple cases) with the +-- implementation below. run :: JSM () -> IO () run entryPoint = do -- TODO rather use a bounded (even size 1) queue? - batchQueue :: TQueue Batch <- newTQueueIO - - let sendBatch :: Batch -> IO () - sendBatch = atomically . writeTQueue batchQueue - - (processResult, _processSyncResult, start) <- - runJavaScript sendBatch entryPoint + outgoingMsgQueue :: TQueue JSString <- newTQueueIO - processResultCallback <- mkPullCallback \s -> do - bs <- jsStringToByteString s - case A.eitherDecodeStrict bs of - Left e -> fail $ "jsaddle: received invalid JSON: " <> show e - Right r -> processResult r + let sendOutgoingMessage = + atomically . writeTQueue outgoingMsgQueue - readBatchCallback <- mkPushCallback do - batch <- atomically $ readTQueue batchQueue - byteStringToJSString $ BLC8.toStrict $ A.encode batch + readBatchCallback <- + mkPushCallback $ atomically $ readTQueue outgoingMsgQueue - let jsaddleRunner :: IO () - jsaddleRunner = do + let jsaddleRunner :: JSVal -> IO () + jsaddleRunner processResultCallback = do s <- byteStringToJSString . BLC8.toStrict . BLC8.unlines $ [ JSaddle.Files.ghcjsHelpers, @@ -47,15 +46,51 @@ " const batch = JSON.parse(await readBatch());", JSaddle.Files.runBatch (\r -> "processResult(JSON.stringify(" <> r <> "));") - -- TODO handle synchronous stuff (see processSyncResult) + -- TODO Think more about how synchronous dispatching works here + -- (see processSyncResult). For some reason, it already /seems/ + -- to work fine, at least in simple cases. Nothing, " }", "})();" ] evaluate =<< js_eval s processResultCallback readBatchCallback - Async.concurrently_ start jsaddleRunner + runHelper entryPoint sendOutgoingMessage jsaddleRunner +runWorker :: JSM () -> JSVal -> IO () +runWorker entryPoint worker = + runHelper + entryPoint + (evaluate <=< js_postMessage worker) + (evaluate <=< js_onMessage worker) + +runHelper :: + JSM () -> + -- | How to send an outgoing message. + (JSString -> IO ()) -> + -- | Start receiving incoming messages. For every message, invoke the given + -- 'JSVal' callback. + (JSVal -> IO ()) -> + IO () +runHelper entryPoint sendOutgoingMessage onIncomingMessage = do + (processResult, _processSyncResult, start) <- + runJavaScript sendBatch entryPoint + + processResultCallback <- mkPullCallback \s -> do + bs <- jsStringToByteString s + case A.eitherDecodeStrict bs of + Left e -> fail $ "jsaddle: received invalid JSON: " <> show e + Right r -> processResult r + + onIncomingMessage processResultCallback + + start + where + sendBatch :: Batch -> IO () + sendBatch batch = do + encodedBatch <- byteStringToJSString $ BLC8.toStrict $ A.encode batch + sendOutgoingMessage encodedBatch + -- Utilities: foreign import javascript "wrapper" mkPullCallback :: (JSString -> IO ()) -> IO JSVal @@ -64,6 +99,17 @@ foreign import javascript safe "new Function('processResult','readBatch',`(()=>{${$1}})()`)($2, $3)" js_eval :: JSString -> JSVal -> JSVal -> IO () + +-- Worker + +foreign import javascript safe "$1.postMessage({tag: 'jsaddle', msg: $2})" + js_postMessage :: JSVal -> JSString -> IO () + +foreign import javascript safe "$1.addEventListener('message', e => {\ + \const d = e.data;\ + \if (d && typeof d === 'object' && d.tag === 'jsaddle') $2(d.msg);\ + \})" + js_onMessage :: JSVal -> JSVal -> IO () -- Conversion JSString <-> ByteString diff --git a/src/Language/Javascript/JSaddle/Wasm.hs b/src/Language/Javascript/JSaddle/Wasm.hs --- a/src/Language/Javascript/JSaddle/Wasm.hs +++ b/src/Language/Javascript/JSaddle/Wasm.hs @@ -1,13 +1,30 @@ -module Language.Javascript.JSaddle.Wasm (run) where +-- | See the [README](https://github.com/amesgen/jsaddle-wasm) for more details. +-- +-- While this package also compiles on non-WASM GHCs for convenience, running +-- this function will immediately fail. +module Language.Javascript.JSaddle.Wasm + ( run, + runWorker, + -- * Re-exports + jsaddleScript, + JSVal, + ) +where + import Language.Javascript.JSaddle.Types (JSM) +import Language.Javascript.JSaddle.Wasm.Internal (JSVal) import Language.Javascript.JSaddle.Wasm.Internal qualified as Internal +import Language.Javascript.JSaddle.Wasm.JS (jsaddleScript) -- | Run a 'JSM' action via the WASM JavaScript FFI. --- --- See the [README](https://github.com/amesgen/jsaddle-wasm) for more details. --- --- While this package also compiles on non-WASM GHCs for convenience, running --- this function will immediately fail. run :: JSM () -> IO () run = Internal.run + +-- | Run the "worker part" of a 'JSM' action, interacting with the JSaddle JS +-- code via the given 'JSVal', a message port like e.g. a web worker. +-- +-- The messages at the connected message port must be dispatched using +-- 'jsaddleScript'. +runWorker :: JSM () -> JSVal -> IO () +runWorker = Internal.runWorker