Process.hs

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

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

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

-- | @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.
readCreateProcessWithExitCode ::
  Exception e' =>
  CreateProcess
  -> String -- ^ standard input
  -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) -- ^ exitcode, stdout, stderr
readCreateProcessWithExitCode p a =
  tryExitcode (liftExitcode (P.readCreateProcessWithExitCode p a)) >>= \(x, y, z) ->
    hoistExitcode (pure . runIdentity) (set _Exitcode1 (y, z) (fromExitCode' x))

readProcessWithExitCode ::
  Exception e' =>
  FilePath -- ^ Filename of the executable (see 'RawCommand' for details)
  -> [String] -- ^ any arguments
  -> String -- ^ standard input
  -> ExitcodeT (ExceptT e' IO) (String, String) (String, String) -- ^ exitcode, stdout, stderr
readProcessWithExitCode p a i =
  tryExitcode (liftExitcode (P.readProcessWithExitCode p a i)) >>= \(x, y, z) ->
    hoistExitcode (pure . runIdentity) (set _Exitcode1 (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.

-}
waitForProcess ::
  Exception e' =>
  ProcessHandle
  -> ExitcodeT (ExceptT e' IO) () ()
waitForProcess h =
  tryExitcode (liftExitcode (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'.
-}
getProcessExitCode ::
  Exception e' =>
  ProcessHandle
  -> ExitcodeT (ExceptT e' IO) (Maybe ()) (Maybe ())
getProcessExitCode h =
  liftTryExitcode (P.getProcessExitCode h) >>=
    maybe (pure Nothing) (hoistExitcode (pure . runIdentity) . set _Exitcode1 (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'.
-}
getProcessExitCodeBool ::
  Exception e' =>
  ProcessHandle
  -> ExitcodeT (ExceptT e' IO) Bool Bool
getProcessExitCodeBool =
  bimap isJust isJust . getProcessExitCode