testsuite: add browser001 test for wasm ghci browser mode

This commit adds support for testing the wasm ghci browser mode in the
testsuite, as well as a simple first test case browser001 that makes
use of TH, JSFFI and browser-specific DOM API. See added note and
comments for details.

testsuite/tests/ghci-browser/all.T

+# Note [Testing wasm ghci browser mode]
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#
+# Wasm ghci browser mode supports connecting with a user-controlled
+# browser tab or an automated headless browser tab. The wasm dyld
+# script supports using puppeteer/playwright to launch the headless
+# browser, and this can be used either interactively by the user, or
+# fully automatically when running the GHC testsuite.
+#
+# The first issue is deciding whether to run these tests at all, even
+# when we're indeed testing the wasm32 target! The user may be using
+# nodejs without the optional npm dependencies needed to make browser
+# mode works, and it's non-trivial to probe browser installations and
+# infer the right puppeteer/playwright launch options.
+#
+# We must ensure the testsuite is still green when browser mode isn't
+# supported, therefore we don't do anything fancy here. These browser
+# tests are opt-in, the user must explicitly set environment variables
+# like FIREFOX_LAUNCH_OPTS to test a specific browser. These variables
+# are *not* handled by the wasm dyld script to avoid confusion, the
+# test runner is in charge of setting the right flags to invoke ghci.
+#
+# The next issue is #25415. The testsuite driver has more than a dozen
+# different functions to "run something", some of which inserts a
+# target wrapper, some of which doesn't, all without knowing if the
+# thing to be run is a host or target thing! For instance, attempting
+# to define these tests as ghci_script would result in the driver
+# attempting to launch host ghci using the wasm interpreter. The same
+# issue exists in many places other than ghci_script, and while the
+# situation ought to be fixed, that is undoubtedly scope creep that
+# belongs to a standalone chunk of work.
+#
+# To ensure wasm ghci browser mode is tested in CI without further
+# complicating the testsuite driver, I choose to avoid any
+# modifications to the driver and global config. So it's best to just
+# define our own ghci_browser test function solely in this file, it
+# does its job well for our rather specific use case.
+
+setTestOpts(
+  [
+    unless(arch("wasm32"), skip),
+    high_memory_usage,
+    only_ways(["ghci", "ghci-opt"]),
+    extra_ways(["ghci", "ghci-opt"]),
+  ]
+)
+
+
+# you can pass more arguments here; the additional argument list is
+# the last argument of test() calls. see do_test function in the
+# driver and how it invokes the func argument for details.
+async def ghci_browser(name_with_browser, way):
+  nb = name_with_browser.rsplit("-", 1)
+  name = nb[0]
+  browser = nb[1]
+
+  opts = getTestOpts()
+
+  way_flags = " ".join(config.way_flags[way])
+  flags = " ".join(get_compiler_flags())
+
+  if browser == "firefox":
+    o = ghc_env["FIREFOX_LAUNCH_OPTS"]
+    env_flags = f"GHCI_BROWSER=1 GHCI_BROWSER_PUPPETEER_LAUNCH_OPTS='{o}'"
+  elif browser == "chrome":
+    o = ghc_env["CHROME_LAUNCH_OPTS"]
+    env_flags = f"GHCI_BROWSER=1 GHCI_BROWSER_PUPPETEER_LAUNCH_OPTS='{o}'"
+  else:
+    assert browser == "webkit"
+    o = ghc_env["WEBKIT_LAUNCH_OPTS"]
+    env_flags = f"GHCI_BROWSER=1 GHCI_BROWSER_PLAYWRIGHT_BROWSER_TYPE=webkit GHCI_BROWSER_PLAYWRIGHT_LAUNCH_OPTS='{o}'"
+
+  # ghci_script formats the command then calls simple_run. simple_run
+  # formats the command then calls runCmdPerf. runCmdPerf formats the
+  # command and calls runCmd. runCmd formats the command then calls
+  # the timeout program that calls /bin/sh which does another layer of
+  # formatting. good luck making your command containing a json
+  # payload to survive how many layers of pure insanity.
+  cmd = (
+    f"cd '{opts.testdir}' && "
+    + env_flags.replace("{", "{{").replace("}", "}}")
+    + f" {{compiler}} {way_flags} {flags} {opts.extra_run_opts}"
+  )
+
+  exit_code = await runCmd(
+    cmd,
+    stdin=in_testdir(name, "script"),
+    stdout=in_testdir(name, "run.stdout"),
+    stderr=in_testdir(name, "run.stderr"),
+    timeout_multiplier=opts.run_timeout_multiplier,
+  )
+
+  if exit_code != opts.exit_code:
+    if config.verbose >= 1:
+      print(
+        f"Wrong exit code for {name_with_browser}({way})(expected {opts.exit_code}, actual {exit_code})",
+      )
+      dump_stdout(name)
+      dump_stderr(name)
+    message = format_bad_exit_code_message(exit_code)
+    return failBecause(message)
+
+  # don't handle stderr for now, i don't wanna write a filter for the
+  # js stack traces
+  if not (await stdout_ok(name, way)):
+    return failBecause(
+      "bad stdout", stderr=read_stderr(name), stdout=read_stdout(name)
+    )
+
+  return passed()
+
+
+# for browser001 we generate tests like browser001-firefox, but we
+# don't want to have duplicate script/stdout files in tree since the
+# behavior should be coherent across all browsers. hence this layer of
+# indirection: the rest of the test driver recognizes
+# browser001-firefox as test name, though we explicitly add
+# browser001.script/browser001.stdout as extra_files to ensure they're
+# copied, and ghci_browser would properly make use of them.
+def browser_test(name, setup, func, args):
+  for browser in ["firefox", "chrome", "webkit"]:
+    test(
+      f"{name}-{browser}",
+      [
+        unless(f"{browser.upper()}_LAUNCH_OPTS" in ghc_env, skip),
+        extra_files([f"{name}.script", f"{name}.stdout"]),
+      ]
+      + setup,
+      func,
+      args,
+    )
+
+
+browser_test("browser001", [], ghci_browser, [])

testsuite/tests/ghci-browser/browser001.script

+import Language.Haskell.TH
+
+:{
+genFib :: Int -> Q Exp
+genFib n =
+  pure $
+    LamCaseE
+      [ Match (LitP $ IntegerL $ fromIntegral i) (NormalB $ LitE $ IntegerL r) []
+      | (i, r) <- zip [0 .. n] fibs
+      ]
+  where
+    fibs = 0 : 1 : zipWith (+) fibs (drop 1 fibs)
+:}
+
+:set -XTemplateHaskell
+
+:{
+fib :: Int -> Integer
+fib = $(genFib 100)
+:}
+
+fib 100
+
+foreign import javascript "new Promise(res => setTimeout(() => res($2), $1))" foo :: Int -> Int -> IO Int
+
+foo 1024 114514
+
+foreign import javascript "non_existent()" bar :: Int
+
+import Control.Exception
+import GHC.Wasm.Prim
+
+catch (print bar) $ \(_ :: JSException) -> putStrLn "exception caught, life goes on"
+
+newtype JSButton = JSButton JSVal
+
+newtype JSCallback t = JSCallback JSVal
+
+foreign import javascript unsafe "document.createElement('button')" js_button_create :: IO JSButton
+foreign import javascript unsafe "document.body.appendChild($1)" js_button_setup :: JSButton -> IO ()
+
+btn <- js_button_create
+js_button_setup
+
+foreign import javascript unsafe "$1.textContent" js_button_get_text :: JSButton -> IO JSString
+foreign import javascript unsafe "$1.textContent = $2;" js_button_set_text :: JSButton -> JSString -> IO ()
+
+js_button_set_text btn $ toJSString "1919810"
+
+foreign import javascript "wrapper sync" syncCallback :: IO () -> IO (JSCallback (IO ()))
+foreign import javascript unsafe "$1.addEventListener('click', $2)" js_button_on_click :: JSButton -> JSCallback (IO ()) -> IO ()
+
+cb <- syncCallback $ do { lbl <- fromJSString <$> js_button_get_text btn; print lbl }
+js_button_on_click btn cb
+
+foreign import javascript unsafe "$1.click()" js_button_click :: JSButton -> IO ()
+
+js_button_click btn

testsuite/tests/ghci-browser/browser001.stdout

+354224848179261915075
+114514
+exception caught, life goes on
+"1919810"