{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module Control.Process.Process
  ( module Process,
    readCreateProcessWithExitCode,
    readProcessWithExitCode,
    waitForProcess,
    getProcessExitCode,
    getProcessExitCodeBool,
    getPid,
  )
where

import Control.Applicative (Applicative (pure))
import Control.Category (Category ((.)))
import Control.Exception (Exception)
import Control.Exitcode
  ( Exitcode,
    bimapExitcode,
    fromExitCode',
    hoistExitcode,
    liftTryExitcode,
    mkExitSuccess,
    tryExitcode,
  )
import Control.Monad (Monad ((>>=)))
import Control.Monad.Except (ExceptT (..))
import Data.Bool (Bool)
import Data.Function (const)
import Data.Functor.Identity (runIdentity)
import Data.Maybe (Maybe (..), isJust, maybe)
import Data.String (String)
import System.FilePath (FilePath)
import System.IO (IO)
import System.Process as Process
  ( CmdSpec (..),
    CreateProcess (),
    Pid,
    ProcessHandle,
    StdStream (..),
    callCommand,
    callProcess,
    cleanupProcess,
    createPipe,
    createPipeFd,
    createProcess,
    createProcess_,
    getCurrentPid,
    interruptProcessGroupOf,
    proc,
    readCreateProcess,
    readProcess,
    shell,
    showCommandForUser,
    spawnProcess,
    terminateProcess,
    withCreateProcess,
  )
import qualified System.Process as P (getProcessExitCode, getPid, readCreateProcessWithExitCode, readProcessWithExitCode, waitForProcess)

getPid :: ProcessHandle -> IO (Maybe Pid)
getPid :: ProcessHandle -> IO (Maybe Pid)
getPid = ProcessHandle -> IO (Maybe Pid)
P.getPid

-- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it
-- lets you pass 'CreateProcess' giving better flexibility.
--
-- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess
-- record will be ignored.
{-# INLINE readCreateProcessWithExitCode #-}
readCreateProcessWithExitCode ::
  (Exception e') =>
  CreateProcess ->
  -- | standard input
  String ->
  -- | exitcode, stdout, stderr
  Exitcode (String, String) (ExceptT e' IO) (String, String)
readCreateProcessWithExitCode :: forall e'.
Exception e' =>
CreateProcess
-> String
-> Exitcode (String, String) (ExceptT e' IO) (String, String)
readCreateProcessWithExitCode CreateProcess
p String
a =
  Exitcode (String, String) IO (ExitCode, String, String)
-> Exitcode
     (String, String) (ExceptT e' IO) (ExitCode, String, String)
forall e' e a.
Exception e' =>
Exitcode e IO a -> Exitcode e (ExceptT e' IO) a
tryExitcode (IO (ExitCode, String, String)
-> Exitcode (String, String) IO (ExitCode, String, String)
forall (f :: * -> *) a e. Functor f => f a -> Exitcode e f a
mkExitSuccess (CreateProcess -> String -> IO (ExitCode, String, String)
P.readCreateProcessWithExitCode CreateProcess
p String
a)) Exitcode
  (String, String) (ExceptT e' IO) (ExitCode, String, String)
-> ((ExitCode, String, String)
    -> Exitcode (String, String) (ExceptT e' IO) (String, String))
-> Exitcode (String, String) (ExceptT e' IO) (String, String)
forall a b.
Exitcode (String, String) (ExceptT e' IO) a
-> (a -> Exitcode (String, String) (ExceptT e' IO) b)
-> Exitcode (String, String) (ExceptT e' IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ExitCode
x, String
y, String
z) ->
    (forall x. Identity x -> ExceptT e' IO x)
-> Exitcode (String, String) Identity (String, String)
-> Exitcode (String, String) (ExceptT e' IO) (String, String)
forall (f :: * -> *) (g :: * -> *) e a.
(forall x. f x -> g x) -> Exitcode e f a -> Exitcode e g a
hoistExitcode (x -> ExceptT e' IO x
forall a. a -> ExceptT e' IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> ExceptT e' IO x)
-> (Identity x -> x) -> Identity x -> ExceptT e' IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity x -> x
forall a. Identity a -> a
runIdentity) ((() -> (String, String))
-> (() -> (String, String))
-> Exitcode () Identity ()
-> Exitcode (String, String) Identity (String, String)
forall (f :: * -> *) e e' a a'.
Functor f =>
(e -> e') -> (a -> a') -> Exitcode e f a -> Exitcode e' f a'
bimapExitcode ((String, String) -> () -> (String, String)
forall a b. a -> b -> a
const (String
y, String
z)) ((String, String) -> () -> (String, String)
forall a b. a -> b -> a
const (String
y, String
z)) (ExitCode -> Exitcode () Identity ()
fromExitCode' ExitCode
x))

{-# INLINE readProcessWithExitCode #-}
readProcessWithExitCode ::
  (Exception e') =>
  -- | Filename of the executable (see 'RawCommand' for details)
  FilePath ->
  -- | any arguments
  [String] ->
  -- | standard input
  String ->
  -- | exitcode, stdout, stderr
  Exitcode (String, String) (ExceptT e' IO) (String, String)
readProcessWithExitCode :: forall e'.
Exception e' =>
String
-> [String]
-> String
-> Exitcode (String, String) (ExceptT e' IO) (String, String)
readProcessWithExitCode String
p [String]
a String
i =
  Exitcode (String, String) IO (ExitCode, String, String)
-> Exitcode
     (String, String) (ExceptT e' IO) (ExitCode, String, String)
forall e' e a.
Exception e' =>
Exitcode e IO a -> Exitcode e (ExceptT e' IO) a
tryExitcode (IO (ExitCode, String, String)
-> Exitcode (String, String) IO (ExitCode, String, String)
forall (f :: * -> *) a e. Functor f => f a -> Exitcode e f a
mkExitSuccess (String -> [String] -> String -> IO (ExitCode, String, String)
P.readProcessWithExitCode String
p [String]
a String
i)) Exitcode
  (String, String) (ExceptT e' IO) (ExitCode, String, String)
-> ((ExitCode, String, String)
    -> Exitcode (String, String) (ExceptT e' IO) (String, String))
-> Exitcode (String, String) (ExceptT e' IO) (String, String)
forall a b.
Exitcode (String, String) (ExceptT e' IO) a
-> (a -> Exitcode (String, String) (ExceptT e' IO) b)
-> Exitcode (String, String) (ExceptT e' IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ExitCode
x, String
y, String
z) ->
    (forall x. Identity x -> ExceptT e' IO x)
-> Exitcode (String, String) Identity (String, String)
-> Exitcode (String, String) (ExceptT e' IO) (String, String)
forall (f :: * -> *) (g :: * -> *) e a.
(forall x. f x -> g x) -> Exitcode e f a -> Exitcode e g a
hoistExitcode (x -> ExceptT e' IO x
forall a. a -> ExceptT e' IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> ExceptT e' IO x)
-> (Identity x -> x) -> Identity x -> ExceptT e' IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity x -> x
forall a. Identity a -> a
runIdentity) ((() -> (String, String))
-> (() -> (String, String))
-> Exitcode () Identity ()
-> Exitcode (String, String) Identity (String, String)
forall (f :: * -> *) e e' a a'.
Functor f =>
(e -> e') -> (a -> a') -> Exitcode e f a -> Exitcode e' f a'
bimapExitcode ((String, String) -> () -> (String, String)
forall a b. a -> b -> a
const (String
y, String
z)) ((String, String) -> () -> (String, String)
forall a b. a -> b -> a
const (String
y, String
z)) (ExitCode -> Exitcode () Identity ()
fromExitCode' ExitCode
x))

-- | Waits for the specified process to terminate, and returns its exit code.
-- On Unix systems, may throw 'UserInterrupt' when using 'delegate_ctlc'.
--
-- GHC Note: in order to call @waitForProcess@ without blocking all the
-- other threads in the system, you must compile the program with
-- @-threaded@.
--
-- Note that it is safe to call @waitForProcess@ for the same process in multiple
-- threads. When the process ends, threads blocking on this call will wake in
-- FIFO order. When using 'delegate_ctlc' and the process is interrupted, only
-- the first waiting thread will throw 'UserInterrupt'.
--
-- (/Since: 1.2.0.0/) On Unix systems, a negative value @'ExitFailure' -/signum/@
-- indicates that the child was terminated by signal @/signum/@.
-- The signal numbers are platform-specific, so to test for a specific signal use
-- the constants provided by "System.Posix.Signals" in the @unix@ package.
-- Note: core dumps are not reported, use "System.Posix.Process" if you need this
-- detail.
{-# INLINE waitForProcess #-}
waitForProcess ::
  (Exception e') =>
  ProcessHandle ->
  Exitcode () (ExceptT e' IO) ()
waitForProcess :: forall e'.
Exception e' =>
ProcessHandle -> Exitcode () (ExceptT e' IO) ()
waitForProcess ProcessHandle
h =
  Exitcode () IO ExitCode -> Exitcode () (ExceptT e' IO) ExitCode
forall e' e a.
Exception e' =>
Exitcode e IO a -> Exitcode e (ExceptT e' IO) a
tryExitcode (IO ExitCode -> Exitcode () IO ExitCode
forall (f :: * -> *) a e. Functor f => f a -> Exitcode e f a
mkExitSuccess (ProcessHandle -> IO ExitCode
P.waitForProcess ProcessHandle
h)) Exitcode () (ExceptT e' IO) ExitCode
-> (ExitCode -> Exitcode () (ExceptT e' IO) ())
-> Exitcode () (ExceptT e' IO) ()
forall a b.
Exitcode () (ExceptT e' IO) a
-> (a -> Exitcode () (ExceptT e' IO) b)
-> Exitcode () (ExceptT e' IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ExitCode
x ->
    (forall x. Identity x -> ExceptT e' IO x)
-> Exitcode () Identity () -> Exitcode () (ExceptT e' IO) ()
forall (f :: * -> *) (g :: * -> *) e a.
(forall x. f x -> g x) -> Exitcode e f a -> Exitcode e g a
hoistExitcode (x -> ExceptT e' IO x
forall a. a -> ExceptT e' IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> ExceptT e' IO x)
-> (Identity x -> x) -> Identity x -> ExceptT e' IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity x -> x
forall a. Identity a -> a
runIdentity) (ExitCode -> Exitcode () Identity ()
fromExitCode' ExitCode
x)

-- |
-- This is a non-blocking version of 'waitForProcess'.  If the process is
-- still running, 'Nothing' is returned.  If the process has exited, then
-- @'Just' e@ is returned where @e@ is the exit code of the process.
--
-- On Unix systems, see 'waitForProcess' for the meaning of exit codes
-- when the process died as the result of a signal. May throw
-- 'UserInterrupt' when using 'delegate_ctlc'.
{-# INLINE getProcessExitCode #-}
getProcessExitCode ::
  (Exception e') =>
  ProcessHandle ->
  Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
getProcessExitCode :: forall e'.
Exception e' =>
ProcessHandle -> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
getProcessExitCode ProcessHandle
h =
  IO (Maybe ExitCode)
-> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ExitCode)
forall e' a e. Exception e' => IO a -> Exitcode e (ExceptT e' IO) a
liftTryExitcode (ProcessHandle -> IO (Maybe ExitCode)
P.getProcessExitCode ProcessHandle
h)
    Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ExitCode)
-> (Maybe ExitCode
    -> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ()))
-> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
forall a b.
Exitcode (Maybe ()) (ExceptT e' IO) a
-> (a -> Exitcode (Maybe ()) (ExceptT e' IO) b)
-> Exitcode (Maybe ()) (ExceptT e' IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
-> (ExitCode -> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ()))
-> Maybe ExitCode
-> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe () -> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
forall a. a -> Exitcode (Maybe ()) (ExceptT e' IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ()
forall a. Maybe a
Nothing) ((forall x. Identity x -> ExceptT e' IO x)
-> Exitcode (Maybe ()) Identity (Maybe ())
-> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
forall (f :: * -> *) (g :: * -> *) e a.
(forall x. f x -> g x) -> Exitcode e f a -> Exitcode e g a
hoistExitcode (x -> ExceptT e' IO x
forall a. a -> ExceptT e' IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> ExceptT e' IO x)
-> (Identity x -> x) -> Identity x -> ExceptT e' IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity x -> x
forall a. Identity a -> a
runIdentity) (Exitcode (Maybe ()) Identity (Maybe ())
 -> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ()))
-> (ExitCode -> Exitcode (Maybe ()) Identity (Maybe ()))
-> ExitCode
-> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (() -> Maybe ())
-> (() -> Maybe ())
-> Exitcode () Identity ()
-> Exitcode (Maybe ()) Identity (Maybe ())
forall (f :: * -> *) e e' a a'.
Functor f =>
(e -> e') -> (a -> a') -> Exitcode e f a -> Exitcode e' f a'
bimapExitcode (Maybe () -> () -> Maybe ()
forall a b. a -> b -> a
const (() -> Maybe ()
forall a. a -> Maybe a
Just ())) (Maybe () -> () -> Maybe ()
forall a b. a -> b -> a
const (() -> Maybe ()
forall a. a -> Maybe a
Just ())) (Exitcode () Identity ()
 -> Exitcode (Maybe ()) Identity (Maybe ()))
-> (ExitCode -> Exitcode () Identity ())
-> ExitCode
-> Exitcode (Maybe ()) Identity (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ExitCode -> Exitcode () Identity ()
fromExitCode')

-- |
-- This is a non-blocking version of 'waitForProcess'.  If the process is
-- still running, 'Nothing' is returned.  If the process has exited, then
-- @'Just' e@ is returned where @e@ is the exit code of the process.
--
-- On Unix systems, see 'waitForProcess' for the meaning of exit codes
-- when the process died as the result of a signal. May throw
-- 'UserInterrupt' when using 'delegate_ctlc'.
{-# INLINE getProcessExitCodeBool #-}
getProcessExitCodeBool ::
  (Exception e') =>
  ProcessHandle ->
  Exitcode Bool (ExceptT e' IO) Bool
getProcessExitCodeBool :: forall e'.
Exception e' =>
ProcessHandle -> Exitcode Bool (ExceptT e' IO) Bool
getProcessExitCodeBool ProcessHandle
h =
  (Maybe () -> Bool)
-> (Maybe () -> Bool)
-> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
-> Exitcode Bool (ExceptT e' IO) Bool
forall (f :: * -> *) e e' a a'.
Functor f =>
(e -> e') -> (a -> a') -> Exitcode e f a -> Exitcode e' f a'
bimapExitcode Maybe () -> Bool
forall a. Maybe a -> Bool
isJust Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (ProcessHandle -> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
forall e'.
Exception e' =>
ProcessHandle -> Exitcode (Maybe ()) (ExceptT e' IO) (Maybe ())
getProcessExitCode ProcessHandle
h)