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 = 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 :: forall stdin stdout stderr.
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 :: forall stdin stdout stderr.
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 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 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle__
p_', ExitCode
e)
            OpenExtHandle{} -> (ProcessHandle__, ExitCode) -> IO (ProcessHandle__, ExitCode)
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
e
    OpenExtHandle PHANDLE
_ PHANDLE
_job PHANDLE
_iocp ->
      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)
 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 :: forall stdin stdout stderr. 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 a. a -> IO a
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 a. a -> IO a
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.