{-# 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 (SomeException, mask
#if !defined(javascript_HOST_ARCH)
                         , allowInterrupt
#endif
                         , bracket, try, throwIO)
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(WINDOWS)
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(..), IOException(..) )
#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(WINDOWS)
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 :: Bool
delegate_ctlc = Bool
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 :: Bool
delegate_ctlc = Bool
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 =
      IOException -> IO a
forall a. IOException -> IO a
ioError (IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
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 :: StdStream
std_in  = StdStream
CreatePipe,
                    std_out :: StdStream
std_out = StdStream
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 :: StdStream
std_in  = StdStream
CreatePipe,
                    std_out :: StdStream
std_out = StdStream
CreatePipe,
                    std_err :: StdStream
std_err = StdStream
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."
withForkWait :: IO () -> (IO () ->  IO a) -> IO a
withForkWait :: forall a. IO () -> (IO () -> IO a) -> IO a
withForkWait IO ()
async IO () -> IO a
body = do
  MVar (Either SomeException ())
waitVar <- IO (MVar (Either SomeException ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either SomeException ()))
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO ()
forall a. IO a -> IO a
restore IO ()
async) IO (Either SomeException ())
-> (Either SomeException () -> 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
>>= MVar (Either SomeException ()) -> Either SomeException () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException ())
waitVar
    let wait :: IO ()
wait = MVar (Either SomeException ()) -> IO (Either SomeException ())
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException ())
waitVar IO (Either SomeException ())
-> (Either SomeException () -> 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
>>= (SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    IO a -> IO a
forall a. IO a -> IO a
restore (IO () -> IO a
body IO ()
wait) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`C.onException` ThreadId -> IO ()
killThread ThreadId
tid
ignoreSigPipe :: IO () -> IO ()
ignoreSigPipe :: IO () -> IO ()
ignoreSigPipe = (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle ((IOException -> IO ()) -> IO () -> IO ())
-> (IOException -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
e -> case IOException
e of
                                   IOError { ioe_type :: IOException -> IOErrorType
ioe_type  = IOErrorType
ResourceVanished
                                           , ioe_errno :: IOException -> Maybe CInt
ioe_errno = Just CInt
ioe }
                                     | CInt -> Errno
Errno CInt
ioe Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
ePIPE -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                   IOException
_ -> IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
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(WINDOWS)
    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(WINDOWS)
    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 a. IO a -> IO a
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(WINDOWS)
    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(WINDOWS)
      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 :: Maybe String
cwd = Maybe String
mb_cwd,
                          env :: Maybe [(String, String)]
env = Maybe [(String, String)]
mb_env,
                          std_in :: StdStream
std_in  = Maybe Handle -> StdStream
mbToStd Maybe Handle
mb_stdin,
                          std_out :: StdStream
std_out = Maybe Handle -> StdStream
mbToStd Maybe Handle
mb_stdout,
                          std_err :: StdStream
std_err = Maybe Handle -> StdStream
mbToStd Maybe Handle
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 :: Maybe String
cwd = Maybe String
mb_cwd, env :: Maybe [(String, String)]
env = Maybe [(String, String)]
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 :: StdStream
std_in  = StdStream
CreatePipe,
                std_out :: StdStream
std_out = StdStream
CreatePipe,
                std_err :: StdStream
std_err = StdStream
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
"" = IOException -> IO ExitCode
forall a. IOException -> IO a
ioException (IOException -> String -> IOException
ioeSetErrorString (IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
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 :: Bool
delegate_ctlc = Bool
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 :: Bool
delegate_ctlc = Bool
True }
  ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p