-- | 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 :: ByteString
jsaddleScript =
  [ByteString] -> ByteString
BLC8.unlines
    [ ByteString
JSaddle.Files.ghcjsHelpers,
      ByteString
JSaddle.Files.initState,
      ByteString
"function runJSaddle(worker) {",
      ByteString
"  worker.addEventListener('message', e => {",
      ByteString
"    const d = e.data;",
      ByteString
"    if (d && typeof d === 'object' && d.tag === 'jsaddle') {",
      ByteString
"      const batch = JSON.parse(d.msg);",
      (ByteString -> ByteString)
-> Maybe (ByteString -> ByteString) -> ByteString
JSaddle.Files.runBatch
        (\ByteString
r -> ByteString
"worker.postMessage({tag: 'jsaddle', msg: JSON.stringify(" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
")});")
        -- not clear how to support synchronous dispatch here
        Maybe (ByteString -> ByteString)
forall a. Maybe a
Nothing,
      ByteString
"    }",
      ByteString
"  });",
      ByteString
"}"
    ]