{-# LANGUAGE CPP, ForeignFunctionInterface #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE InterruptibleFFI #-}
#include <ghcplatform.h>
#if defined(javascript_HOST_ARCH)
{-# LANGUAGE JavaScriptFFI #-}
#endif
module System.Process (
createProcess,
createProcess_,
shell, proc,
CreateProcess(..),
CmdSpec(..),
StdStream(..),
ProcessHandle,
callProcess,
callCommand,
spawnProcess,
spawnCommand,
readCreateProcess,
readProcess,
readCreateProcessWithExitCode,
readProcessWithExitCode,
withCreateProcess,
cleanupProcess,
showCommandForUser,
Pid,
getPid,
getCurrentPid,
waitForProcess,
getProcessExitCode,
terminateProcess,
interruptProcessGroupOf,
createPipe,
createPipeFd,
runProcess,
runCommand,
runInteractiveProcess,
runInteractiveCommand,
system,
rawSystem,
) where
import Prelude hiding (mapM)
import System.Process.Internals
import Control.Concurrent
import Control.DeepSeq (rnf)
import Control.Exception (
#if !defined(javascript_HOST_ARCH)
allowInterrupt,
#endif
bracket)
import qualified Control.Exception as C
import Control.Monad
import Data.Maybe
import Foreign
import Foreign.C
import System.Exit ( ExitCode(..) )
import System.IO
import System.IO.Error (mkIOError, ioeSetErrorString)
#if defined(javascript_HOST_ARCH)
import System.Process.JavaScript(getProcessId, getCurrentProcessId)
#elif defined(mingw32_HOST_OS)
import System.Win32.Process (getProcessId, getCurrentProcessId, ProcessId)
#else
import System.Posix.Process (getProcessID)
import System.Posix.Types (CPid (..))
#endif
import GHC.IO.Exception ( ioException, IOErrorType(..) )
#if defined(wasm32_HOST_ARCH)
import GHC.IO.Exception ( unsupportedOperation )
import System.IO.Error
#endif
#if defined(javascript_HOST_ARCH)
type Pid = Int
#elif defined(mingw32_HOST_OS)
type Pid = ProcessId
#else
type Pid = CPid
#endif
proc :: FilePath -> [String] -> CreateProcess
proc :: String -> [String] -> CreateProcess
proc String
cmd [String]
args = CreateProcess { cmdspec :: CmdSpec
cmdspec = String -> [String] -> CmdSpec
RawCommand String
cmd [String]
args,
cwd :: Maybe String
cwd = Maybe String
forall a. Maybe a
Nothing,
env :: Maybe [(String, String)]
env = Maybe [(String, String)]
forall a. Maybe a
Nothing,
std_in :: StdStream
std_in = StdStream
Inherit,
std_out :: StdStream
std_out = StdStream
Inherit,
std_err :: StdStream
std_err = StdStream
Inherit,
close_fds :: Bool
close_fds = Bool
False,
create_group :: Bool
create_group = Bool
False,
delegate_ctlc :: Bool
delegate_ctlc = Bool
False,
detach_console :: Bool
detach_console = Bool
False,
create_new_console :: Bool
create_new_console = Bool
False,
new_session :: Bool
new_session = Bool
False,
child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing,
child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing,
use_process_jobs :: Bool
use_process_jobs = Bool
False }
shell :: String -> CreateProcess
shell :: String -> CreateProcess
shell String
str = CreateProcess { cmdspec :: CmdSpec
cmdspec = String -> CmdSpec
ShellCommand String
str,
cwd :: Maybe String
cwd = Maybe String
forall a. Maybe a
Nothing,
env :: Maybe [(String, String)]
env = Maybe [(String, String)]
forall a. Maybe a
Nothing,
std_in :: StdStream
std_in = StdStream
Inherit,
std_out :: StdStream
std_out = StdStream
Inherit,
std_err :: StdStream
std_err = StdStream
Inherit,
close_fds :: Bool
close_fds = Bool
False,
create_group :: Bool
create_group = Bool
False,
delegate_ctlc :: Bool
delegate_ctlc = Bool
False,
detach_console :: Bool
detach_console = Bool
False,
create_new_console :: Bool
create_new_console = Bool
False,
new_session :: Bool
new_session = Bool
False,
child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing,
child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing,
use_process_jobs :: Bool
use_process_jobs = Bool
False }
createProcess
:: CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess :: CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cp = do
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
r <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"createProcess" CreateProcess
cp
StdStream -> IO ()
maybeCloseStd (CreateProcess -> StdStream
std_in CreateProcess
cp)
StdStream -> IO ()
maybeCloseStd (CreateProcess -> StdStream
std_out CreateProcess
cp)
StdStream -> IO ()
maybeCloseStd (CreateProcess -> StdStream
std_err CreateProcess
cp)
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
r
where
maybeCloseStd :: StdStream -> IO ()
maybeCloseStd :: StdStream -> IO ()
maybeCloseStd (UseHandle Handle
hdl)
| Handle
hdl Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
stdin Bool -> Bool -> Bool
&& Handle
hdl Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
stdout Bool -> Bool -> Bool
&& Handle
hdl Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
stderr = Handle -> IO ()
hClose Handle
hdl
maybeCloseStd StdStream
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
withCreateProcess
:: CreateProcess
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess :: forall a.
CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess CreateProcess
c Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a
action =
IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
C.bracket (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
c) (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess
(\(Maybe Handle
m_in, Maybe Handle
m_out, Maybe Handle
m_err, ProcessHandle
ph) -> Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a
action Maybe Handle
m_in Maybe Handle
m_out Maybe Handle
m_err ProcessHandle
ph)
withCreateProcess_
:: String
-> CreateProcess
-> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess_ :: forall a.
String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess_ String
fun CreateProcess
c Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a
action =
IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
C.bracketOnError (String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
fun CreateProcess
c) (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess
(\(Maybe Handle
m_in, Maybe Handle
m_out, Maybe Handle
m_err, ProcessHandle
ph) -> Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a
action Maybe Handle
m_in Maybe Handle
m_out Maybe Handle
m_err ProcessHandle
ph)
cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ()
cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess (Maybe Handle
mb_stdin, Maybe Handle
mb_stdout, Maybe Handle
mb_stderr,
ph :: ProcessHandle
ph@(ProcessHandle MVar ProcessHandle__
_ Bool
delegating_ctlc MVar ()
_)) = do
ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph
IO () -> (Handle -> IO ()) -> Maybe Handle -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()
ignoreSigPipe (IO () -> IO ()) -> (Handle -> IO ()) -> Handle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose) Maybe Handle
mb_stdin
IO () -> (Handle -> IO ()) -> Maybe Handle -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Handle -> IO ()
hClose Maybe Handle
mb_stdout
IO () -> (Handle -> IO ()) -> Maybe Handle -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Handle -> IO ()
hClose Maybe Handle
mb_stderr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delegating_ctlc
IO ()
stopDelegateControlC
ThreadId
_ <- IO () -> IO ThreadId
forkIO (ProcessHandle -> IO ExitCode
waitForProcess (ProcessHandle -> ProcessHandle
resetCtlcDelegation ProcessHandle
ph) IO ExitCode -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
resetCtlcDelegation :: ProcessHandle -> ProcessHandle
resetCtlcDelegation (ProcessHandle MVar ProcessHandle__
m Bool
_ MVar ()
l) = MVar ProcessHandle__ -> Bool -> MVar () -> ProcessHandle
ProcessHandle MVar ProcessHandle__
m Bool
False MVar ()
l
spawnProcess :: FilePath -> [String] -> IO ProcessHandle
spawnProcess :: String -> [String] -> IO ProcessHandle
spawnProcess String
cmd [String]
args = do
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
p) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"spawnProcess" (String -> [String] -> CreateProcess
proc String
cmd [String]
args)
ProcessHandle -> IO ProcessHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
p
spawnCommand :: String -> IO ProcessHandle
spawnCommand :: String -> IO ProcessHandle
spawnCommand String
cmd = do
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
p) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"spawnCommand" (String -> CreateProcess
shell String
cmd)
ProcessHandle -> IO ProcessHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
p
callProcess :: FilePath -> [String] -> IO ()
callProcess :: String -> [String] -> IO ()
callProcess String
cmd [String]
args = do
ExitCode
exit_code <- String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a.
String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess_ String
"callProcess"
(String -> [String] -> CreateProcess
proc String
cmd [String]
args) { delegate_ctlc = True } ((Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode)
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p ->
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
case ExitCode
exit_code of
ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure Int
r -> String -> String -> [String] -> Int -> IO ()
forall a. String -> String -> [String] -> Int -> IO a
processFailedException String
"callProcess" String
cmd [String]
args Int
r
callCommand :: String -> IO ()
callCommand :: String -> IO ()
callCommand String
cmd = do
ExitCode
exit_code <- String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a.
String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess_ String
"callCommand"
(String -> CreateProcess
shell String
cmd) { delegate_ctlc = True } ((Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode)
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p ->
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
case ExitCode
exit_code of
ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure Int
r -> String -> String -> [String] -> Int -> IO ()
forall a. String -> String -> [String] -> Int -> IO a
processFailedException String
"callCommand" String
cmd [] Int
r
processFailedException :: String -> String -> [String] -> Int -> IO a
processFailedException :: forall a. String -> String -> [String] -> Int -> IO a
processFailedException String
fun String
cmd [String]
args Int
exit_code =
IOError -> IO a
forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
OtherError (String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++
(String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show) [String]
args String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (exit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
exit_code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
readProcess
:: FilePath
-> [String]
-> String
-> IO String
readProcess :: String -> [String] -> String -> IO String
readProcess String
cmd [String]
args = CreateProcess -> String -> IO String
readCreateProcess (CreateProcess -> String -> IO String)
-> CreateProcess -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
proc String
cmd [String]
args
readCreateProcess
:: CreateProcess
-> String
-> IO String
readCreateProcess :: CreateProcess -> String -> IO String
readCreateProcess CreateProcess
cp String
input = do
let cp_opts :: CreateProcess
cp_opts = CreateProcess
cp {
std_in = CreatePipe,
std_out = CreatePipe
}
(ExitCode
ex, String
output) <- String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (ExitCode, String))
-> IO (ExitCode, String)
forall a.
String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess_ String
"readCreateProcess" CreateProcess
cp_opts ((Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (ExitCode, String))
-> IO (ExitCode, String))
-> (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (ExitCode, String))
-> IO (ExitCode, String)
forall a b. (a -> b) -> a -> b
$
\Maybe Handle
mb_inh Maybe Handle
mb_outh Maybe Handle
_ ProcessHandle
ph ->
case (Maybe Handle
mb_inh, Maybe Handle
mb_outh) of
(Just Handle
inh, Just Handle
outh) -> do
String
output <- Handle -> IO String
hGetContents Handle
outh
IO () -> (IO () -> IO ()) -> IO ()
forall a. IO () -> (IO () -> IO a) -> IO a
withForkWait (() -> IO ()
forall a. a -> IO a
C.evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ()
forall a. NFData a => a -> ()
rnf String
output) ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
waitOut -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO () -> IO ()
ignoreSigPipe (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
inh String
input
IO () -> IO ()
ignoreSigPipe (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
inh
IO ()
waitOut
Handle -> IO ()
hClose Handle
outh
ExitCode
ex <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
(ExitCode, String) -> IO (ExitCode, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ex, String
output)
(Maybe Handle
Nothing,Maybe Handle
_) -> String -> IO (ExitCode, String)
forall a. HasCallStack => String -> a
error String
"readCreateProcess: Failed to get a stdin handle."
(Maybe Handle
_,Maybe Handle
Nothing) -> String -> IO (ExitCode, String)
forall a. HasCallStack => String -> a
error String
"readCreateProcess: Failed to get a stdout handle."
case ExitCode
ex of
ExitCode
ExitSuccess -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
output
ExitFailure Int
r -> String -> String -> [String] -> Int -> IO String
forall a. String -> String -> [String] -> Int -> IO a
processFailedException String
"readCreateProcess" String
cmd [String]
args Int
r
where
cmd :: String
cmd = case CreateProcess
cp of
CreateProcess { cmdspec :: CreateProcess -> CmdSpec
cmdspec = ShellCommand String
sc } -> String
sc
CreateProcess { cmdspec :: CreateProcess -> CmdSpec
cmdspec = RawCommand String
fp [String]
_ } -> String
fp
args :: [String]
args = case CreateProcess
cp of
CreateProcess { cmdspec :: CreateProcess -> CmdSpec
cmdspec = ShellCommand String
_ } -> []
CreateProcess { cmdspec :: CreateProcess -> CmdSpec
cmdspec = RawCommand String
_ [String]
args' } -> [String]
args'
readProcessWithExitCode
:: FilePath
-> [String]
-> String
-> IO (ExitCode,String,String)
readProcessWithExitCode :: String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
cmd [String]
args =
CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (CreateProcess -> String -> IO (ExitCode, String, String))
-> CreateProcess -> String -> IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
proc String
cmd [String]
args
readCreateProcessWithExitCode
:: CreateProcess
-> String
-> IO (ExitCode,String,String)
readCreateProcessWithExitCode :: CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
cp String
input = do
let cp_opts :: CreateProcess
cp_opts = CreateProcess
cp {
std_in = CreatePipe,
std_out = CreatePipe,
std_err = CreatePipe
}
String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
forall a.
String
-> CreateProcess
-> (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess_ String
"readCreateProcessWithExitCode" CreateProcess
cp_opts ((Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (ExitCode, String, String))
-> IO (ExitCode, String, String))
-> (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> ProcessHandle
-> IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$
\Maybe Handle
mb_inh Maybe Handle
mb_outh Maybe Handle
mb_errh ProcessHandle
ph ->
case (Maybe Handle
mb_inh, Maybe Handle
mb_outh, Maybe Handle
mb_errh) of
(Just Handle
inh, Just Handle
outh, Just Handle
errh) -> do
String
out <- Handle -> IO String
hGetContents Handle
outh
String
err <- Handle -> IO String
hGetContents Handle
errh
IO () -> (IO () -> IO ()) -> IO ()
forall a. IO () -> (IO () -> IO a) -> IO a
withForkWait (() -> IO ()
forall a. a -> IO a
C.evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ()
forall a. NFData a => a -> ()
rnf String
out) ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
waitOut ->
IO () -> (IO () -> IO ()) -> IO ()
forall a. IO () -> (IO () -> IO a) -> IO a
withForkWait (() -> IO ()
forall a. a -> IO a
C.evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ()
forall a. NFData a => a -> ()
rnf String
err) ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
waitErr -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
input) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO () -> IO ()
ignoreSigPipe (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
inh String
input
IO () -> IO ()
ignoreSigPipe (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
inh
IO ()
waitOut
IO ()
waitErr
Handle -> IO ()
hClose Handle
outh
Handle -> IO ()
hClose Handle
errh
ExitCode
ex <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
(ExitCode, String, String) -> IO (ExitCode, String, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ex, String
out, String
err)
(Maybe Handle
Nothing,Maybe Handle
_,Maybe Handle
_) -> String -> IO (ExitCode, String, String)
forall a. HasCallStack => String -> a
error String
"readCreateProcessWithExitCode: Failed to get a stdin handle."
(Maybe Handle
_,Maybe Handle
Nothing,Maybe Handle
_) -> String -> IO (ExitCode, String, String)
forall a. HasCallStack => String -> a
error String
"readCreateProcessWithExitCode: Failed to get a stdout handle."
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
Nothing) -> String -> IO (ExitCode, String, String)
forall a. HasCallStack => String -> a
error String
"readCreateProcessWithExitCode: Failed to get a stderr handle."
showCommandForUser :: FilePath -> [String] -> String
showCommandForUser :: String -> [String] -> String
showCommandForUser String
cmd [String]
args = [String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
translate (String
cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args))
getPid :: ProcessHandle -> IO (Maybe Pid)
getPid :: ProcessHandle -> IO (Maybe Pid)
getPid (ProcessHandle MVar ProcessHandle__
mh Bool
_ MVar ()
_) = do
ProcessHandle__
p_ <- MVar ProcessHandle__ -> IO ProcessHandle__
forall a. MVar a -> IO a
readMVar MVar ProcessHandle__
mh
case ProcessHandle__
p_ of
#if defined(javascript_HOST_ARCH)
OpenHandle h -> do
pid <- getProcessId h
return $ Just pid
#elif defined(mingw32_HOST_OS)
OpenHandle h -> do
pid <- getProcessId h
return $ Just pid
#else
OpenHandle Pid
pid -> Maybe Pid -> IO (Maybe Pid)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Pid -> IO (Maybe Pid)) -> Maybe Pid -> IO (Maybe Pid)
forall a b. (a -> b) -> a -> b
$ Pid -> Maybe Pid
forall a. a -> Maybe a
Just Pid
pid
#endif
ProcessHandle__
_ -> Maybe Pid -> IO (Maybe Pid)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Pid
forall a. Maybe a
Nothing
getCurrentPid :: IO Pid
getCurrentPid :: IO Pid
getCurrentPid =
#if defined(javascript_HOST_ARCH)
getCurrentProcessId
#elif defined(mingw32_HOST_OS)
getCurrentProcessId
#else
IO Pid
getProcessID
#endif
waitForProcess
:: ProcessHandle
-> IO ExitCode
waitForProcess :: ProcessHandle -> IO ExitCode
waitForProcess ph :: ProcessHandle
ph@(ProcessHandle MVar ProcessHandle__
_ Bool
delegating_ctlc MVar ()
_) = IO ExitCode -> IO ExitCode
forall {b}. IO b -> IO b
lockWaitpid (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ do
ProcessHandle__
p_ <- ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, ProcessHandle__))
-> IO ProcessHandle__
forall a.
ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle ProcessHandle
ph ((ProcessHandle__ -> IO (ProcessHandle__, ProcessHandle__))
-> IO ProcessHandle__)
-> (ProcessHandle__ -> IO (ProcessHandle__, ProcessHandle__))
-> IO ProcessHandle__
forall a b. (a -> b) -> a -> b
$ \ProcessHandle__
p_ -> (ProcessHandle__, ProcessHandle__)
-> IO (ProcessHandle__, ProcessHandle__)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_,ProcessHandle__
p_)
case ProcessHandle__
p_ of
ClosedHandle ExitCode
e -> ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
e
OpenHandle Pid
h -> do
ExitCode
e <- Pid -> IO ExitCode
waitForProcess' Pid
h
(ExitCode
e', Bool
was_open) <- ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, (ExitCode, Bool)))
-> IO (ExitCode, Bool)
forall a.
ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle ProcessHandle
ph ((ProcessHandle__ -> IO (ProcessHandle__, (ExitCode, Bool)))
-> IO (ExitCode, Bool))
-> (ProcessHandle__ -> IO (ProcessHandle__, (ExitCode, Bool)))
-> IO (ExitCode, Bool)
forall a b. (a -> b) -> a -> b
$ \ProcessHandle__
p_' ->
case ProcessHandle__
p_' of
ClosedHandle ExitCode
e' -> (ProcessHandle__, (ExitCode, Bool))
-> IO (ProcessHandle__, (ExitCode, Bool))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_', (ExitCode
e', Bool
False))
OpenExtHandle{} -> String -> IO (ProcessHandle__, (ExitCode, Bool))
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"waitForProcess(OpenExtHandle): this cannot happen"
OpenHandle Pid
ph' -> do
Pid -> IO ()
closePHANDLE Pid
ph'
(ProcessHandle__, (ExitCode, Bool))
-> IO (ProcessHandle__, (ExitCode, Bool))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessHandle__
ClosedHandle ExitCode
e, (ExitCode
e, Bool
True))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
was_open Bool -> Bool -> Bool
&& Bool
delegating_ctlc) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ExitCode -> IO ()
endDelegateControlC ExitCode
e
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
e'
#if defined(mingw32_HOST_OS)
OpenExtHandle h job -> do
waitForJobCompletion job
e <- waitForProcess' h
e' <- modifyProcessHandle ph $ \p_' ->
case p_' of
ClosedHandle e' -> return (p_', e')
OpenHandle{} -> fail "waitForProcess(OpenHandle): this cannot happen"
OpenExtHandle ph' job' -> do
closePHANDLE ph'
closePHANDLE job'
return (ClosedHandle e, e)
return e'
#else
OpenExtHandle Pid
_ Pid
_job ->
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure (-Int
1)
#endif
where
lockWaitpid :: IO b -> IO b
lockWaitpid IO b
m = MVar () -> (() -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (ProcessHandle -> MVar ()
waitpidLock ProcessHandle
ph) ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \() -> IO b
m
waitForProcess' :: PHANDLE -> IO ExitCode
waitForProcess' :: Pid -> IO ExitCode
waitForProcess' Pid
h = (Ptr CInt -> IO ExitCode) -> IO ExitCode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ExitCode) -> IO ExitCode)
-> (Ptr CInt -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pret -> do
#if defined(javascript_HOST_ARCH)
throwErrnoIfMinus1Retry_ "waitForProcess" (C.interruptible $ c_waitForProcess h pret)
#else
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"waitForProcess" (IO ()
allowInterrupt IO () -> IO CInt -> IO CInt
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pid -> Ptr CInt -> IO CInt
c_waitForProcess Pid
h Ptr CInt
pret)
#endif
CInt -> ExitCode
mkExitCode (CInt -> ExitCode) -> IO CInt -> IO ExitCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pret
mkExitCode :: CInt -> ExitCode
mkExitCode :: CInt -> ExitCode
mkExitCode CInt
code
| CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 = ExitCode
ExitSuccess
| Bool
otherwise = Int -> ExitCode
ExitFailure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
code)
getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ph :: ProcessHandle
ph@(ProcessHandle MVar ProcessHandle__
_ Bool
delegating_ctlc MVar ()
_) = IO (Maybe ExitCode) -> IO (Maybe ExitCode)
tryLockWaitpid (IO (Maybe ExitCode) -> IO (Maybe ExitCode))
-> IO (Maybe ExitCode) -> IO (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$ do
(Maybe ExitCode
m_e, Bool
was_open) <- ProcessHandle
-> (ProcessHandle__
-> IO (ProcessHandle__, (Maybe ExitCode, Bool)))
-> IO (Maybe ExitCode, Bool)
forall a.
ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle ProcessHandle
ph ((ProcessHandle__ -> IO (ProcessHandle__, (Maybe ExitCode, Bool)))
-> IO (Maybe ExitCode, Bool))
-> (ProcessHandle__
-> IO (ProcessHandle__, (Maybe ExitCode, Bool)))
-> IO (Maybe ExitCode, Bool)
forall a b. (a -> b) -> a -> b
$ \ProcessHandle__
p_ ->
case ProcessHandle__
p_ of
ClosedHandle ExitCode
e -> (ProcessHandle__, (Maybe ExitCode, Bool))
-> IO (ProcessHandle__, (Maybe ExitCode, Bool))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_, (ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
e, Bool
False))
ProcessHandle__
open -> do
(Ptr CInt -> IO (ProcessHandle__, (Maybe ExitCode, Bool)))
-> IO (ProcessHandle__, (Maybe ExitCode, Bool))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (ProcessHandle__, (Maybe ExitCode, Bool)))
-> IO (ProcessHandle__, (Maybe ExitCode, Bool)))
-> (Ptr CInt -> IO (ProcessHandle__, (Maybe ExitCode, Bool)))
-> IO (ProcessHandle__, (Maybe ExitCode, Bool))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
pExitCode -> do
case ProcessHandle__ -> Maybe Pid
getHandle ProcessHandle__
open of
Maybe Pid
Nothing -> (ProcessHandle__, (Maybe ExitCode, Bool))
-> IO (ProcessHandle__, (Maybe ExitCode, Bool))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_, (Maybe ExitCode
forall a. Maybe a
Nothing, Bool
False))
Just Pid
h -> do
CInt
res <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"getProcessExitCode" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
Pid -> Ptr CInt -> IO CInt
c_getProcessExitCode Pid
h Ptr CInt
pExitCode
CInt
code <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pExitCode
if CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
then (ProcessHandle__, (Maybe ExitCode, Bool))
-> IO (ProcessHandle__, (Maybe ExitCode, Bool))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_, (Maybe ExitCode
forall a. Maybe a
Nothing, Bool
False))
else do
Pid -> IO ()
closePHANDLE Pid
h
let e :: ExitCode
e | CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 = ExitCode
ExitSuccess
| Bool
otherwise = Int -> ExitCode
ExitFailure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
code)
(ProcessHandle__, (Maybe ExitCode, Bool))
-> IO (ProcessHandle__, (Maybe ExitCode, Bool))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessHandle__
ClosedHandle ExitCode
e, (ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
e, Bool
True))
case Maybe ExitCode
m_e of
Just ExitCode
e | Bool
was_open Bool -> Bool -> Bool
&& Bool
delegating_ctlc -> ExitCode -> IO ()
endDelegateControlC ExitCode
e
Maybe ExitCode
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe ExitCode -> IO (Maybe ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExitCode
m_e
where getHandle :: ProcessHandle__ -> Maybe PHANDLE
getHandle :: ProcessHandle__ -> Maybe Pid
getHandle (OpenHandle Pid
h) = Pid -> Maybe Pid
forall a. a -> Maybe a
Just Pid
h
getHandle (ClosedHandle ExitCode
_) = Maybe Pid
forall a. Maybe a
Nothing
getHandle (OpenExtHandle Pid
h Pid
_) = Pid -> Maybe Pid
forall a. a -> Maybe a
Just Pid
h
tryLockWaitpid :: IO (Maybe ExitCode) -> IO (Maybe ExitCode)
tryLockWaitpid :: IO (Maybe ExitCode) -> IO (Maybe ExitCode)
tryLockWaitpid IO (Maybe ExitCode)
action = IO (Maybe ())
-> (Maybe () -> IO ())
-> (Maybe () -> IO (Maybe ExitCode))
-> IO (Maybe ExitCode)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Maybe ())
acquire Maybe () -> IO ()
release Maybe () -> IO (Maybe ExitCode)
between
where
acquire :: IO (Maybe ())
acquire = MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryTakeMVar (ProcessHandle -> MVar ()
waitpidLock ProcessHandle
ph)
release :: Maybe () -> IO ()
release Maybe ()
m = case Maybe ()
m of
Maybe ()
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just () -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (ProcessHandle -> MVar ()
waitpidLock ProcessHandle
ph) ()
between :: Maybe () -> IO (Maybe ExitCode)
between Maybe ()
m = case Maybe ()
m of
Maybe ()
Nothing -> Maybe ExitCode -> IO (Maybe ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExitCode
forall a. Maybe a
Nothing
Just () -> IO (Maybe ExitCode)
action
terminateProcess :: ProcessHandle -> IO ()
terminateProcess :: ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph = do
ProcessHandle -> (ProcessHandle__ -> IO ()) -> IO ()
forall a. ProcessHandle -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle ProcessHandle
ph ((ProcessHandle__ -> IO ()) -> IO ())
-> (ProcessHandle__ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessHandle__
p_ ->
case ProcessHandle__
p_ of
ClosedHandle ExitCode
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(mingw32_HOST_OS)
OpenExtHandle{} -> terminateJobUnsafe p_ 1 >> return ()
#else
OpenExtHandle{} -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"terminateProcess with OpenExtHandle should not happen on POSIX."
#endif
OpenHandle Pid
h -> do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"terminateProcess" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Pid -> IO CInt
c_terminateProcess Pid
h
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(wasm32_HOST_ARCH)
c_terminateProcess :: PHANDLE -> IO CInt
c_terminateProcess _ = ioError (ioeSetLocation unsupportedOperation "terminateProcess")
c_getProcessExitCode :: PHANDLE -> Ptr CInt -> IO CInt
c_getProcessExitCode _ _ = ioError (ioeSetLocation unsupportedOperation "getProcessExitCode")
c_waitForProcess :: PHANDLE -> Ptr CInt -> IO CInt
c_waitForProcess _ _ = ioError (ioeSetLocation unsupportedOperation "waitForProcess")
#elif defined(javascript_HOST_ARCH)
foreign import javascript unsafe "h$process_terminateProcess"
c_terminateProcess
:: PHANDLE
-> IO Int
foreign import javascript unsafe "h$process_getProcessExitCode"
c_getProcessExitCode
:: PHANDLE
-> Ptr Int
-> IO Int
foreign import javascript interruptible "h$process_waitForProcess"
c_waitForProcess
:: PHANDLE
-> Ptr CInt
-> IO CInt
#else
foreign import ccall unsafe "terminateProcess"
c_terminateProcess
:: PHANDLE
-> IO CInt
foreign import ccall unsafe "getProcessExitCode"
c_getProcessExitCode
:: PHANDLE
-> Ptr CInt
-> IO CInt
foreign import ccall interruptible "waitForProcess"
c_waitForProcess
:: PHANDLE
-> Ptr CInt
-> IO CInt
#endif
runCommand
:: String
-> IO ProcessHandle
runCommand :: String -> IO ProcessHandle
runCommand String
string = do
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
ph) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"runCommand" (String -> CreateProcess
shell String
string)
ProcessHandle -> IO ProcessHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
ph
runProcess
:: FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String,String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess :: String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess String
cmd [String]
args Maybe String
mb_cwd Maybe [(String, String)]
mb_env Maybe Handle
mb_stdin Maybe Handle
mb_stdout Maybe Handle
mb_stderr = do
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
ph) <-
String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"runProcess"
(String -> [String] -> CreateProcess
proc String
cmd [String]
args){ cwd = mb_cwd,
env = mb_env,
std_in = mbToStd mb_stdin,
std_out = mbToStd mb_stdout,
std_err = mbToStd mb_stderr }
Maybe Handle -> IO ()
maybeClose Maybe Handle
mb_stdin
Maybe Handle -> IO ()
maybeClose Maybe Handle
mb_stdout
Maybe Handle -> IO ()
maybeClose Maybe Handle
mb_stderr
ProcessHandle -> IO ProcessHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessHandle
ph
where
maybeClose :: Maybe Handle -> IO ()
maybeClose :: Maybe Handle -> IO ()
maybeClose (Just Handle
hdl)
| Handle
hdl Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
stdin Bool -> Bool -> Bool
&& Handle
hdl Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
stdout Bool -> Bool -> Bool
&& Handle
hdl Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
/= Handle
stderr = Handle -> IO ()
hClose Handle
hdl
maybeClose Maybe Handle
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mbToStd :: Maybe Handle -> StdStream
mbToStd :: Maybe Handle -> StdStream
mbToStd Maybe Handle
Nothing = StdStream
Inherit
mbToStd (Just Handle
hdl) = Handle -> StdStream
UseHandle Handle
hdl
runInteractiveCommand
:: String
-> IO (Handle,Handle,Handle,ProcessHandle)
runInteractiveCommand :: String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
string =
String
-> CreateProcess -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess1 String
"runInteractiveCommand" (String -> CreateProcess
shell String
string)
runInteractiveProcess
:: FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String,String)]
-> IO (Handle,Handle,Handle,ProcessHandle)
runInteractiveProcess :: String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
cmd [String]
args Maybe String
mb_cwd Maybe [(String, String)]
mb_env = do
String
-> CreateProcess -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess1 String
"runInteractiveProcess"
(String -> [String] -> CreateProcess
proc String
cmd [String]
args){ cwd = mb_cwd, env = mb_env }
runInteractiveProcess1
:: String
-> CreateProcess
-> IO (Handle,Handle,Handle,ProcessHandle)
runInteractiveProcess1 :: String
-> CreateProcess -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess1 String
fun CreateProcess
cmd = do
(Maybe Handle
mb_in, Maybe Handle
mb_out, Maybe Handle
mb_err, ProcessHandle
p) <-
String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
fun
CreateProcess
cmd{ std_in = CreatePipe,
std_out = CreatePipe,
std_err = CreatePipe }
(Handle, Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, Handle, ProcessHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
mb_in, Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
mb_out, Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
mb_err, ProcessHandle
p)
system :: String -> IO ExitCode
system :: String -> IO ExitCode
system String
"" = IOError -> IO ExitCode
forall a. IOError -> IO a
ioException (IOError -> String -> IOError
ioeSetErrorString (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
InvalidArgument String
"system" Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing) String
"null command")
system String
str = do
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
p) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"system" (String -> CreateProcess
shell String
str) { delegate_ctlc = True }
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
rawSystem :: String -> [String] -> IO ExitCode
rawSystem :: String -> [String] -> IO ExitCode
rawSystem String
cmd [String]
args = do
(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
p) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
"rawSystem" (String -> [String] -> CreateProcess
proc String
cmd [String]
args) { delegate_ctlc = True }
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p