Skip to content

Commit 5ba847a

Browse files
bgamaribgamari
authored
Merge pull request #292 from luite/js
Add support for the GHC JavaScript backend (node.js)
2 parents 5326f67 + 56ebb5c commit 5ba847a

File tree

9 files changed

+989
-35
lines changed

9 files changed

+989
-35
lines changed

‎System/Process.hs

Lines changed: 46 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,10 @@
88

99
#include <ghcplatform.h>
1010

11+
#if defined(javascript_HOST_ARCH)
12+
{-# LANGUAGE JavaScriptFFI #-}
13+
#endif
14+
1115
-----------------------------------------------------------------------------
1216
-- |
1317
-- Module : System.Process
@@ -85,7 +89,11 @@ import System.Process.Internals
8589

8690
import Control.Concurrent
8791
import Control.DeepSeq (rnf)
88-
import Control.Exception (SomeException, mask, allowInterrupt, bracket, try, throwIO)
92+
import Control.Exception (SomeException, mask
93+
#if !defined(javascript_HOST_ARCH)
94+
, allowInterrupt
95+
#endif
96+
, bracket, try, throwIO)
8997
import qualified Control.Exception as C
9098
import Control.Monad
9199
import Data.Maybe
@@ -95,7 +103,9 @@ import System.Exit ( ExitCode(..) )
95103
import System.IO
96104
import System.IO.Error (mkIOError, ioeSetErrorString)
97105

98-
#if defined(WINDOWS)
106+
#if defined(javascript_HOST_ARCH)
107+
import System.Process.JavaScript(getProcessId, getCurrentProcessId)
108+
#elif defined(WINDOWS)
99109
import System.Win32.Process (getProcessId, getCurrentProcessId, ProcessId)
100110
#else
101111
import System.Posix.Process (getProcessID)
@@ -114,7 +124,9 @@ import System.IO.Error
114124
-- This is always an integral type. Width and signedness are platform specific.
115125
--
116126
-- @since 1.6.3.0
117-
#if defined(WINDOWS)
127+
#if defined(javascript_HOST_ARCH)
128+
type Pid = Int
129+
#elif defined(WINDOWS)
118130
type Pid = ProcessId
119131
#else
120132
type Pid = CPid
@@ -651,7 +663,11 @@ getPid :: ProcessHandle -> IO (Maybe Pid)
651663
getPid (ProcessHandle mh _ _) = do
652664
p_ <- readMVar mh
653665
case p_ of
654-
#ifdef WINDOWS
666+
#if defined(javascript_HOST_ARCH)
667+
OpenHandle h -> do
668+
pid <- getProcessId h
669+
return $ Just pid
670+
#elif defined(WINDOWS)
655671
OpenHandle h -> do
656672
pid <- getProcessId h
657673
return $ Just pid
@@ -672,7 +688,9 @@ getPid (ProcessHandle mh _ _) = do
672688
-- @since 1.6.12.0
673689
getCurrentPid :: IO Pid
674690
getCurrentPid =
675-
#ifdef WINDOWS
691+
#if defined(javascript_HOST_ARCH)
692+
getCurrentProcessId
693+
#elif defined(WINDOWS)
676694
getCurrentProcessId
677695
#else
678696
getProcessID
@@ -753,7 +771,11 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do
753771

754772
waitForProcess' :: PHANDLE -> IO ExitCode
755773
waitForProcess' h = alloca $ \pret -> do
774+
#if defined(javascript_HOST_ARCH)
775+
throwErrnoIfMinus1Retry_ "waitForProcess" (C.interruptible $ c_waitForProcess h pret)
776+
#else
756777
throwErrnoIfMinus1Retry_ "waitForProcess" (allowInterrupt >> c_waitForProcess h pret)
778+
#endif
757779
mkExitCode <$> peek pret
758780

759781
mkExitCode :: CInt -> ExitCode
@@ -875,6 +897,25 @@ c_getProcessExitCode _ _ = ioError (ioeSetLocation unsupportedOperation "getProc
875897
c_waitForProcess :: PHANDLE -> Ptr CInt -> IO CInt
876898
c_waitForProcess _ _ = ioError (ioeSetLocation unsupportedOperation "waitForProcess")
877899

900+
#elif defined(javascript_HOST_ARCH)
901+
902+
foreign import javascript unsafe "h$process_terminateProcess"
903+
c_terminateProcess
904+
:: PHANDLE
905+
-> IO Int
906+
907+
foreign import javascript unsafe "h$process_getProcessExitCode"
908+
c_getProcessExitCode
909+
:: PHANDLE
910+
-> Ptr Int
911+
-> IO Int
912+
913+
foreign import javascript interruptible "h$process_waitForProcess"
914+
c_waitForProcess
915+
:: PHANDLE
916+
-> Ptr CInt
917+
-> IO CInt
918+
878919
#else
879920

880921
foreign import ccall unsafe "terminateProcess"

‎System/Process/Common.hs

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,10 @@ import System.IO.Error
5757
import Data.Typeable
5858
import System.IO (IOMode)
5959

60+
#if defined(javascript_HOST_ARCH)
61+
import GHC.JS.Prim (JSVal)
62+
#endif
63+
6064
-- We do a minimal amount of CPP here to provide uniform data types across
6165
-- Windows and POSIX.
6266
#ifdef WINDOWS
@@ -69,7 +73,9 @@ import System.Win32.Types (HANDLE)
6973
import System.Posix.Types
7074
#endif
7175

72-
#ifdef WINDOWS
76+
#if defined(javascript_HOST_ARCH)
77+
type PHANDLE = JSVal
78+
#elif defined(WINDOWS)
7379
-- Define some missing types for Windows compatibility. Note that these values
7480
-- will never actually be used, as the setuid/setgid system calls are not
7581
-- applicable on Windows. No value of this type will ever exist.
@@ -80,16 +86,15 @@ type UserID = CGid
8086
#else
8187
type PHANDLE = CPid
8288
#endif
83-
8489
data CreateProcess = CreateProcess{
8590
cmdspec :: CmdSpec, -- ^ Executable & arguments, or shell command. If 'cwd' is 'Nothing', relative paths are resolved with respect to the current working directory. If 'cwd' is provided, it is implementation-dependent whether relative paths are resolved with respect to 'cwd' or the current working directory, so absolute paths should be used to ensure portability.
8691
cwd :: Maybe FilePath, -- ^ Optional path to the working directory for the new process
8792
env :: Maybe [(String,String)], -- ^ Optional environment (otherwise inherit from the current process)
8893
std_in :: StdStream, -- ^ How to determine stdin
8994
std_out :: StdStream, -- ^ How to determine stdout
9095
std_err :: StdStream, -- ^ How to determine stderr
91-
close_fds :: Bool, -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit). This implementation will call close on every fd from 3 to the maximum of open files, which can be slow for high maximum of open files.
92-
create_group :: Bool, -- ^ Create a new process group
96+
close_fds :: Bool, -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit). This implementation will call close on every fd from 3 to the maximum of open files, which can be slow for high maximum of open files. XXX verify what happens with fds in nodejs child processes
97+
create_group :: Bool, -- ^ Create a new process group. On JavaScript this also creates a new session.
9398
delegate_ctlc:: Bool, -- ^ Delegate control-C handling. Use this for interactive console processes to let them handle control-C themselves (see below for details).
9499
--
95100
-- @since 1.2.0.0
@@ -101,15 +106,15 @@ data CreateProcess = CreateProcess{
101106
-- Default: @False@
102107
--
103108
-- @since 1.3.0.0
104-
new_session :: Bool, -- ^ Use posix setsid to start the new process in a new session; does nothing on other platforms.
109+
new_session :: Bool, -- ^ Use posix setsid to start the new process in a new session; starts process in a new session on JavaScript; does nothing on other platforms.
105110
--
106111
-- @since 1.3.0.0
107-
child_group :: Maybe GroupID, -- ^ Use posix setgid to set child process's group id; does nothing on other platforms.
112+
child_group :: Maybe GroupID, -- ^ Use posix setgid to set child process's group id; works for JavaScript when system running nodejs is posix. does nothing on other platforms.
108113
--
109114
-- Default: @Nothing@
110115
--
111116
-- @since 1.4.0.0
112-
child_user :: Maybe UserID, -- ^ Use posix setuid to set child process's user id; does nothing on other platforms.
117+
child_user :: Maybe UserID, -- ^ Use posix setuid to set child process's user id; works for JavaScript when system running nodejs is posix. does nothing on other platforms.
113118
--
114119
-- Default: @Nothing@
115120
--
@@ -243,12 +248,17 @@ mbFd _ _std CreatePipe = return (-1)
243248
mbFd _fun std Inherit = return std
244249
mbFd _fn _std NoStream = return (-2)
245250
mbFd fun _std (UseHandle hdl) =
246-
withHandle fun hdl $ \Handle__{haDevice=dev,..} ->
251+
withHandle fun hdl $ \Handle__{haDevice=dev,..} -> do
247252
case cast dev of
248253
Just fd -> do
254+
#if !defined(javascript_HOST_ARCH)
249255
-- clear the O_NONBLOCK flag on this FD, if it is set, since
250256
-- we're exposing it externally (see #3316)
251257
fd' <- FD.setNonBlockingMode fd False
258+
#else
259+
-- on the JavaScript platform we cannot change the FD flags
260+
fd' <- pure fd
261+
#endif
252262
return (Handle__{haDevice=fd',..}, FD.fdFD fd')
253263
Nothing ->
254264
ioError (mkIOError illegalOperationErrorType

‎System/Process/Internals.hs

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -45,9 +45,11 @@ module System.Process.Internals (
4545
waitForJobCompletion,
4646
timeout_Infinite,
4747
#else
48+
#if !defined(javascript_HOST_ARCH)
4849
pPrPr_disableITimers, c_execvpe,
49-
ignoreSignal, defaultSignal,
5050
runInteractiveProcess_lock,
51+
#endif
52+
ignoreSignal, defaultSignal,
5153
#endif
5254
withFilePathException, withCEnvironment,
5355
translate,
@@ -64,7 +66,9 @@ import System.Posix.Internals (FD)
6466

6567
import System.Process.Common
6668

67-
#ifdef WINDOWS
69+
#if defined(javascript_HOST_ARCH)
70+
import System.Process.JavaScript
71+
#elif defined(WINDOWS)
6872
import System.Process.Windows
6973
#else
7074
import System.Process.Posix

0 commit comments

Comments
 (0)