├── cabal.project ├── .gitignore ├── cabal.project.ci ├── .github ├── dependabot.yml └── workflows │ └── ci.yml ├── src-native └── Language │ └── Javascript │ └── JSaddle │ └── Wasm │ └── Internal.hs ├── flake.nix ├── src └── Language │ └── Javascript │ └── JSaddle │ ├── Wasm.hs │ └── Wasm │ └── TH.hs ├── src-js └── Language │ └── Javascript │ └── JSaddle │ └── Wasm │ └── JS.hs ├── CHANGELOG.md ├── jsaddle-wasm.cabal ├── flake.lock ├── src-wasm └── Language │ └── Javascript │ └── JSaddle │ └── Wasm │ ├── Internal │ └── TH.hs │ └── Internal.hs ├── README.md └── LICENSE /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | tests: True 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle/ 2 | cabal.project.local 3 | -------------------------------------------------------------------------------- /cabal.project.ci: -------------------------------------------------------------------------------- 1 | program-options 2 | ghc-options: -Werror 3 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: "github-actions" 4 | directory: "/" 5 | schedule: 6 | interval: "daily" 7 | -------------------------------------------------------------------------------- /src-native/Language/Javascript/JSaddle/Wasm/Internal.hs: -------------------------------------------------------------------------------- 1 | module Language.Javascript.JSaddle.Wasm.Internal 2 | ( run, 3 | runWorker, 4 | JSVal, 5 | ) 6 | where 7 | 8 | import Language.Javascript.JSaddle.Types (JSM) 9 | 10 | run :: JSM () -> IO () 11 | run _ = 12 | fail "Language.Javascript.JSaddle.Wasm.run: only works on Wasm backend" 13 | 14 | runWorker :: JSM () -> JSVal -> IO () 15 | runWorker _ _ = 16 | fail "Language.Javascript.JSaddle.Wasm.runWorker: only works on Wasm backend" 17 | 18 | data JSVal 19 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs = { 3 | nixpkgs.follows = "ghc-wasm-meta/nixpkgs"; 4 | flake-utils.follows = "ghc-wasm-meta/flake-utils"; 5 | ghc-wasm-meta.url = "gitlab:haskell-wasm/ghc-wasm-meta?host=gitlab.haskell.org"; 6 | }; 7 | outputs = inputs: inputs.flake-utils.lib.eachDefaultSystem (system: 8 | let 9 | pkgs = inputs.nixpkgs.legacyPackages.${system}; 10 | inherit (pkgs) lib; 11 | devShells = lib.genAttrs [ "9_10" "9_12" ] (ghc: pkgs.mkShell { 12 | packages = [ 13 | inputs.ghc-wasm-meta.packages.${system}."all_${ghc}" 14 | ]; 15 | }); 16 | in 17 | { 18 | devShells = devShells // { default = devShells."9_10"; }; 19 | }); 20 | } 21 | -------------------------------------------------------------------------------- /src/Language/Javascript/JSaddle/Wasm.hs: -------------------------------------------------------------------------------- 1 | -- | See the [README](https://github.com/amesgen/jsaddle-wasm) for more details. 2 | -- 3 | -- While this package also compiles on non-Wasm GHCs for convenience, running 4 | -- any function from this module will immediately fail in that case. 5 | module Language.Javascript.JSaddle.Wasm 6 | ( run, 7 | runWorker, 8 | 9 | -- * Re-exports 10 | jsaddleScript, 11 | JSVal, 12 | ) 13 | where 14 | 15 | import Language.Javascript.JSaddle.Types (JSM) 16 | import Language.Javascript.JSaddle.Wasm.Internal (JSVal) 17 | import Language.Javascript.JSaddle.Wasm.Internal qualified as Internal 18 | import Language.Javascript.JSaddle.Wasm.JS (jsaddleScript) 19 | 20 | -- | Run a 'JSM' action via the Wasm JavaScript FFI. 21 | run :: JSM () -> IO () 22 | run = Internal.run 23 | 24 | -- | Run the "worker part" of a 'JSM' action, interacting with the JSaddle JS 25 | -- code via the given 'JSVal', a message port like e.g. a web worker. 26 | -- 27 | -- The messages at the connected message port must be dispatched using 28 | -- 'jsaddleScript'. 29 | runWorker :: JSM () -> JSVal -> IO () 30 | runWorker = Internal.runWorker 31 | -------------------------------------------------------------------------------- /src-js/Language/Javascript/JSaddle/Wasm/JS.hs: -------------------------------------------------------------------------------- 1 | -- | The JSaddle command interpreter. This lives in a sublibrary as it does not 2 | -- depend on JSFFI as the rest of jsaddle-wasm, and hence does not induce this 3 | -- property on downstream packages. 4 | module Language.Javascript.JSaddle.Wasm.JS (jsaddleScript) where 5 | 6 | import Data.ByteString.Lazy.Char8 qualified as BLC8 7 | import Language.Javascript.JSaddle.Run.Files qualified as JSaddle.Files 8 | 9 | -- | A chunk of JavaScript that defines a function @runJSaddle@, a function that 10 | -- takes a message port (e.g. a web worker) as its single argument, and then 11 | -- processes incoming JSaddle commands. 12 | jsaddleScript :: BLC8.ByteString 13 | jsaddleScript = 14 | BLC8.unlines 15 | [ JSaddle.Files.ghcjsHelpers, 16 | JSaddle.Files.initState, 17 | "function runJSaddle(worker) {", 18 | " worker.addEventListener('message', e => {", 19 | " const d = e.data;", 20 | " if (d && typeof d === 'object' && d.tag === 'jsaddle') {", 21 | " const batch = JSON.parse(d.msg);", 22 | JSaddle.Files.runBatch 23 | (\r -> "worker.postMessage({tag: 'jsaddle', msg: JSON.stringify(" <> r <> ")});") 24 | -- not clear how to support synchronous dispatch here 25 | Nothing, 26 | " }", 27 | " });", 28 | "}" 29 | ] 30 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for jsaddle-wasm 2 | 3 | ## 0.1.2.1 -- 2025-07-10 4 | 5 | * `Language.Javascript.JSaddle.Wasm.TH`: Make sure that the underlying FFI call has been fully completed. 6 | 7 | ## 0.1.2.0 -- 2025-06-27 8 | 9 | * Internally, stop using JS `eval`. This allows usage with a `Content-Security-Policy` without `unsafe-eval` (but still with `wasm-unsafe-eval`). 10 | 11 | For the same reason, expose `eval` and `evalFile` from `Language.Javascript.JSaddle.Wasm.TH` which allow to generate corresponding Wasm JSFFI imports for statically known strings. 12 | 13 | Useful as a replacement of JSaddle's `eval` in downstream libraries 14 | 15 | ## 0.1.1.0 -- 2025-05-01 16 | 17 | * Bug fix: make GHCJS helpers globally available. 18 | 19 | This bug manifested itself in error messages like 20 | ``` 21 | TypeError: jsaddle_values.get(...) is undefined 22 | ``` 23 | when calling certain JSaddle functions like `jsTypeOf` or `createFromArrayBuffer`. 24 | 25 | ## 0.1.0.0 -- 2025-03-06 26 | 27 | * Add support for synchronous callbacks (when using `run`, but not `runWorker`) using the new synchronous Wasm JSFFI exports feature. 28 | Correspondingly, jsaddle-wasm requires a GHC with support for that feature; please use older versions of this library if you can not yet upgrade. 29 | 30 | ## 0.0.1.0 -- 2024-10-26 31 | 32 | * Added `runWorker` and `jsaddleScript` for running JSaddle and WASM logic in different execution environments. See the README for details on how to use this. 33 | 34 | ## 0.0.0.0 -- 2024-10-20 35 | 36 | * First version. 37 | -------------------------------------------------------------------------------- /src/Language/Javascript/JSaddle/Wasm/TH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- | Utilities for evaluating (at runtime) JS code that is known at compile time 4 | -- via TemplateHaskell /without/ relying on JS @eval@. 5 | -- 6 | -- For niche use cases, generating JSaddle-based 'JSaddle.eval' instead is 7 | -- possible by disabling the @eval-via-jsffi@ Cabal flag. 8 | -- 9 | -- For convenience, on non-Wasm GHCs, the semantics of having @eval-via-jsffi@ 10 | -- disabled are used. 11 | module Language.Javascript.JSaddle.Wasm.TH where 12 | 13 | import Language.Haskell.TH qualified as TH 14 | import Language.Javascript.JSaddle qualified as JSaddle 15 | #ifdef EVAL_VIA_JSFFI 16 | import Control.Monad.IO.Class (liftIO) 17 | import Language.Javascript.JSaddle.Wasm.Internal.TH qualified as Internal 18 | #else 19 | import Data.Functor (void) 20 | #endif 21 | 22 | -- | Generate an expression that, when called, evaluates the given chunk of JS 23 | -- code. Additionally, a list of argument types can be specified. 24 | -- 25 | -- For example, 26 | -- 27 | -- > $(eval "console.log('hi')") :: JSM () 28 | -- 29 | -- will print \"hi\" to the console when executed. 30 | -- 31 | -- Internally, this generates the following code: 32 | -- 33 | -- * If the Cabal flag @eval-via-jsffi@ is enabled (the default): An 34 | -- appropriate safe Wasm JSFFI import. 35 | -- 36 | -- * If @eval-via-jsffi@ is disabled: Use JSaddle's 'JSaddle.eval'. 37 | eval :: String -> TH.Q TH.Exp 38 | #if EVAL_VIA_JSFFI 39 | eval chunk = [|liftIO $(Internal.eval chunk []) :: JSaddle.JSM ()|] 40 | #else 41 | eval chunk = [|void $ JSaddle.eval chunk|] 42 | #endif 43 | 44 | -- | Like 'eval', but read the JS code to evaluate from a file. 45 | evalFile :: FilePath -> TH.Q TH.Exp 46 | evalFile path = do 47 | chunk <- TH.runIO $ readFile path 48 | eval chunk 49 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | push: 4 | branches: 5 | - main 6 | pull_request: 7 | types: 8 | - opened 9 | - synchronize 10 | jobs: 11 | formatting: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - uses: actions/checkout@v5 15 | - uses: haskell-actions/run-ormolu@v17 16 | - uses: tfausak/cabal-gild-setup-action@v2 17 | with: 18 | version: 1.6.0.2 19 | ci-wasm: 20 | runs-on: ubuntu-latest 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | ghc: ['9_10', '9_12'] 25 | steps: 26 | - uses: actions/checkout@v5 27 | - uses: cachix/install-nix-action@v31 28 | - uses: actions/cache@v4 29 | with: 30 | path: | 31 | ~/.ghc-wasm/.cabal/store 32 | key: wasm-${{ github.run_id }} 33 | restore-keys: | 34 | wasm-${{ matrix.ghc }}-${{ github.run_id }} 35 | wasm-${{ matrix.ghc }}- 36 | - uses: nicknovitski/nix-develop@v1 37 | with: 38 | arguments: '.#"${{ matrix.ghc }}"' 39 | - name: Build 40 | run: | 41 | mv cabal.project.ci cabal.project.local 42 | wasm32-wasi-cabal update 43 | wasm32-wasi-cabal build 44 | ci-native: 45 | runs-on: ubuntu-latest 46 | strategy: 47 | fail-fast: false 48 | matrix: 49 | ghc: ['9.10', '9.12'] 50 | steps: 51 | - uses: actions/checkout@v5 52 | - uses: haskell-actions/setup@v2 53 | id: setup-haskell 54 | with: 55 | ghc-version: ${{ matrix.ghc }} 56 | - uses: actions/cache@v4 57 | with: 58 | path: ${{ steps.setup-haskell.outputs.cabal-store }} 59 | key: ci-native-${{ github.run_id }} 60 | restore-keys: | 61 | ci-native-${{ matrix.ghc }}-${{ github.run_id }} 62 | ci-native-${{ matrix.ghc }}- 63 | - run: cabal build 64 | -------------------------------------------------------------------------------- /jsaddle-wasm.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: jsaddle-wasm 3 | version: 0.1.2.1 4 | synopsis: Run JSaddle JSM with the GHC Wasm backend 5 | description: Run JSaddle @JSM@ with the GHC Wasm backend. 6 | category: Web, Javascript 7 | homepage: https://github.com/amesgen/jsaddle-wasm 8 | bug-reports: https://github.com/amesgen/jsaddle-wasm/issues 9 | license: CC0-1.0 10 | license-file: LICENSE 11 | extra-source-files: README.md 12 | author: amesgen 13 | maintainer: amesgen@amesgen.de 14 | extra-doc-files: CHANGELOG.md 15 | 16 | source-repository head 17 | location: https://github.com/amesgen/jsaddle-wasm 18 | type: git 19 | 20 | flag eval-via-jsffi 21 | description: 22 | Generate Wasm JSFFI imports for the TemplateHaskell utilities in 23 | @Language.Javascript.JSaddle.Wasm.TH@. 24 | 25 | default: True 26 | manual: True 27 | 28 | common common 29 | ghc-options: 30 | -Wall 31 | -Wimplicit-lift 32 | -Wunused-packages 33 | -Wredundant-constraints 34 | 35 | default-language: GHC2021 36 | default-extensions: 37 | BlockArguments 38 | LambdaCase 39 | OverloadedStrings 40 | TemplateHaskellQuotes 41 | 42 | library js 43 | import: common 44 | visibility: public 45 | hs-source-dirs: src-js 46 | exposed-modules: 47 | Language.Javascript.JSaddle.Wasm.JS 48 | 49 | build-depends: 50 | base >=4.16 && <5, 51 | bytestring >=0.11 && <0.13, 52 | jsaddle ^>=0.9, 53 | 54 | library 55 | import: common 56 | hs-source-dirs: src 57 | exposed-modules: 58 | Language.Javascript.JSaddle.Wasm 59 | Language.Javascript.JSaddle.Wasm.TH 60 | 61 | other-modules: 62 | Language.Javascript.JSaddle.Wasm.Internal 63 | 64 | build-depends: 65 | base >=4.16 && <5, 66 | jsaddle ^>=0.9, 67 | jsaddle-wasm:js, 68 | template-haskell >=2.20 && <2.24, 69 | 70 | if arch(wasm32) 71 | build-depends: 72 | aeson >=2 && <2.3, 73 | bytestring >=0.11 && <0.13, 74 | ghc-experimental ^>=0.1 || >=9.1000 && <9.1300, 75 | parser-regex ^>=0.3, 76 | stm ^>=2.5, 77 | 78 | other-modules: 79 | Language.Javascript.JSaddle.Wasm.Internal.TH 80 | 81 | hs-source-dirs: src-wasm 82 | 83 | if flag(eval-via-jsffi) 84 | cpp-options: -DEVAL_VIA_JSFFI 85 | else 86 | hs-source-dirs: src-native 87 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-utils": { 4 | "inputs": { 5 | "systems": "systems" 6 | }, 7 | "locked": { 8 | "lastModified": 1731533236, 9 | "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", 10 | "owner": "numtide", 11 | "repo": "flake-utils", 12 | "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "numtide", 17 | "repo": "flake-utils", 18 | "type": "github" 19 | } 20 | }, 21 | "ghc-wasm-meta": { 22 | "inputs": { 23 | "flake-utils": "flake-utils", 24 | "nixpkgs": "nixpkgs" 25 | }, 26 | "locked": { 27 | "host": "gitlab.haskell.org", 28 | "lastModified": 1749674157, 29 | "narHash": "sha256-A+wyUfg/P3B7CW9ZH3JyaPMFdPTpXa2Q6CdffF2gl1s=", 30 | "owner": "haskell-wasm", 31 | "repo": "ghc-wasm-meta", 32 | "rev": "913a51e58b330f00e3b0ad5b89184cad328ea109", 33 | "type": "gitlab" 34 | }, 35 | "original": { 36 | "host": "gitlab.haskell.org", 37 | "owner": "haskell-wasm", 38 | "repo": "ghc-wasm-meta", 39 | "type": "gitlab" 40 | } 41 | }, 42 | "nixpkgs": { 43 | "locked": { 44 | "lastModified": 1749285348, 45 | "narHash": "sha256-frdhQvPbmDYaScPFiCnfdh3B/Vh81Uuoo0w5TkWmmjU=", 46 | "owner": "NixOS", 47 | "repo": "nixpkgs", 48 | "rev": "3e3afe5174c561dee0df6f2c2b2236990146329f", 49 | "type": "github" 50 | }, 51 | "original": { 52 | "owner": "NixOS", 53 | "ref": "nixos-unstable", 54 | "repo": "nixpkgs", 55 | "type": "github" 56 | } 57 | }, 58 | "root": { 59 | "inputs": { 60 | "flake-utils": [ 61 | "ghc-wasm-meta", 62 | "flake-utils" 63 | ], 64 | "ghc-wasm-meta": "ghc-wasm-meta", 65 | "nixpkgs": [ 66 | "ghc-wasm-meta", 67 | "nixpkgs" 68 | ] 69 | } 70 | }, 71 | "systems": { 72 | "locked": { 73 | "lastModified": 1681028828, 74 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 75 | "owner": "nix-systems", 76 | "repo": "default", 77 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 78 | "type": "github" 79 | }, 80 | "original": { 81 | "owner": "nix-systems", 82 | "repo": "default", 83 | "type": "github" 84 | } 85 | } 86 | }, 87 | "root": "root", 88 | "version": 7 89 | } 90 | -------------------------------------------------------------------------------- /src-wasm/Language/Javascript/JSaddle/Wasm/Internal/TH.hs: -------------------------------------------------------------------------------- 1 | module Language.Javascript.JSaddle.Wasm.Internal.TH 2 | ( eval, 3 | patchedGhcjsHelpers, 4 | ) 5 | where 6 | 7 | import Control.Applicative (asum, many) 8 | import Control.Exception (evaluate) 9 | import Data.ByteString.Lazy.Char8 qualified as BLC8 10 | import Language.Haskell.TH qualified as TH 11 | import Language.Haskell.TH.Syntax qualified as TH 12 | import Language.Javascript.JSaddle.Run.Files qualified as JSaddle.Files 13 | import Regex.List qualified as Re 14 | 15 | eval :: String -> [TH.Q TH.Type] -> TH.Q TH.Exp 16 | eval jsChunk argTys = do 17 | ffiImportName <- TH.newName . show =<< TH.newName "wasm_ffi_import_eval" 18 | sig <- mkSig argTys 19 | let ffiImport = 20 | TH.ForeignD $ 21 | TH.ImportF 22 | TH.JavaScript 23 | TH.Safe 24 | jsChunk 25 | ffiImportName 26 | sig 27 | TH.addTopDecls [ffiImport] 28 | 29 | argNames <- traverse (\_ -> TH.newName "x") argTys 30 | let argPats = TH.varP <$> argNames 31 | argExps = TH.varE <$> argNames 32 | -- Safe FFI imports return a thunk that needs to be evaluated to make sure 33 | -- that the FFI call actually completed ('unsafeInterleaveIO'-like). To avoid 34 | -- surprises, use this unconditionally. 35 | TH.lamE argPats [|evaluate =<< $(TH.appsE $ TH.varE ffiImportName : argExps)|] 36 | where 37 | mkSig = \case 38 | [] -> [t|IO ()|] 39 | t : ts -> [t|$t -> $(mkSig ts)|] 40 | 41 | -- | The JSaddle GHCJS helpers need to be available in the global scope. 42 | -- Usually, this is done by evaluating them in a global scope; however, we want 43 | -- to avoid JS eval (due to CSP, see 44 | -- https://github.com/tweag/ghc-wasm-miso-examples/issues/33), so we instead use 45 | -- a hack, namely transforming 46 | -- 47 | -- > function foo(a) { 48 | -- > return a + 1; 49 | -- > } 50 | -- 51 | -- into 52 | -- 53 | -- > globalThis["foo"] = function(a) { 54 | -- > return a + 1; 55 | -- > } 56 | -- 57 | -- Of course, this only works because of the very particular structure of 58 | -- 'ghcjsHelpers'; but it changes very rarely (didn't change non-trivially in 59 | -- the last 10 years), so this seems acceptable. 60 | patchedGhcjsHelpers :: String 61 | patchedGhcjsHelpers = 62 | Re.replaceAll re $ BLC8.unpack JSaddle.Files.ghcjsHelpers 63 | where 64 | re :: Re.RE Char String 65 | re = 66 | asum 67 | [ f <$> (Re.list "function " *> many (Re.satisfy (/= '('))), 68 | "\n};" <$ Re.list "\n}" 69 | ] 70 | where 71 | f name = "globalThis[" <> show name <> "] = function" 72 | -------------------------------------------------------------------------------- /src-wasm/Language/Javascript/JSaddle/Wasm/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Language.Javascript.JSaddle.Wasm.Internal 4 | ( run, 5 | runWorker, 6 | JSVal, 7 | ) 8 | where 9 | 10 | import Control.Concurrent.STM 11 | import Control.Exception (evaluate) 12 | import Control.Monad ((<=<), (>=>)) 13 | import Data.Aeson qualified as A 14 | import Data.ByteString (ByteString) 15 | import Data.ByteString.Internal qualified as BI 16 | import Data.ByteString.Lazy.Char8 qualified as BLC8 17 | import Data.ByteString.Unsafe qualified as BU 18 | import Foreign.Ptr (Ptr) 19 | import GHC.Wasm.Prim (JSString, JSVal) 20 | import GHC.Wasm.Prim qualified 21 | import Language.Javascript.JSaddle.Run (runJavaScript) 22 | import Language.Javascript.JSaddle.Run.Files qualified as JSaddle.Files 23 | import Language.Javascript.JSaddle.Types (Batch, JSM, Results) 24 | import Language.Javascript.JSaddle.Wasm.Internal.TH qualified as JSaddle.Wasm.TH 25 | 26 | -- Note: It is also possible to implement this succinctly on top of 'runWorker' 27 | -- and 'jsaddleScript' (using MessageChannel), but then e.g. 28 | -- @stopPropagation@/@preventDefault@ don't work, whereas the implementation 29 | -- below has special support via @processResultSync@. 30 | run :: JSM () -> IO () 31 | run entryPoint = do 32 | -- TODO rather use a bounded (even size 1) queue? 33 | outgoingMsgQueue :: TQueue JSString <- newTQueueIO 34 | 35 | let sendOutgoingMessage = 36 | atomically . writeTQueue outgoingMsgQueue 37 | 38 | readBatchCallback <- 39 | mkPushCallback $ atomically $ readTQueue outgoingMsgQueue 40 | 41 | let jsaddleRunner :: JSVal -> JSVal -> IO () 42 | jsaddleRunner processResultCallback processResultSyncCallback = do 43 | let eval :: JSVal -> JSVal -> JSVal -> IO () 44 | eval = 45 | $( do 46 | let s = 47 | BLC8.unlines $ 48 | [ JSaddle.Files.initState, 49 | "var syncDepth = 0;", 50 | "(async () => {", 51 | " while (true) {", 52 | " const batch = JSON.parse(await $3());", 53 | JSaddle.Files.runBatch 54 | (\r -> "$1(JSON.stringify(" <> r <> "));") 55 | (Just \r -> "JSON.parse($2(JSON.stringify(" <> r <> ")))"), 56 | " }", 57 | "})();" 58 | ] 59 | JSaddle.Wasm.TH.eval (BLC8.unpack s) (replicate 3 [t|JSVal|]) 60 | ) 61 | eval 62 | processResultCallback 63 | processResultSyncCallback 64 | readBatchCallback 65 | 66 | $(JSaddle.Wasm.TH.eval JSaddle.Wasm.TH.patchedGhcjsHelpers []) 67 | 68 | runHelper entryPoint sendOutgoingMessage jsaddleRunner 69 | 70 | runWorker :: JSM () -> JSVal -> IO () 71 | runWorker entryPoint worker = 72 | runHelper 73 | entryPoint 74 | (evaluate <=< js_postMessage worker) 75 | (\processResult _processResultSync -> evaluate =<< js_onMessage worker processResult) 76 | 77 | runHelper :: 78 | JSM () -> 79 | -- | How to send an outgoing message. 80 | (JSString -> IO ()) -> 81 | -- | Start receiving incoming messages. For every message, invoke one of the 82 | -- two given 'JSVal' callbacks (for sync/async processing, respectively). 83 | (JSVal -> JSVal -> IO ()) -> 84 | IO () 85 | runHelper entryPoint sendOutgoingMessage onIncomingMessage = do 86 | (processResult, processSyncResult, start) <- 87 | runJavaScript sendBatch entryPoint 88 | 89 | let receiveBatch :: JSString -> IO () 90 | receiveBatch = decodeResults >=> processResult 91 | 92 | processBatchSync :: JSString -> IO JSString 93 | processBatchSync = decodeResults >=> processSyncResult >=> encodeBatch 94 | 95 | processResultCallback <- mkPullCallback receiveBatch 96 | processResultSyncCallback <- mkSyncCallback processBatchSync 97 | 98 | onIncomingMessage processResultCallback processResultSyncCallback 99 | 100 | start 101 | where 102 | sendBatch :: Batch -> IO () 103 | sendBatch = encodeBatch >=> sendOutgoingMessage 104 | 105 | encodeBatch :: Batch -> IO JSString 106 | encodeBatch = byteStringToJSString . BLC8.toStrict . A.encode 107 | 108 | decodeResults :: JSString -> IO Results 109 | decodeResults s = do 110 | bs <- jsStringToByteString s 111 | case A.eitherDecodeStrict bs of 112 | Left e -> fail $ "jsaddle: received invalid JSON: " <> show e 113 | Right r -> pure r 114 | 115 | -- Utilities: 116 | 117 | foreign import javascript "wrapper" mkPullCallback :: (JSString -> IO ()) -> IO JSVal 118 | 119 | foreign import javascript "wrapper sync" mkSyncCallback :: (JSString -> IO JSString) -> IO JSVal 120 | 121 | foreign import javascript "wrapper" mkPushCallback :: IO JSString -> IO JSVal 122 | 123 | -- Worker 124 | 125 | foreign import javascript safe "$1.postMessage({tag: 'jsaddle', msg: $2})" 126 | js_postMessage :: JSVal -> JSString -> IO () 127 | 128 | foreign import javascript safe "$1.addEventListener('message', e => {\ 129 | \const d = e.data;\ 130 | \if (d && typeof d === 'object' && d.tag === 'jsaddle') $2(d.msg);\ 131 | \})" 132 | js_onMessage :: JSVal -> JSVal -> IO () 133 | 134 | -- Conversion JSString <-> ByteString 135 | 136 | foreign import javascript unsafe "$1.length" 137 | js_stringLength :: JSString -> IO Int 138 | 139 | foreign import javascript unsafe "(new TextEncoder()).encodeInto($1, new Uint8Array(__exports.memory.buffer, $2, $3)).written" 140 | js_encodeInto :: JSString -> Ptr a -> Int -> IO Int 141 | 142 | jsStringToByteString :: JSString -> IO ByteString 143 | jsStringToByteString s = do 144 | len <- js_stringLength s 145 | -- see https://developer.mozilla.org/en-US/docs/Web/API/TextEncoder/encodeInto#buffer_sizing 146 | -- (could also use another strategy described there) 147 | let lenMax = len * 3 148 | BI.createUptoN lenMax \buf -> js_encodeInto s buf lenMax 149 | 150 | foreign import javascript unsafe "(new TextDecoder('utf-8', {fatal: true})).decode(new Uint8Array(__exports.memory.buffer, $1, $2))" 151 | js_toJSString :: Ptr a -> Int -> IO JSString 152 | 153 | byteStringToJSString :: ByteString -> IO JSString 154 | byteStringToJSString bs = 155 | BU.unsafeUseAsCStringLen bs $ uncurry js_toJSString 156 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # jsaddle-wasm 2 | [![CI](https://github.com/amesgen/jsaddle-wasm/workflows/CI/badge.svg)](https://github.com/amesgen/jsaddle-wasm/actions) 3 | [![Hackage](https://img.shields.io/hackage/v/jsaddle-wasm)](https://hackage.haskell.org/package/jsaddle-wasm) 4 | [![Haddocks](https://img.shields.io/badge/documentation-Haddocks-purple)](https://hackage.haskell.org/package/jsaddle-wasm/docs/Language-Javascript-JSaddle-Wasm.html) 5 | 6 | Run [JSaddle][] `JSM` actions with the [GHC Wasm backend][]. 7 | 8 | This can for example be used to compile and run [Miso][] or [Reflex][] apps in the browser. 9 | 10 | > [!IMPORTANT] 11 | > This project is in an early stage. 12 | 13 | ## Examples 14 | 15 | - Miso examples: https://github.com/tweag/ghc-wasm-miso-examples 16 | 17 | - Reflex examples: https://github.com/tweag/ghc-wasm-reflex-examples 18 | 19 | - Ormolu Live: https://github.com/tweag/ormolu/tree/master/ormolu-live 20 | (uses the web worker approach described below) 21 | 22 | ## How to use 23 | 24 | Install a Wasm-enabled GHC with support for the Wasm JSFFI (including [synchronous JSFFI exports][sync-jsffi-exports][^missing-sync-jsffi]) from [ghc-wasm-meta][] (GHC 9.10 or newer). 25 | 26 | 27 | Assuming you built your application as an `app :: JSM ()`: 28 | 29 | ```haskell 30 | import Language.Javascript.JSaddle.Wasm qualified as JSaddle.Wasm 31 | 32 | foreign export javascript "hs_start" main :: IO () 33 | 34 | main :: IO () 35 | main = JSaddle.Wasm.run app 36 | ``` 37 | 38 | Build the Wasm binary with the following GHC options: 39 | ```cabal 40 | ghc-options: -no-hs-main -optl-mexec-model=reactor "-optl-Wl,--export=hs_start" 41 | ``` 42 | 43 | Now, run the post-linker script as described in the [GHC User's Guide][ghc-users-guide-js-api]; we will call the resulting JavaScript file `ghc_wasm_jsffi.js`. 44 | 45 | Then, following the [GHC User's Guide][ghc-users-guide-js-api], you can run the Wasm binary in the browser via e.g. [browser_wasi_shim][]: 46 | ```javascript 47 | import { WASI, OpenFile, File, ConsoleStdout } from "@bjorn3/browser_wasi_shim"; 48 | import ghc_wasm_jsffi from "./ghc_wasm_jsffi.js"; 49 | 50 | const fds = [ 51 | new OpenFile(new File([])), // stdin 52 | ConsoleStdout.lineBuffered((msg) => console.log(`[WASI stdout] ${msg}`)), 53 | ConsoleStdout.lineBuffered((msg) => console.warn(`[WASI stderr] ${msg}`)), 54 | ]; 55 | const options = { debug: false }; 56 | const wasi = new WASI([], [], fds, options); 57 | 58 | const instance_exports = {}; 59 | const { instance } = await WebAssembly.instantiateStreaming(fetch("app.wasm"), { 60 | wasi_snapshot_preview1: wasi.wasiImport, 61 | ghc_wasm_jsffi: ghc_wasm_jsffi(instance_exports), 62 | }); 63 | Object.assign(instance_exports, instance.exports); 64 | 65 | wasi.initialize(instance); 66 | await instance.exports.hs_start(); 67 | ``` 68 | 69 | ### Separating execution environments 70 | 71 | 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. 72 | 73 | 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. 74 | 75 | - Instead of the `run` function above, you need to use `runWorker` (again assuming `app :: JSM ()`): 76 | 77 | ```haskell 78 | import Language.Javascript.JSaddle.Wasm qualified as JSaddle.Wasm 79 | 80 | foreign export javascript "hs_runWorker" runWorker :: JSVal -> IO () 81 | 82 | runWorker :: JSVal -> IO () 83 | runWorker = JSaddle.Wasm.runWorker app 84 | ``` 85 | 86 | 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. 87 | 88 | For example, in a web worker, you can initialize the Wasm module as above, and then run 89 | ```javascript 90 | await instance.exports.hs_runWorker(globalThis); 91 | ``` 92 | as `globalThis` (or `self`) in a web worker is a message port. 93 | 94 | - Additionally, you need to run the JSaddle command dispatching logic on the other end of the message port. 95 | 96 | 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. 97 | 98 | It provides a function `runJSaddle` taking a single argument, a message port. 99 | 100 | 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 101 | ```javascript 102 | const worker = new Worker("my-worker.js"); 103 | runJSaddle(worker); 104 | ``` 105 | 106 | Additionally, when other packages use the `Language.Javascript.JSaddle.Wasm.TH` module, you need to disable the `eval-via-jsffi` flag, e.g. by adding the following to your `cabal.project`: 107 | ```cabal 108 | package jsaddle-wasm 109 | flags: -eval-via-jsffi 110 | ``` 111 | 112 | ## Potential future work 113 | 114 | - Testing (e.g. via Selenium). 115 | - Add logging/stats. 116 | - Performance/benchmarking (not clear that this is actually a bottleneck for most applications). 117 | - Optimize existing command-based implementation. 118 | - Reuse buffers 119 | - Use a serialization format more efficient than JSON. 120 | - Patch `jsaddle` to not go through commands, by using the Wasm JS FFI. 121 | - Implement `ghcjs-dom` API directly via the Wasm JS FFI. 122 | 123 | This would involve creating a `ghcjs-dom-wasm` package by adapting the FFI import syntax from `ghcjs-dom-jsffi`/`ghcjs-dom-javascript` appropriately. 124 | 125 | Currently, the generic `ghcjs-dom-jsaddle` seems to work fine, so it seems sensible to wait with this until benchmarks or other concerns motivate this. 126 | 127 | ## Related projects 128 | 129 | - [WebGHC/jsaddle-wasm](https://github.com/WebGHC/jsaddle-wasm) for the analogue for [WebGHC][] instead of the [GHC Wasm backend][]. 130 | 131 | [^missing-sync-jsffi]: Otherwise, you will see errors involving `unknown type name 'HsFUN'`. 132 | 133 | [JSaddle]: https://github.com/ghcjs/jsaddle 134 | [GHC Wasm backend]: https://www.tweag.io/blog/2022-11-22-wasm-backend-merged-in-ghc 135 | [Miso]: https://github.com/dmjio/miso 136 | [Reflex]: https://github.com/reflex-frp/reflex 137 | [ghc-wasm-meta]: https://gitlab.haskell.org/haskell-wasm/ghc-wasm-meta 138 | [browser_wasi_shim]: https://github.com/bjorn3/browser_wasi_shim 139 | [ghc-users-guide-js-api]: https://ghc.gitlab.haskell.org/ghc/doc/users_guide/wasm.html#the-javascript-api 140 | [WebGHC]: https://webghc.github.io 141 | [Channel Messaging API]: https://developer.mozilla.org/en-US/docs/Web/API/Channel_Messaging_API 142 | [sync-jsffi-exports]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13994 143 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Creative Commons Legal Code 2 | 3 | CC0 1.0 Universal 4 | 5 | CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE 6 | LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN 7 | ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS 8 | INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES 9 | REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS 10 | PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM 11 | THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED 12 | HEREUNDER. 13 | 14 | Statement of Purpose 15 | 16 | The laws of most jurisdictions throughout the world automatically confer 17 | exclusive Copyright and Related Rights (defined below) upon the creator 18 | and subsequent owner(s) (each and all, an "owner") of an original work of 19 | authorship and/or a database (each, a "Work"). 20 | 21 | Certain owners wish to permanently relinquish those rights to a Work for 22 | the purpose of contributing to a commons of creative, cultural and 23 | scientific works ("Commons") that the public can reliably and without fear 24 | of later claims of infringement build upon, modify, incorporate in other 25 | works, reuse and redistribute as freely as possible in any form whatsoever 26 | and for any purposes, including without limitation commercial purposes. 27 | These owners may contribute to the Commons to promote the ideal of a free 28 | culture and the further production of creative, cultural and scientific 29 | works, or to gain reputation or greater distribution for their Work in 30 | part through the use and efforts of others. 31 | 32 | For these and/or other purposes and motivations, and without any 33 | expectation of additional consideration or compensation, the person 34 | associating CC0 with a Work (the "Affirmer"), to the extent that he or she 35 | is an owner of Copyright and Related Rights in the Work, voluntarily 36 | elects to apply CC0 to the Work and publicly distribute the Work under its 37 | terms, with knowledge of his or her Copyright and Related Rights in the 38 | Work and the meaning and intended legal effect of CC0 on those rights. 39 | 40 | 1. Copyright and Related Rights. A Work made available under CC0 may be 41 | protected by copyright and related or neighboring rights ("Copyright and 42 | Related Rights"). Copyright and Related Rights include, but are not 43 | limited to, the following: 44 | 45 | i. the right to reproduce, adapt, distribute, perform, display, 46 | communicate, and translate a Work; 47 | ii. moral rights retained by the original author(s) and/or performer(s); 48 | iii. publicity and privacy rights pertaining to a person's image or 49 | likeness depicted in a Work; 50 | iv. rights protecting against unfair competition in regards to a Work, 51 | subject to the limitations in paragraph 4(a), below; 52 | v. rights protecting the extraction, dissemination, use and reuse of data 53 | in a Work; 54 | vi. database rights (such as those arising under Directive 96/9/EC of the 55 | European Parliament and of the Council of 11 March 1996 on the legal 56 | protection of databases, and under any national implementation 57 | thereof, including any amended or successor version of such 58 | directive); and 59 | vii. other similar, equivalent or corresponding rights throughout the 60 | world based on applicable law or treaty, and any national 61 | implementations thereof. 62 | 63 | 2. Waiver. To the greatest extent permitted by, but not in contravention 64 | of, applicable law, Affirmer hereby overtly, fully, permanently, 65 | irrevocably and unconditionally waives, abandons, and surrenders all of 66 | Affirmer's Copyright and Related Rights and associated claims and causes 67 | of action, whether now known or unknown (including existing as well as 68 | future claims and causes of action), in the Work (i) in all territories 69 | worldwide, (ii) for the maximum duration provided by applicable law or 70 | treaty (including future time extensions), (iii) in any current or future 71 | medium and for any number of copies, and (iv) for any purpose whatsoever, 72 | including without limitation commercial, advertising or promotional 73 | purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each 74 | member of the public at large and to the detriment of Affirmer's heirs and 75 | successors, fully intending that such Waiver shall not be subject to 76 | revocation, rescission, cancellation, termination, or any other legal or 77 | equitable action to disrupt the quiet enjoyment of the Work by the public 78 | as contemplated by Affirmer's express Statement of Purpose. 79 | 80 | 3. Public License Fallback. Should any part of the Waiver for any reason 81 | be judged legally invalid or ineffective under applicable law, then the 82 | Waiver shall be preserved to the maximum extent permitted taking into 83 | account Affirmer's express Statement of Purpose. In addition, to the 84 | extent the Waiver is so judged Affirmer hereby grants to each affected 85 | person a royalty-free, non transferable, non sublicensable, non exclusive, 86 | irrevocable and unconditional license to exercise Affirmer's Copyright and 87 | Related Rights in the Work (i) in all territories worldwide, (ii) for the 88 | maximum duration provided by applicable law or treaty (including future 89 | time extensions), (iii) in any current or future medium and for any number 90 | of copies, and (iv) for any purpose whatsoever, including without 91 | limitation commercial, advertising or promotional purposes (the 92 | "License"). The License shall be deemed effective as of the date CC0 was 93 | applied by Affirmer to the Work. Should any part of the License for any 94 | reason be judged legally invalid or ineffective under applicable law, such 95 | partial invalidity or ineffectiveness shall not invalidate the remainder 96 | of the License, and in such case Affirmer hereby affirms that he or she 97 | will not (i) exercise any of his or her remaining Copyright and Related 98 | Rights in the Work or (ii) assert any associated claims and causes of 99 | action with respect to the Work, in either case contrary to Affirmer's 100 | express Statement of Purpose. 101 | 102 | 4. Limitations and Disclaimers. 103 | 104 | a. No trademark or patent rights held by Affirmer are waived, abandoned, 105 | surrendered, licensed or otherwise affected by this document. 106 | b. Affirmer offers the Work as-is and makes no representations or 107 | warranties of any kind concerning the Work, express, implied, 108 | statutory or otherwise, including without limitation warranties of 109 | title, merchantability, fitness for a particular purpose, non 110 | infringement, or the absence of latent or other defects, accuracy, or 111 | the present or absence of errors, whether or not discoverable, all to 112 | the greatest extent permissible under applicable law. 113 | c. Affirmer disclaims responsibility for clearing rights of other persons 114 | that may apply to the Work or any use thereof, including without 115 | limitation any person's Copyright and Related Rights in the Work. 116 | Further, Affirmer disclaims responsibility for obtaining any necessary 117 | consents, permissions or other rights required for any use of the 118 | Work. 119 | d. Affirmer understands and acknowledges that Creative Commons is not a 120 | party to this document and has no duty or obligation with respect to 121 | this CC0 or use of the Work. 122 | --------------------------------------------------------------------------------