{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Runtime.Interpreter.JS
( spawnJSInterp
, jsLinkRts
, jsLinkInterp
, jsLinkObject
, jsLinkObjects
, jsLoadFile
, jsRunServer
, mkExportedModFuns
)
where
import GHC.Prelude
import GHC.Runtime.Interpreter.Types
import GHC.Runtime.Interpreter.Process
import GHC.Runtime.Utils
import GHCi.Message
import GHC.StgToJS.Linker.Types
import GHC.StgToJS.Linker.Linker
import GHC.StgToJS.Types
import GHC.StgToJS.Object
import GHC.Unit.Env
import GHC.Unit.Types
import GHC.Unit.State
import GHC.Utils.Logger
import GHC.Utils.TmpFs
import GHC.Utils.Panic
import GHC.Utils.Error (logInfo)
import GHC.Utils.Outputable (text)
import GHC.Data.FastString
import Control.Concurrent
import Control.Monad
import System.Process
import System.IO
import System.FilePath
import Data.IORef
import qualified Data.Set as Set
import qualified Data.ByteString as B
import Foreign.C.String
startTHRunnerProcess :: FilePath -> NodeJsSettings -> IO (Handle,InterpProcess)
startTHRunnerProcess :: FilePath -> NodeJsSettings -> IO (Handle, InterpProcess)
startTHRunnerProcess FilePath
interp_js NodeJsSettings
settings = do
interp_in <- Handle -> IO (IORef Handle)
forall a. a -> IO (IORef a)
newIORef Handle
forall a. HasCallStack => a
undefined
let createProc CreateProcess
cp = do
let cp' :: CreateProcess
cp' = CreateProcess
cp
{ std_in = CreatePipe
, std_out = Inherit
, std_err = Inherit
}
(mb_in, _mb_out, _mb_err, hdl) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cp'
case mb_in of
Maybe Handle
Nothing -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
panic FilePath
"startTHRunnerProcess: expected stdin for interpreter"
Just Handle
i -> IORef Handle -> Handle -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Handle
interp_in Handle
i
return hdl
(hdl, rh, wh) <- runWithPipes createProc (nodeProgram settings)
[interp_js]
(nodeExtraArgs settings)
std_in <- readIORef interp_in
lo_ref <- newIORef Nothing
lock <- newMVar ()
let pipe = Pipe { pipeRead :: Handle
pipeRead = Handle
rh, pipeWrite :: Handle
pipeWrite = Handle
wh, pipeLeftovers :: IORef (Maybe ByteString)
pipeLeftovers = IORef (Maybe ByteString)
lo_ref }
let proc = InterpProcess
{ interpHandle :: ProcessHandle
interpHandle = ProcessHandle
hdl
, interpPipe :: Pipe
interpPipe = Pipe
pipe
, interpLock :: MVar ()
interpLock = MVar ()
lock
}
pure (std_in, proc)
spawnJSInterp :: JSInterpConfig -> IO (ExtInterpInstance JSInterpExtra)
spawnJSInterp :: JSInterpConfig -> IO (ExtInterpInstance JSInterpExtra)
spawnJSInterp JSInterpConfig
cfg = do
let logger :: Logger
logger= JSInterpConfig -> Logger
jsInterpLogger JSInterpConfig
cfg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Logger -> Int -> Bool
logVerbAtLeast Logger
logger Int
2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger -> SDoc -> IO ()
logInfo Logger
logger (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Spawning JS interpreter")
let tmpfs :: TmpFs
tmpfs = JSInterpConfig -> TmpFs
jsInterpTmpFs JSInterpConfig
cfg
tmp_dir :: TempDir
tmp_dir = JSInterpConfig -> TempDir
jsInterpTmpDir JSInterpConfig
cfg
logger :: Logger
logger = JSInterpConfig -> Logger
jsInterpLogger JSInterpConfig
cfg
codegen_cfg :: StgToJSConfig
codegen_cfg = JSInterpConfig -> StgToJSConfig
jsInterpCodegenCfg JSInterpConfig
cfg
unit_env :: UnitEnv
unit_env = JSInterpConfig -> UnitEnv
jsInterpUnitEnv JSInterpConfig
cfg
finder_opts :: FinderOpts
finder_opts = JSInterpConfig -> FinderOpts
jsInterpFinderOpts JSInterpConfig
cfg
finder_cache :: FinderCache
finder_cache = JSInterpConfig -> FinderCache
jsInterpFinderCache JSInterpConfig
cfg
(std_in, proc) <- FilePath -> NodeJsSettings -> IO (Handle, InterpProcess)
startTHRunnerProcess (JSInterpConfig -> FilePath
jsInterpScript JSInterpConfig
cfg) (JSInterpConfig -> NodeJsSettings
jsInterpNodeConfig JSInterpConfig
cfg)
js_state <- newMVar (JSState
{ jsLinkState = emptyLinkPlan
, jsServerStarted = False
})
ghci_unit_id <- case lookupPackageName (ue_units unit_env) (PackageName (fsLit "ghci")) of
Maybe UnitId
Nothing -> FilePath -> IO UnitId
forall a. FilePath -> IO a
cmdLineErrorIO FilePath
"JS interpreter: couldn't find \"ghci\" package"
Just UnitId
i -> UnitId -> IO UnitId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnitId
i
let extra = JSInterpExtra
{ instStdIn :: Handle
instStdIn = Handle
std_in
, instJSState :: MVar JSState
instJSState = MVar JSState
js_state
, instFinderCache :: FinderCache
instFinderCache = FinderCache
finder_cache
, instFinderOpts :: FinderOpts
instFinderOpts = FinderOpts
finder_opts
, instGhciUnitId :: UnitId
instGhciUnitId = UnitId
ghci_unit_id
}
pending_frees <- newMVar []
let inst = ExtInterpInstance
{ instProcess :: InterpProcess
instProcess = InterpProcess
proc
, instPendingFrees :: MVar [HValueRef]
instPendingFrees = MVar [HValueRef]
pending_frees
, instExtra :: JSInterpExtra
instExtra = JSInterpExtra
extra
}
jsLinkRts logger tmpfs tmp_dir codegen_cfg unit_env inst
jsLinkInterp logger tmpfs tmp_dir codegen_cfg unit_env inst
jsRunServer inst
pure inst
jsLinkRts :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> IO ()
jsLinkRts :: Logger
-> TmpFs
-> TempDir
-> StgToJSConfig
-> UnitEnv
-> ExtInterpInstance JSInterpExtra
-> IO ()
jsLinkRts Logger
logger TmpFs
tmpfs TempDir
tmp_dir StgToJSConfig
cfg UnitEnv
unit_env ExtInterpInstance JSInterpExtra
inst = do
let link_cfg :: JSLinkConfig
link_cfg = JSLinkConfig
{ lcNoStats :: Bool
lcNoStats = Bool
True
, lcNoRts :: Bool
lcNoRts = Bool
False
, lcCombineAll :: Bool
lcCombineAll = Bool
False
, lcForeignRefs :: Bool
lcForeignRefs = Bool
False
, lcNoJSExecutables :: Bool
lcNoJSExecutables = Bool
True
, lcNoHsMain :: Bool
lcNoHsMain = Bool
True
, lcForceEmccRts :: Bool
lcForceEmccRts = Bool
False
, lcLinkCsources :: Bool
lcLinkCsources = Bool
False
}
let link_spec :: LinkSpec
link_spec = LinkSpec
{ lks_unit_ids :: [UnitId]
lks_unit_ids = [UnitId
rtsUnitId, UnitId
ghcInternalUnitId, UnitId
primUnitId]
, lks_obj_root_filter :: ExportedFun -> Bool
lks_obj_root_filter = Bool -> ExportedFun -> Bool
forall a b. a -> b -> a
const Bool
False
, lks_extra_roots :: Set ExportedFun
lks_extra_roots = Set ExportedFun
forall a. Monoid a => a
mempty
, lks_objs_hs :: [FilePath]
lks_objs_hs = [FilePath]
forall a. Monoid a => a
mempty
, lks_objs_js :: [FilePath]
lks_objs_js = [FilePath]
forall a. Monoid a => a
mempty
, lks_objs_cc :: [FilePath]
lks_objs_cc = [FilePath]
forall a. Monoid a => a
mempty
}
let finder_opts :: FinderOpts
finder_opts = JSInterpExtra -> FinderOpts
instFinderOpts (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
finder_cache :: FinderCache
finder_cache = JSInterpExtra -> FinderCache
instFinderCache (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
ar_cache <- IO ArchiveCache
newArchiveCache
link_plan <- computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
jsLinkPlan logger tmpfs tmp_dir ar_cache link_cfg cfg inst link_plan
jsLinkInterp :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> IO ()
jsLinkInterp :: Logger
-> TmpFs
-> TempDir
-> StgToJSConfig
-> UnitEnv
-> ExtInterpInstance JSInterpExtra
-> IO ()
jsLinkInterp Logger
logger TmpFs
tmpfs TempDir
tmp_dir StgToJSConfig
cfg UnitEnv
unit_env ExtInterpInstance JSInterpExtra
inst = do
let link_cfg :: JSLinkConfig
link_cfg = JSLinkConfig
{ lcNoStats :: Bool
lcNoStats = Bool
True
, lcNoRts :: Bool
lcNoRts = Bool
True
, lcCombineAll :: Bool
lcCombineAll = Bool
False
, lcForeignRefs :: Bool
lcForeignRefs = Bool
False
, lcNoJSExecutables :: Bool
lcNoJSExecutables = Bool
True
, lcNoHsMain :: Bool
lcNoHsMain = Bool
True
, lcForceEmccRts :: Bool
lcForceEmccRts = Bool
False
, lcLinkCsources :: Bool
lcLinkCsources = Bool
True
}
let is_root :: p -> Bool
is_root p
_ = Bool
True
let ghci_unit_id :: UnitId
ghci_unit_id = JSInterpExtra -> UnitId
instGhciUnitId (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
let unit_map :: UnitInfoMap
unit_map = UnitState -> UnitInfoMap
unitInfoMap (HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env)
dep_units <- MaybeErr UnitErr [UnitId] -> IO [UnitId]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (MaybeErr UnitErr [UnitId] -> IO [UnitId])
-> MaybeErr UnitErr [UnitId] -> IO [UnitId]
forall a b. (a -> b) -> a -> b
$ UnitInfoMap
-> [(UnitId, Maybe UnitId)] -> MaybeErr UnitErr [UnitId]
closeUnitDeps UnitInfoMap
unit_map [(UnitId
ghci_unit_id,Maybe UnitId
forall a. Maybe a
Nothing)]
let units = [UnitId]
dep_units [UnitId] -> [UnitId] -> [UnitId]
forall a. [a] -> [a] -> [a]
++ [UnitId
ghci_unit_id]
let root_deps = [ExportedFun] -> Set ExportedFun
forall a. Ord a => [a] -> Set a
Set.fromList ([ExportedFun] -> Set ExportedFun)
-> [ExportedFun] -> Set ExportedFun
forall a b. (a -> b) -> a -> b
$ UnitId -> FastString -> [FastString] -> [ExportedFun]
mkExportedFuns UnitId
ghci_unit_id (FilePath -> FastString
fsLit FilePath
"GHCi.Server") [FilePath -> FastString
fsLit FilePath
"defaultServer"]
let link_spec = LinkSpec
{ lks_unit_ids :: [UnitId]
lks_unit_ids = [UnitId]
units
, lks_obj_root_filter :: ExportedFun -> Bool
lks_obj_root_filter = ExportedFun -> Bool
forall {p}. p -> Bool
is_root
, lks_extra_roots :: Set ExportedFun
lks_extra_roots = Set ExportedFun
root_deps
, lks_objs_hs :: [FilePath]
lks_objs_hs = [FilePath]
forall a. Monoid a => a
mempty
, lks_objs_js :: [FilePath]
lks_objs_js = [FilePath]
forall a. Monoid a => a
mempty
, lks_objs_cc :: [FilePath]
lks_objs_cc = [FilePath]
forall a. Monoid a => a
mempty
}
let finder_cache = JSInterpExtra -> FinderCache
instFinderCache (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
finder_opts = JSInterpExtra -> FinderOpts
instFinderOpts (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
ar_cache <- newArchiveCache
link_plan <- computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
jsLinkPlan logger tmpfs tmp_dir ar_cache link_cfg cfg inst link_plan
jsLinkObjects :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> [FilePath] -> (ExportedFun -> Bool) -> IO ()
jsLinkObjects :: Logger
-> TmpFs
-> TempDir
-> StgToJSConfig
-> UnitEnv
-> ExtInterpInstance JSInterpExtra
-> [FilePath]
-> (ExportedFun -> Bool)
-> IO ()
jsLinkObjects Logger
logger TmpFs
tmpfs TempDir
tmp_dir StgToJSConfig
cfg UnitEnv
unit_env ExtInterpInstance JSInterpExtra
inst [FilePath]
objs ExportedFun -> Bool
is_root = do
let link_cfg :: JSLinkConfig
link_cfg = JSLinkConfig
{ lcNoStats :: Bool
lcNoStats = Bool
True
, lcNoRts :: Bool
lcNoRts = Bool
True
, lcCombineAll :: Bool
lcCombineAll = Bool
False
, lcForeignRefs :: Bool
lcForeignRefs = Bool
False
, lcNoJSExecutables :: Bool
lcNoJSExecutables = Bool
True
, lcNoHsMain :: Bool
lcNoHsMain = Bool
True
, lcForceEmccRts :: Bool
lcForceEmccRts = Bool
False
, lcLinkCsources :: Bool
lcLinkCsources = Bool
True
}
let units :: [UnitId]
units = UnitState -> [UnitId]
preloadUnits (HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env)
let link_spec :: LinkSpec
link_spec = LinkSpec
{ lks_unit_ids :: [UnitId]
lks_unit_ids = [UnitId]
units
, lks_obj_root_filter :: ExportedFun -> Bool
lks_obj_root_filter = ExportedFun -> Bool
is_root
, lks_extra_roots :: Set ExportedFun
lks_extra_roots = Set ExportedFun
forall a. Monoid a => a
mempty
, lks_objs_hs :: [FilePath]
lks_objs_hs = [FilePath]
objs
, lks_objs_js :: [FilePath]
lks_objs_js = [FilePath]
forall a. Monoid a => a
mempty
, lks_objs_cc :: [FilePath]
lks_objs_cc = [FilePath]
forall a. Monoid a => a
mempty
}
let finder_opts :: FinderOpts
finder_opts = JSInterpExtra -> FinderOpts
instFinderOpts (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
finder_cache :: FinderCache
finder_cache = JSInterpExtra -> FinderCache
instFinderCache (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
ar_cache <- IO ArchiveCache
newArchiveCache
link_plan <- computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
jsLinkPlan logger tmpfs tmp_dir ar_cache link_cfg cfg inst link_plan
jsLinkObject :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> FilePath -> [ExportedFun] -> IO ()
jsLinkObject :: Logger
-> TmpFs
-> TempDir
-> StgToJSConfig
-> UnitEnv
-> ExtInterpInstance JSInterpExtra
-> FilePath
-> [ExportedFun]
-> IO ()
jsLinkObject Logger
logger TmpFs
tmpfs TempDir
tmp_dir StgToJSConfig
cfg UnitEnv
unit_env ExtInterpInstance JSInterpExtra
inst FilePath
obj [ExportedFun]
roots = do
let is_root :: ExportedFun -> Bool
is_root ExportedFun
f = ExportedFun -> Set ExportedFun -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ExportedFun
f ([ExportedFun] -> Set ExportedFun
forall a. Ord a => [a] -> Set a
Set.fromList [ExportedFun]
roots)
let objs :: [FilePath]
objs = [FilePath
obj]
Logger
-> TmpFs
-> TempDir
-> StgToJSConfig
-> UnitEnv
-> ExtInterpInstance JSInterpExtra
-> [FilePath]
-> (ExportedFun -> Bool)
-> IO ()
jsLinkObjects Logger
logger TmpFs
tmpfs TempDir
tmp_dir StgToJSConfig
cfg UnitEnv
unit_env ExtInterpInstance JSInterpExtra
inst [FilePath]
objs ExportedFun -> Bool
is_root
jsLinkPlan :: Logger -> TmpFs -> TempDir -> ArchiveCache -> JSLinkConfig -> StgToJSConfig -> ExtInterpInstance JSInterpExtra -> LinkPlan -> IO ()
jsLinkPlan :: Logger
-> TmpFs
-> TempDir
-> ArchiveCache
-> JSLinkConfig
-> StgToJSConfig
-> ExtInterpInstance JSInterpExtra
-> LinkPlan
-> IO ()
jsLinkPlan Logger
logger TmpFs
tmpfs TempDir
tmp_dir ArchiveCache
ar_cache JSLinkConfig
link_cfg StgToJSConfig
cfg ExtInterpInstance JSInterpExtra
inst LinkPlan
link_plan = do
old_plan <- JSState -> LinkPlan
jsLinkState (JSState -> LinkPlan) -> IO JSState -> IO LinkPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar JSState -> IO JSState
forall a. MVar a -> IO a
readMVar (JSInterpExtra -> MVar JSState
instJSState (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst))
let (diff_plan, total_plan) = incrementLinkPlan old_plan link_plan
tmp_out <- newTempSubDir logger tmpfs tmp_dir
void $ jsLink link_cfg cfg logger tmpfs ar_cache tmp_out diff_plan
let filenames
| JSLinkConfig -> Bool
lcNoRts JSLinkConfig
link_cfg = [FilePath
"lib.js", FilePath
"out.js"]
| Bool
otherwise = [FilePath
"rts.js", FilePath
"lib.js", FilePath
"out.js"]
let files = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
tmp_out FilePath -> FilePath -> FilePath
</>) [FilePath]
filenames
let all_js = FilePath
tmp_out FilePath -> FilePath -> FilePath
</> FilePath
"all.js"
let all_files = FilePath
all_js FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
files
withBinaryFile all_js WriteMode $ \Handle
h -> do
let cpy :: FilePath -> IO ()
cpy FilePath
i = FilePath -> IO ByteString
B.readFile FilePath
i IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> ByteString -> IO ()
B.hPut Handle
h
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
cpy [FilePath]
files
addFilesToClean tmpfs TFL_CurrentModule all_files
server_started <- jsServerStarted <$> readMVar (instJSState (instExtra inst))
if server_started
then sendMessageNoResponse inst $ LoadObj all_js
else jsLoadFile inst all_js
modifyMVar_ (instJSState (instExtra inst)) $ \JSState
state -> JSState -> IO JSState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSState
state { jsLinkState = total_plan }
jsSendCommand :: ExtInterpInstance JSInterpExtra -> String -> IO ()
jsSendCommand :: ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
jsSendCommand ExtInterpInstance JSInterpExtra
inst FilePath
cmd = FilePath -> IO ()
send_cmd FilePath
cmd
where
extra :: JSInterpExtra
extra = ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst
handle :: Handle
handle = JSInterpExtra -> Handle
instStdIn JSInterpExtra
extra
send_cmd :: FilePath -> IO ()
send_cmd FilePath
s = do
FilePath -> (CStringLen -> IO ()) -> IO ()
forall a. FilePath -> (CStringLen -> IO a) -> IO a
withCStringLen FilePath
s \(Ptr CChar
p,Int
n) -> Handle -> Ptr CChar -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
handle Ptr CChar
p Int
n
Handle -> IO ()
hFlush Handle
handle
jsLoadFile :: ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
jsLoadFile :: ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
jsLoadFile ExtInterpInstance JSInterpExtra
inst FilePath
path = ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
jsSendCommand ExtInterpInstance JSInterpExtra
inst (FilePath
"LOAD " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
jsRunServer :: ExtInterpInstance JSInterpExtra -> IO ()
jsRunServer :: ExtInterpInstance JSInterpExtra -> IO ()
jsRunServer ExtInterpInstance JSInterpExtra
inst = do
let ghci_unit_id :: UnitId
ghci_unit_id = JSInterpExtra -> UnitId
instGhciUnitId (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)
let zghci_unit_id :: FilePath
zghci_unit_id = FastZString -> FilePath
zString (FastString -> FastZString
zEncodeFS (UnitId -> FastString
unitIdFS UnitId
ghci_unit_id))
ExtInterpInstance JSInterpExtra -> FilePath -> IO ()
jsSendCommand ExtInterpInstance JSInterpExtra
inst (FilePath
"RUN_SERVER " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
zghci_unit_id FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
MVar JSState -> (JSState -> IO JSState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (JSInterpExtra -> MVar JSState
instJSState (ExtInterpInstance JSInterpExtra -> JSInterpExtra
forall c. ExtInterpInstance c -> c
instExtra ExtInterpInstance JSInterpExtra
inst)) ((JSState -> IO JSState) -> IO ())
-> (JSState -> IO JSState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \JSState
state -> JSState -> IO JSState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSState
state { jsServerStarted = True }