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 :: ProcessConf stdin stdout stderr -> IO (Process stdin stdout stderr)
startProcess = ProcessConf stdin stdout stderr -> IO (Process stdin stdout stderr)
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 :: Process stdin stdout stderr -> IO ExitCode
stopProcess Process stdin stdout stderr
p = do
    Process stdin stdout stderr -> IO ()
forall stdin stdout stderr. Process stdin stdout stderr -> IO ()
terminateProcess Process stdin stdout stderr
p
    Process stdin stdout stderr -> IO ExitCode
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 :: Process stdin stdout stderr -> IO ExitCode
waitForProcess Process stdin stdout stderr
ph = 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_ <- Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, ProcessHandle__))
-> IO ProcessHandle__
forall stdin stdout stderr a.
Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle Process stdin stdout stderr
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 (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_,ProcessHandle__
p_)
  case ProcessHandle__
p_ of
    ClosedHandle ExitCode
e -> ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
e
    OpenHandle PHANDLE
h  -> do
        ExitCode
e <- (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
          -- don't hold the MVar while we call c_waitForProcess...
          String -> IO CInt -> IO ()
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)
          Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, ExitCode))
-> IO ExitCode
forall stdin stdout stderr a.
Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle Process stdin stdout stderr
ph ((ProcessHandle__ -> IO (ProcessHandle__, ExitCode))
 -> IO ExitCode)
-> (ProcessHandle__ -> IO (ProcessHandle__, ExitCode))
-> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \ ProcessHandle__
p_' ->
            case ProcessHandle__
p_' of
              ClosedHandle ExitCode
e  -> (ProcessHandle__, ExitCode) -> IO (ProcessHandle__, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_', ExitCode
e)
              OpenExtHandle{} -> (ProcessHandle__, ExitCode) -> IO (ProcessHandle__, ExitCode)
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 <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pret
                let e :: ExitCode
e = if CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
                       then ExitCode
ExitSuccess
                       else Int -> ExitCode
ExitFailure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
code)
                (ProcessHandle__, ExitCode) -> IO (ProcessHandle__, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessHandle__
ClosedHandle ExitCode
e, ExitCode
e)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delegatingCtlc (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          ExitCode -> IO ()
endDelegateControlC ExitCode
e
        ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
e
    OpenExtHandle PHANDLE
_ PHANDLE
_job PHANDLE
_iocp ->
        ExitCode -> IO ExitCode
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)
  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 = MVar () -> (() -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Process stdin stdout stderr -> MVar ()
forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
waitpidLock Process stdin stdout stderr
ph) ((() -> IO b) -> IO b) -> (() -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ () -> IO b
m
    delegatingCtlc :: Bool
delegatingCtlc = Process stdin stdout stderr -> Bool
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 :: Process stdin stdout stderr -> IO ()
terminateProcess Process stdin stdout stderr
p = Process stdin stdout stderr -> (ProcessHandle__ -> IO ()) -> IO ()
forall stdin stdout stderr a.
Process stdin stdout stderr -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle Process stdin stdout stderr
p ((ProcessHandle__ -> IO ()) -> IO ())
-> (ProcessHandle__ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ case
    ClosedHandle  ExitCode
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    OpenExtHandle{} -> String -> IO ()
forall a. HasCallStack => String -> a
error
        String
"terminateProcess with OpenExtHandle should not happen on POSIX."
    OpenHandle    PHANDLE
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
$ PHANDLE -> IO CInt
c_terminateProcess PHANDLE
h
        () -> IO ()
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.