{-# LANGUAGE CPP #-}
-- | Unlifted "System.Process".
--
-- @since 0.2.5.0

module UnliftIO.Process (
  -- * Running sub-processes
  CreateProcess(..), CmdSpec(..), StdStream(..), ProcessHandle, createProcess

#if MIN_VERSION_process(1,2,1)
  , createProcess_
#endif

  , P.shell, P.proc

  -- ** Simpler functions for common tasks
  , callProcess, callCommand, spawnProcess, spawnCommand

#if MIN_VERSION_process(1,2,3)
  , readCreateProcess
#endif

  , readProcess

#if MIN_VERSION_process(1,2,3)
  , readCreateProcessWithExitCode
#endif

  , readProcessWithExitCode

#if MIN_VERSION_process(1,4,3)
  , withCreateProcess
#endif

  -- ** Related utilities
  , P.showCommandForUser

  -- * Process completion
  , waitForProcess, getProcessExitCode, terminateProcess, interruptProcessGroupOf

#if MIN_VERSION_process(1,2,1)
  -- * Interprocess communication
  , createPipe
#endif

#if MIN_VERSION_process(1,4,2)
  , createPipeFd
#endif
  ) where

import Control.Monad.IO.Unlift
import System.Exit
import System.IO
import System.Posix.Internals
import System.Process
  ( CmdSpec(..)
  , CreateProcess(..)
  , ProcessHandle
  , StdStream(..)
  )
import qualified System.Process as P

-- | Lifted 'P.createProcess'.
--
-- @since 0.2.5.0
{-# INLINE createProcess #-}
createProcess ::
     MonadIO m
  => CreateProcess
  -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess :: CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess = IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> (CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess

#if MIN_VERSION_process(1,2,1)
-- | Lifted 'P.createProcess_'.
--
-- @since 0.2.5.0
{-# INLINE createProcess_ #-}
createProcess_ ::
     MonadIO m
  => String
  -> CreateProcess
  -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ :: String
-> CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
msg CreateProcess
proc_ = IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess_ String
msg CreateProcess
proc_)
#endif

-- | Lifted 'P.callProcess'.
--
-- @since 0.2.5.0
{-# INLINE callProcess #-}
callProcess :: MonadIO m => FilePath -> [String] -> m ()
callProcess :: String -> [String] -> m ()
callProcess String
cmd [String]
args = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [String] -> IO ()
P.callProcess String
cmd [String]
args)

-- | Lifted 'P.callCommand'.
--
-- @since 0.2.5.0
{-# INLINE callCommand #-}
callCommand :: MonadIO m => String -> m ()
callCommand :: String -> m ()
callCommand = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
P.callCommand

-- | Lifted 'P.spawnProcess'.
--
-- @since 0.2.5.0
{-# INLINE spawnProcess #-}
spawnProcess :: MonadIO m => FilePath -> [String] -> m ProcessHandle
spawnProcess :: String -> [String] -> m ProcessHandle
spawnProcess String
cmd [String]
args = IO ProcessHandle -> m ProcessHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [String] -> IO ProcessHandle
P.spawnProcess String
cmd [String]
args)

-- | Lifted 'P.spawnCommand'.
--
-- @since 0.2.5.0
{-# INLINE spawnCommand #-}
spawnCommand :: MonadIO m => String -> m ProcessHandle
spawnCommand :: String -> m ProcessHandle
spawnCommand = IO ProcessHandle -> m ProcessHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessHandle -> m ProcessHandle)
-> (String -> IO ProcessHandle) -> String -> m ProcessHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ProcessHandle
P.spawnCommand

#if MIN_VERSION_process(1,2,3)
-- | Lifted 'P.readCreateProcess'.
--
-- @since 0.2.5.0
{-# INLINE readCreateProcess #-}
readCreateProcess :: MonadIO m => CreateProcess -> String -> m String
readCreateProcess :: CreateProcess -> String -> m String
readCreateProcess CreateProcess
cp String
input = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess -> String -> IO String
P.readCreateProcess CreateProcess
cp String
input)
#endif

-- | Lifted 'P.readProcess'.
--
-- @since 0.2.5.0
{-# INLINE readProcess #-}
readProcess :: MonadIO m => FilePath -> [String] -> String -> m String
readProcess :: String -> [String] -> String -> m String
readProcess String
cmd [String]
args String
input = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [String] -> String -> IO String
P.readProcess String
cmd [String]
args String
input)

#if MIN_VERSION_process(1,2,3)
-- | Lifted 'P.readCreateProcessWithExitCode'.
--
-- @since 0.2.5.0
{-# INLINE readCreateProcessWithExitCode #-}
readCreateProcessWithExitCode ::
     MonadIO m => CreateProcess -> String -> m (ExitCode, String, String)
readCreateProcessWithExitCode :: CreateProcess -> String -> m (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
cp String
input =
  IO (ExitCode, String, String) -> m (ExitCode, String, String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess -> String -> IO (ExitCode, String, String)
P.readCreateProcessWithExitCode CreateProcess
cp String
input)
#endif

-- | Lifted 'P.readProcessWithExitCode'.
--
-- @since 0.2.5.0
{-# INLINE readProcessWithExitCode #-}
readProcessWithExitCode ::
     MonadIO m => FilePath -> [String] -> String -> m (ExitCode, String, String)
readProcessWithExitCode :: String -> [String] -> String -> m (ExitCode, String, String)
readProcessWithExitCode String
cmd [String]
args String
input =
  IO (ExitCode, String, String) -> m (ExitCode, String, String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> [String] -> String -> IO (ExitCode, String, String)
P.readProcessWithExitCode String
cmd [String]
args String
input)

#if MIN_VERSION_process(1,4,3)
-- | Unlifted 'P.withCreateProcess'.
--
-- @since 0.2.5.0
{-# INLINE withCreateProcess #-}
withCreateProcess ::
     MonadUnliftIO m
  => CreateProcess
  -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> m a)
  -> m a
withCreateProcess :: CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> m a)
-> m a
withCreateProcess CreateProcess
c Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> m a
action =
  ((forall a. m a -> IO a) -> IO a) -> m a
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO
    (\forall a. m a -> IO a
u ->
       CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
P.withCreateProcess
         CreateProcess
c
         (\Maybe Handle
stdin_h Maybe Handle
stdout_h Maybe Handle
stderr_h ProcessHandle
proc_h ->
            m a -> IO a
forall a. m a -> IO a
u (Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> m a
action Maybe Handle
stdin_h Maybe Handle
stdout_h Maybe Handle
stderr_h ProcessHandle
proc_h)))
#endif

-- | Lifted 'P.waitForProcess'.
--
-- @since 0.2.5.0
{-# INLINE waitForProcess #-}
waitForProcess :: MonadIO m => ProcessHandle -> m ExitCode
waitForProcess :: ProcessHandle -> m ExitCode
waitForProcess = IO ExitCode -> m ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> m ExitCode)
-> (ProcessHandle -> IO ExitCode) -> ProcessHandle -> m ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO ExitCode
P.waitForProcess

-- | Lifted 'P.getProcessExitCode'.
--
-- @since 0.2.5.0
{-# INLINE getProcessExitCode #-}
getProcessExitCode :: MonadIO m => ProcessHandle -> m (Maybe ExitCode)
getProcessExitCode :: ProcessHandle -> m (Maybe ExitCode)
getProcessExitCode = IO (Maybe ExitCode) -> m (Maybe ExitCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ExitCode) -> m (Maybe ExitCode))
-> (ProcessHandle -> IO (Maybe ExitCode))
-> ProcessHandle
-> m (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO (Maybe ExitCode)
P.getProcessExitCode

-- | Lifted 'P.terminateProcess'.
--
-- @since 0.2.5.0
{-# INLINE terminateProcess #-}
terminateProcess :: MonadIO m => ProcessHandle -> m ()
terminateProcess :: ProcessHandle -> m ()
terminateProcess = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (ProcessHandle -> IO ()) -> ProcessHandle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO ()
P.terminateProcess

-- | Lifted 'P.interruptProcessGroupOf'.
--
-- @since 0.2.5.0
{-# INLINE interruptProcessGroupOf #-}
interruptProcessGroupOf :: MonadIO m => ProcessHandle -> m ()
interruptProcessGroupOf :: ProcessHandle -> m ()
interruptProcessGroupOf = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (ProcessHandle -> IO ()) -> ProcessHandle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO ()
P.interruptProcessGroupOf

#if MIN_VERSION_process(1,2,1)
-- | Lifted 'P.createPipe'.
--
-- @since 0.2.5.0
{-# INLINE createPipe #-}
createPipe :: MonadIO m => m (Handle, Handle)
createPipe :: m (Handle, Handle)
createPipe = IO (Handle, Handle) -> m (Handle, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Handle, Handle)
P.createPipe
#endif

#if MIN_VERSION_process(1,4,2)
-- | Lifted 'P.createPipeFd'.
--
-- @since 0.2.5.0
{-# INLINE createPipeFd #-}
createPipeFd :: MonadIO m => m (FD, FD)
createPipeFd :: m (FD, FD)
createPipeFd = IO (FD, FD) -> m (FD, FD)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (FD, FD)
P.createPipeFd
#endif