Process.hs

{-# 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 = 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 p a =
  tryExitcode (mkExitSuccess (P.readCreateProcessWithExitCode p a)) >>= \(x, y, z) ->
    hoistExitcode (pure . runIdentity) (bimapExitcode (const (y, z)) (const (y, z)) (fromExitCode' 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 p a i =
  tryExitcode (mkExitSuccess (P.readProcessWithExitCode p a i)) >>= \(x, y, z) ->
    hoistExitcode (pure . runIdentity) (bimapExitcode (const (y, z)) (const (y, z)) (fromExitCode' 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 h =
  tryExitcode (mkExitSuccess (P.waitForProcess h)) >>= \x ->
    hoistExitcode (pure . runIdentity) (fromExitCode' 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 h =
  liftTryExitcode (P.getProcessExitCode h)
    >>= maybe (pure Nothing) (hoistExitcode (pure . runIdentity) . bimapExitcode (const (Just ())) (const (Just ())) . 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 h =
  bimapExitcode isJust isJust (getProcessExitCode h)