module RawFilePath.Process.Basic where

-- base modules

import RawFilePath.Import hiding (ClosedHandle)

-- local modules

import RawFilePath.Process.Common
import RawFilePath.Process.Internal
import RawFilePath.Process.Posix

-- | Start a new sub-process with the given configuration.
startProcess
    :: (StreamType stdin, StreamType stdout, StreamType stderr)
    => ProcessConf stdin stdout stderr
    -> IO (Process stdin stdout stderr)
startProcess :: forall stdin stdout stderr.
(StreamType stdin, StreamType stdout, StreamType stderr) =>
ProcessConf stdin stdout stderr -> IO (Process stdin stdout stderr)
startProcess = forall stdin stdout stderr.
(StreamType stdin, StreamType stdout, StreamType stderr) =>
ProcessConf stdin stdout stderr -> IO (Process stdin stdout stderr)
createProcessInternal

-- | Stop a sub-process. For now it simply calls 'terminateProcess' and then
-- 'waitForProcess'.
stopProcess :: Process stdin stdout stderr -> IO ExitCode
stopProcess :: forall stdin stdout stderr.
Process stdin stdout stderr -> IO ExitCode
stopProcess Process stdin stdout stderr
p = do
    forall stdin stdout stderr. Process stdin stdout stderr -> IO ()
terminateProcess Process stdin stdout stderr
p
    forall stdin stdout stderr.
Process stdin stdout stderr -> IO ExitCode
waitForProcess Process stdin stdout stderr
p

-- | Wait (block) for a sub-process to exit and obtain its exit code.
waitForProcess
  :: Process stdin stdout stderr
  -> IO ExitCode
waitForProcess :: forall stdin stdout stderr.
Process stdin stdout stderr -> IO ExitCode
waitForProcess Process stdin stdout stderr
ph = forall {b}. IO b -> IO b
lockWaitpid forall a b. (a -> b) -> a -> b
$ do
  ProcessHandle__
p_ <- forall stdin stdout stderr a.
Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle Process stdin stdout stderr
ph forall a b. (a -> b) -> a -> b
$ \ ProcessHandle__
p_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_,ProcessHandle__
p_)
  case ProcessHandle__
p_ of
    ClosedHandle ExitCode
e -> forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
e
    OpenHandle PHANDLE
h  -> do
        ExitCode
e <- forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
pret -> do
          -- don't hold the MVar while we call c_waitForProcess...
          forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"waitForProcess" (PHANDLE -> Ptr CInt -> IO CInt
c_waitForProcess PHANDLE
h Ptr CInt
pret)
          forall stdin stdout stderr a.
Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle Process stdin stdout stderr
ph forall a b. (a -> b) -> a -> b
$ \ ProcessHandle__
p_' ->
            case ProcessHandle__
p_' of
              ClosedHandle ExitCode
e  -> forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_', ExitCode
e)
              OpenExtHandle{} -> forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_', Int -> ExitCode
ExitFailure (-Int
1))
              OpenHandle PHANDLE
ph'  -> do
                PHANDLE -> IO ()
closePHANDLE PHANDLE
ph'
                CInt
code <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pret
                let e :: ExitCode
e = if CInt
code forall a. Eq a => a -> a -> Bool
== CInt
0
                       then ExitCode
ExitSuccess
                       else Int -> ExitCode
ExitFailure (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
code)
                forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessHandle__
ClosedHandle ExitCode
e, ExitCode
e)
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delegatingCtlc forall a b. (a -> b) -> a -> b
$
          ExitCode -> IO ()
endDelegateControlC ExitCode
e
        forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
e
    OpenExtHandle PHANDLE
_ PHANDLE
_job PHANDLE
_iocp ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure (-Int
1)
  where
    -- If more than one thread calls `waitpid` at a time, `waitpid` will
    -- return the exit code to one of them and (-1) to the rest of them,
    -- causing an exception to be thrown.
    -- Cf. https://github.com/haskell/process/issues/46, and
    -- https://github.com/haskell/process/pull/58 for further discussion
    lockWaitpid :: IO b -> IO b
lockWaitpid IO b
m = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
waitpidLock Process stdin stdout stderr
ph) forall a b. (a -> b) -> a -> b
$ \ () -> IO b
m
    delegatingCtlc :: Bool
delegatingCtlc = forall stdin stdout stderr. Process stdin stdout stderr -> Bool
mbDelegateCtlc Process stdin stdout stderr
ph

-- | Terminate a sub-process by sending SIGTERM to it.
terminateProcess :: Process stdin stdout stderr -> IO ()
terminateProcess :: forall stdin stdout stderr. Process stdin stdout stderr -> IO ()
terminateProcess Process stdin stdout stderr
p = forall stdin stdout stderr a.
Process stdin stdout stderr -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle Process stdin stdout stderr
p forall a b. (a -> b) -> a -> b
$ \ case
    ClosedHandle  ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    OpenExtHandle{} -> forall a. HasCallStack => String -> a
error
        String
"terminateProcess with OpenExtHandle should not happen on POSIX."
    OpenHandle    PHANDLE
h -> do
        forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"terminateProcess" forall a b. (a -> b) -> a -> b
$ PHANDLE -> IO CInt
c_terminateProcess PHANDLE
h
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- does not close the handle, we might want to try terminating it
        -- again, or get its exit code.