Cheng Shao pushed to branch wip/wasm-ghci-file-server at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • compiler/GHC/Driver/Config/Interpreter.hs
    ... ... @@ -30,6 +30,7 @@ initInterpOpts dflags = do
    30 30 
         , interpBrowser = gopt Opt_GhciBrowser dflags
    31 31 
         , interpBrowserHost = ghciBrowserHost dflags
    32 32 
         , interpBrowserPort = ghciBrowserPort dflags
    33 
    +    , interpBrowserAssetsDir = ghciBrowserAssetsDir dflags
    33 34 
         , interpBrowserRedirectWasiConsole = gopt Opt_GhciBrowserRedirectWasiConsole dflags
    34 35 
         , interpBrowserPuppeteerLaunchOpts = ghciBrowserPuppeteerLaunchOpts dflags
    35 36 
         , interpBrowserPlaywrightBrowserType = ghciBrowserPlaywrightBrowserType dflags
    ... ... @@ -43,4 +44,3 @@ initInterpOpts dflags = do
    43 44 
         , interpCcConfig = configureCc dflags
    44 45 
         , interpExecutableLinkOpts = initExecutableLinkOpts dflags Dynamic
    45 46 
         }
    46 
    -

  • compiler/GHC/Driver/DynFlags.hs
    ... ... @@ -426,6 +426,7 @@ data DynFlags = DynFlags {
    426 426 
       -- wasm ghci browser mode
    427 427 
       ghciBrowserHost                  :: !String,
    428 428 
       ghciBrowserPort                  :: !Int,
    429 
    +  ghciBrowserAssetsDir             :: !(Maybe FilePath),
    429 430 
       ghciBrowserPuppeteerLaunchOpts   :: !(Maybe String),
    430 431 
       ghciBrowserPlaywrightBrowserType :: !(Maybe String),
    431 432 
       ghciBrowserPlaywrightLaunchOpts  :: !(Maybe String),
    ... ... @@ -727,6 +728,7 @@ defaultDynFlags mySettings =
    727 728
    728 729 
             ghciBrowserHost = "127.0.0.1",
    729 730 
             ghciBrowserPort = 0,
    731 
    +        ghciBrowserAssetsDir = Nothing,
    730 732 
             ghciBrowserPuppeteerLaunchOpts = Nothing,
    731 733 
             ghciBrowserPlaywrightBrowserType = Nothing,
    732 734 
             ghciBrowserPlaywrightLaunchOpts = Nothing,

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -1896,6 +1896,8 @@ dynamic_flags_deps = [
    1896 1896 
           $ hasArg $ \f d -> d { ghciBrowserHost = f }
    1897 1897 
       , make_ord_flag defGhciFlag "fghci-browser-port"
    1898 1898 
           $ intSuffix $ \n d -> d { ghciBrowserPort = n }
    1899 
    +  , make_ord_flag defGhciFlag "fghci-browser-assets-dir"
    1900 
    +      $ hasArg $ \f d -> d { ghciBrowserAssetsDir = Just f }
    1899 1901 
       , make_ord_flag defGhciFlag "fghci-browser-puppeteer-launch-opts"
    1900 1902 
           $ hasArg $ \f d -> d { ghciBrowserPuppeteerLaunchOpts = Just f }
    1901 1903 
       , make_ord_flag defGhciFlag "fghci-browser-playwright-browser-type"

  • compiler/GHC/Runtime/Interpreter/Init.hs
    ... ... @@ -49,6 +49,7 @@ data InterpOpts = InterpOpts
    49 49 
       , interpBrowser :: Bool
    50 50 
       , interpBrowserHost :: String
    51 51 
       , interpBrowserPort :: Int
    52 
    +  , interpBrowserAssetsDir :: !(Maybe FilePath)
    52 53 
       , interpBrowserRedirectWasiConsole :: Bool
    53 54 
       , interpBrowserPuppeteerLaunchOpts :: Maybe String
    54 55 
       , interpBrowserPlaywrightBrowserType :: Maybe String
    ... ... @@ -89,6 +90,7 @@ initInterpreter dflags tmpfs logger platform finder_cache unit_env opts = do
    89 90 
                     , wasmInterpBrowser = interpBrowser opts
    90 91 
                     , wasmInterpBrowserHost = interpBrowserHost opts
    91 92 
                     , wasmInterpBrowserPort = interpBrowserPort opts
    93 
    +                , wasmInterpBrowserAssetsDir = interpBrowserAssetsDir opts
    92 94 
                     , wasmInterpBrowserRedirectWasiConsole = interpBrowserRedirectWasiConsole opts
    93 95 
                     , wasmInterpBrowserPuppeteerLaunchOpts = interpBrowserPuppeteerLaunchOpts opts
    94 96 
                     , wasmInterpBrowserPlaywrightBrowserType = interpBrowserPlaywrightBrowserType opts

  • compiler/GHC/Runtime/Interpreter/Types.hs
    ... ... @@ -220,6 +220,7 @@ data WasmInterpConfig = WasmInterpConfig
    220 220 
       , wasmInterpBrowser                      :: !Bool
    221 221 
       , wasmInterpBrowserHost                  :: !String
    222 222 
       , wasmInterpBrowserPort                  :: !Int
    223 
    +  , wasmInterpBrowserAssetsDir             :: !(Maybe FilePath)
    223 224 
       , wasmInterpBrowserRedirectWasiConsole   :: !Bool
    224 225 
       , wasmInterpBrowserPuppeteerLaunchOpts   :: !(Maybe String)
    225 226 
       , wasmInterpBrowserPlaywrightBrowserType :: !(Maybe String)

  • compiler/GHC/Runtime/Interpreter/Wasm.hs
    ... ... @@ -52,6 +52,7 @@ spawnWasmInterp WasmInterpConfig {..} = do
    52 52 
       let dyld_env =
    53 53 
             [("GHCI_BROWSER", "1") | wasmInterpBrowser]
    54 54 
             ++ [("GHCI_BROWSER_HOST", wasmInterpBrowserHost), ("GHCI_BROWSER_PORT", show wasmInterpBrowserPort)]
    55 
    +        ++ [("GHCI_BROWSER_ASSETS_DIR", f) | f <- maybeToList wasmInterpBrowserAssetsDir]
    55 56 
             ++ [("GHCI_BROWSER_REDIRECT_WASI_CONSOLE", "1") | wasmInterpBrowserRedirectWasiConsole]
    56 57 
             ++ [("GHCI_BROWSER_PUPPETEER_LAUNCH_OPTS", f) | f <- maybeToList wasmInterpBrowserPuppeteerLaunchOpts]
    57 58 
             ++ [("GHCI_BROWSER_PLAYWRIGHT_BROWSER_TYPE", f) | f <- maybeToList wasmInterpBrowserPlaywrightBrowserType]

  • docs/users_guide/wasm.rst
    ... ... @@ -193,6 +193,18 @@ See below for other optional GHC flags of wasm ghci browser mode:
    193 193 
         Specify the port that the ``dyld`` HTTP server should listen on.
    194 194 
         Defaults to a random idle port.
    195 195
    196 
    +.. ghc-flag:: -fghci-browser-assets-dir
    197 
    +    :shortdesc: User-specified assets root directory
    198 
    +    :type: dynamic
    199 
    +
    200 
    +    :default: ``$PWD``
    201 
    +
    202 
    +    The HTTP server also exposes an ``/assets`` endpoint that allows
    203 
    +    the users to fetch custom assets with sensible default MIME type,
    204 
    +    e.g. `http://127.0.0.1:8080/assets/index.html` would fetch
    205 
    +    `index.html` in the assets root directory with ``text/html`` MIME
    206 
    +    type.
    207 
    +
    196 208 
     .. ghc-flag:: -fghci-browser-redirect-wasi-console
    197 209 
         :shortdesc: Redirect wasi console stdout/stderr back to host ghci.
    198 210 
         :type: dynamic

  • utils/jsffi/dyld.mjs
    ... ... @@ -560,6 +560,7 @@ export class DyLDRPC {
    560 560
    561 561 
     // Actual implementation of endpoints used by DyLDRPC
    562 562 
     class DyLDRPCServer {
    563 
    +  #mimeDb;
    563 564 
       #dyldHost;
    564 565 
       #server;
    565 566 
       #wss;
    ... ... @@ -567,6 +568,7 @@ class DyLDRPCServer {
    567 568 
       constructor({
    568 569 
         host,
    569 570 
         port,
    571 
    +    assetsDir,
    570 572 
         dyldPath,
    571 573 
         searchDirs,
    572 574 
         mainSoPath,
    ... ... @@ -575,6 +577,20 @@ class DyLDRPCServer {
    575 577 
         args,
    576 578 
         redirectWasiConsole,
    577 579 
       }) {
    580 
    +    this.#mimeDb = fetch("https://cdn.jsdelivr.net/npm/mime-db@1.54.0/db.json")
    581 
    +      .then((resp) => resp.json())
    582 
    +      .then((db) => {
    583 
    +        const ext2mime = {};
    584 
    +        for (const mime in db) {
    585 
    +          if (db[mime].extensions) {
    586 
    +            for (const ext of db[mime].extensions) {
    587 
    +              ext2mime[`.${ext}`] = mime;
    588 
    +            }
    589 
    +          }
    590 
    +        }
    591 
    +        return ext2mime;
    592 
    +      });
    593 
    +
    578 594 
         this.#dyldHost = new DyLDHost({ outFd, inFd });
    579 595
    580 596 
         this.#server = http.createServer(async (req, res) => {
    ... ... @@ -634,6 +650,33 @@ args.rpc.opened.then(() => main(args));
    634 650 
             return;
    635 651 
           }
    636 652
    653 
    +      if (req.url.startsWith("/assets")) {
    654 
    +        const p = path.resolve(
    655 
    +          assetsDir,
    656 
    +          new URL(req.url, origin).pathname.replace("/assets/", ""),
    657 
    +        );
    658 
    +        try {
    659 
    +          await fs.promises.access(p, fs.promises.constants.R_OK);
    660 
    +
    661 
    +          res.setHeader(
    662 
    +            "Content-Type",
    663 
    +            (await this.#mimeDb)[path.extname(p)] || "application/octet-stream",
    664 
    +          );
    665 
    +
    666 
    +          res.setHeader("Cache-Control", "no-cache, no-store, must-revalidate");
    667 
    +
    668 
    +          res.writeHead(200);
    669 
    +          fs.createReadStream(p).pipe(res);
    670 
    +        } catch {
    671 
    +          res.writeHead(404, {
    672 
    +            "Content-Type": "text/plain",
    673 
    +          });
    674 
    +          res.end("not found");
    675 
    +        }
    676 
    +
    677 
    +        return;
    678 
    +      }
    679 
    +
    637 680 
           if (req.url.startsWith("/rpc")) {
    638 681 
             const endpoint = req.url.replace("/rpc/", "");
    639 682
    ... ... @@ -1373,6 +1416,7 @@ async function nodeMain({ searchDirs, mainSoPath, outFd, inFd, args }) {
    1373 1416 
       const server = new DyLDRPCServer({
    1374 1417 
         host: process.env.GHCI_BROWSER_HOST || "127.0.0.1",
    1375 1418 
         port: process.env.GHCI_BROWSER_PORT || 0,
    1419 
    +    assetsDir: process.env.GHCI_BROWSER_ASSETS_DIR || process.cwd(),
    1376 1420 
         dyldPath: import.meta.filename,
    1377 1421 
         searchDirs,
    1378 1422 
         mainSoPath,

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help