{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module GHC.Runtime.Interpreter.Wasm (spawnWasmInterp) where

import GHC.Prelude
import GHC.Runtime.Interpreter.Types

#if !defined(mingw32_HOST_OS)

import Control.Concurrent.MVar
import Data.Maybe
import GHC.Data.FastString
import qualified GHC.Data.ShortText as ST
import GHC.Platform
import GHC.Unit
import GHCi.Message
import System.Directory
import System.Environment.Blank
import System.IO
import qualified System.Posix.IO as Posix
import System.Process

#else

import GHC.Utils.Panic

#endif

spawnWasmInterp :: WasmInterpConfig -> IO (ExtInterpInstance ())

#if !defined(mingw32_HOST_OS)

-- See Note [The Wasm Dynamic Linker] for details
spawnWasmInterp :: WasmInterpConfig -> IO (ExtInterpInstance ())
spawnWasmInterp WasmInterpConfig {Bool
Int
String
[String]
Maybe String
Platform
UnitState
wasmInterpDyLD :: String
wasmInterpLibDir :: String
wasmInterpOpts :: [String]
wasmInterpBrowser :: Bool
wasmInterpBrowserHost :: String
wasmInterpBrowserPort :: Int
wasmInterpBrowserRedirectWasiConsole :: Bool
wasmInterpBrowserPuppeteerLaunchOpts :: Maybe String
wasmInterpBrowserPlaywrightBrowserType :: Maybe String
wasmInterpBrowserPlaywrightLaunchOpts :: Maybe String
wasmInterpTargetPlatform :: Platform
wasmInterpProfiled :: Bool
wasmInterpHsSoSuffix :: String
wasmInterpUnitState :: UnitState
wasmInterpUnitState :: WasmInterpConfig -> UnitState
wasmInterpHsSoSuffix :: WasmInterpConfig -> String
wasmInterpProfiled :: WasmInterpConfig -> Bool
wasmInterpTargetPlatform :: WasmInterpConfig -> Platform
wasmInterpBrowserPlaywrightLaunchOpts :: WasmInterpConfig -> Maybe String
wasmInterpBrowserPlaywrightBrowserType :: WasmInterpConfig -> Maybe String
wasmInterpBrowserPuppeteerLaunchOpts :: WasmInterpConfig -> Maybe String
wasmInterpBrowserRedirectWasiConsole :: WasmInterpConfig -> Bool
wasmInterpBrowserPort :: WasmInterpConfig -> Int
wasmInterpBrowserHost :: WasmInterpConfig -> String
wasmInterpBrowser :: WasmInterpConfig -> Bool
wasmInterpOpts :: WasmInterpConfig -> [String]
wasmInterpLibDir :: WasmInterpConfig -> String
wasmInterpDyLD :: WasmInterpConfig -> String
..} = do
  let Just UnitId
ghci_unit_id =
        UnitState -> PackageName -> Maybe UnitId
lookupPackageName
          UnitState
wasmInterpUnitState
          (FastString -> PackageName
PackageName (FastString -> PackageName) -> FastString -> PackageName
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"ghci")
      ghci_unit_info :: UnitInfo
ghci_unit_info = HasDebugCallStack => UnitState -> UnitId -> UnitInfo
UnitState -> UnitId -> UnitInfo
unsafeLookupUnitId UnitState
wasmInterpUnitState UnitId
ghci_unit_id
      ghci_so_dirs :: [String]
ghci_so_dirs = (FilePathST -> String) -> [FilePathST] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FilePathST -> String
ST.unpack ([FilePathST] -> [String]) -> [FilePathST] -> [String]
forall a b. (a -> b) -> a -> b
$ UnitInfo -> [FilePathST]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [FilePathST]
unitLibraryDynDirs UnitInfo
ghci_unit_info
      [String
ghci_lib_name] = (FilePathST -> String) -> [FilePathST] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FilePathST -> String
ST.unpack ([FilePathST] -> [String]) -> [FilePathST] -> [String]
forall a b. (a -> b) -> a -> b
$ UnitInfo -> [FilePathST]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [FilePathST]
unitLibraries UnitInfo
ghci_unit_info
      ghci_so_name :: String
ghci_so_name = String
ghci_lib_name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wasmInterpHsSoSuffix
      ghci_so_file :: String
ghci_so_file = Platform -> String -> String
platformHsSOName Platform
wasmInterpTargetPlatform String
ghci_so_name
  Just ghci_so_path <- [String] -> String -> IO (Maybe String)
findFile [String]
ghci_so_dirs String
ghci_so_file
  (rfd1, wfd1) <- Posix.createPipe
  (rfd2, wfd2) <- Posix.createPipe
  Posix.setFdOption rfd1 Posix.CloseOnExec True
  Posix.setFdOption wfd2 Posix.CloseOnExec True
  ghc_env <- getEnvironment
  let dyld_env =
        [(String
"GHCI_BROWSER", String
"1") | Bool
wasmInterpBrowser]
        [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String
"GHCI_BROWSER_HOST", String
wasmInterpBrowserHost), (String
"GHCI_BROWSER_PORT", Int -> String
forall a. Show a => a -> String
show Int
wasmInterpBrowserPort)]
        [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String
"GHCI_BROWSER_REDIRECT_WASI_CONSOLE", String
"1") | Bool
wasmInterpBrowserRedirectWasiConsole]
        [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String
"GHCI_BROWSER_PUPPETEER_LAUNCH_OPTS", String
f) | String
f <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
wasmInterpBrowserPuppeteerLaunchOpts]
        [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String
"GHCI_BROWSER_PLAYWRIGHT_BROWSER_TYPE", String
f) | String
f <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
wasmInterpBrowserPlaywrightBrowserType]
        [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String
"GHCI_BROWSER_PLAYWRIGHT_LAUNCH_OPTS", String
f) | String
f <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
wasmInterpBrowserPlaywrightLaunchOpts]
        [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
ghc_env
  (_, _, _, ph) <-
    createProcess
      ( proc wasmInterpDyLD $
          [wasmInterpLibDir, ghci_so_path, show wfd1, show rfd2]
            ++ wasmInterpOpts
            ++ ["+RTS", "-H64m", "-RTS"]
      ) { env = Just dyld_env }
  Posix.closeFd wfd1
  Posix.closeFd rfd2
  rh <- Posix.fdToHandle rfd1
  wh <- Posix.fdToHandle wfd2
  hSetBuffering wh NoBuffering
  hSetBuffering rh NoBuffering
  interpPipe <- mkPipeFromHandles rh wh
  pending_frees <- newMVar []
  lock <- newMVar ()
  pure
    $ ExtInterpInstance
      { instProcess =
          InterpProcess
            { interpHandle = ph,
              interpPipe,
              interpLock = lock
            },
        instPendingFrees = pending_frees,
        instExtra = ()
      }

#else

-- Due to difficulty of using inherited pipe file descriptor in
-- nodejs, unfortunately we don't support Win32 host yet
spawnWasmInterp _ = sorry "Wasm iserv doesn't work on Win32 host yet"

#endif