{-# LANGUAGE CPP #-}
-- | Lifted "System.Process".
module Effectful.Process
  ( -- * Effect
    Process

    -- ** Handlers
  , runProcess

    -- * Running sub-processes
  , createProcess
  , createProcess_
  , P.shell
  , P.proc
  , P.CreateProcess(..)
  , P.CmdSpec(..)
  , P.StdStream(..)
  , P.ProcessHandle

    -- ** Simpler functions for common tasks
  , callProcess
  , callCommand
  , spawnProcess
  , spawnCommand
  , readCreateProcess
  , readProcess
  , readCreateProcessWithExitCode
  , readProcessWithExitCode
  , withCreateProcess
  , cleanupProcess

    -- ** Related utilities
  , P.showCommandForUser
  , P.Pid
  , getPid
#if MIN_VERSION_process(1,6,12)
  , getCurrentPid
#endif

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

    -- * Interprocess communication
  , createPipe
  , createPipeFd
  ) where

import System.Exit (ExitCode)
import System.IO (Handle)
import System.Posix.Internals (FD)
import qualified System.Process as P

import Effectful
import Effectful.Dispatch.Static

-- | An effect for running child processes using the @process@ library.
data Process :: Effect

type instance DispatchOf Process = Static WithSideEffects
data instance StaticRep Process = Process

runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
runProcess :: Eff (Process : es) a -> Eff es a
runProcess = StaticRep Process -> Eff (Process : es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (sideEffects :: SideEffects)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep Process
Process

----------------------------------------
-- Running sub-processes

-- | Lifted 'P.createProcess'.
createProcess
  :: Process :> es
  => P.CreateProcess
  -> Eff es (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
createProcess :: CreateProcess
-> Eff es (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess = IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Eff es (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> Eff
      es (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> (CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> Eff es (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

-- | Lifted 'P.createProcess_'.
createProcess_
  :: Process :> es
  => String
  -> P.CreateProcess
  -> Eff es (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
createProcess_ :: String
-> CreateProcess
-> Eff es (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
msg = IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Eff es (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> Eff
      es (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> (CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> Eff es (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess_ String
msg

----------------------------------------
-- Simpler functions for common tasks

-- | Lifted 'P.callProcess'.
callProcess :: Process :> es => FilePath -> [String] -> Eff es ()
callProcess :: String -> [String] -> Eff es ()
callProcess String
fp = IO () -> Eff es ()
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> ([String] -> IO ()) -> [String] -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> IO ()
P.callProcess String
fp

-- | Lifted 'P.callCommand'.
callCommand :: Process :> es => String -> Eff es ()
callCommand :: String -> Eff es ()
callCommand = IO () -> Eff es ()
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> (String -> IO ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
P.callCommand

-- | Lifted 'P.spawnProcess'.
spawnProcess :: Process :> es => FilePath -> [String] -> Eff es P.ProcessHandle
spawnProcess :: String -> [String] -> Eff es ProcessHandle
spawnProcess String
fp = IO ProcessHandle -> Eff es ProcessHandle
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO ProcessHandle -> Eff es ProcessHandle)
-> ([String] -> IO ProcessHandle)
-> [String]
-> Eff es ProcessHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> IO ProcessHandle
P.spawnProcess String
fp

-- | Lifted 'P.spawnCommand'.
spawnCommand :: Process :> es => String -> Eff es P.ProcessHandle
spawnCommand :: String -> Eff es ProcessHandle
spawnCommand = IO ProcessHandle -> Eff es ProcessHandle
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO ProcessHandle -> Eff es ProcessHandle)
-> (String -> IO ProcessHandle) -> String -> Eff es ProcessHandle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ProcessHandle
P.spawnCommand

-- | Lifted 'P.readCreateProcess'.
readCreateProcess :: Process :> es => P.CreateProcess -> String -> Eff es String
readCreateProcess :: CreateProcess -> String -> Eff es String
readCreateProcess CreateProcess
cp = IO String -> Eff es String
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO String -> Eff es String)
-> (String -> IO String) -> String -> Eff es String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateProcess -> String -> IO String
P.readCreateProcess CreateProcess
cp

-- | Lifted 'P.readProcess'.
readProcess :: Process :> es => FilePath -> [String] -> String -> Eff es String
readProcess :: String -> [String] -> String -> Eff es String
readProcess String
fp [String]
args = IO String -> Eff es String
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO String -> Eff es String)
-> (String -> IO String) -> String -> Eff es String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String -> IO String
P.readProcess String
fp [String]
args

-- | Lifted 'P.readCreateProcessWithExitCode'.
readCreateProcessWithExitCode
  :: Process :> es
  => P.CreateProcess
  -> String
  -> Eff es (ExitCode, String, String)
readCreateProcessWithExitCode :: CreateProcess -> String -> Eff es (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
cp = IO (ExitCode, String, String) -> Eff es (ExitCode, String, String)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (ExitCode, String, String)
 -> Eff es (ExitCode, String, String))
-> (String -> IO (ExitCode, String, String))
-> String
-> Eff es (ExitCode, String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateProcess -> String -> IO (ExitCode, String, String)
P.readCreateProcessWithExitCode CreateProcess
cp

-- | Lifted 'P.readProcessWithExitCode'.
readProcessWithExitCode
  :: Process :> es
  => FilePath
  -> [String]
  -> String
  -> Eff es (ExitCode, String, String)
readProcessWithExitCode :: String -> [String] -> String -> Eff es (ExitCode, String, String)
readProcessWithExitCode String
fp [String]
args = IO (ExitCode, String, String) -> Eff es (ExitCode, String, String)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (ExitCode, String, String)
 -> Eff es (ExitCode, String, String))
-> (String -> IO (ExitCode, String, String))
-> String
-> Eff es (ExitCode, String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String -> IO (ExitCode, String, String)
P.readProcessWithExitCode String
fp [String]
args

-- | Lifted 'P.withCreateProcess'.
withCreateProcess
  :: Process :> es
  => P.CreateProcess
  -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)
  -> Eff es a
withCreateProcess :: CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> Eff es a)
-> Eff es a
withCreateProcess CreateProcess
cp Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> Eff es a
cb = ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
unsafeSeqUnliftIO (((forall r. Eff es r -> IO r) -> IO a) -> Eff es a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  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
cp ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
 -> IO a)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
inh Maybe Handle
outh Maybe Handle
errh ProcessHandle
ph -> Eff es a -> IO a
forall r. Eff es r -> IO r
unlift (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> Maybe Handle -> Maybe Handle -> ProcessHandle -> Eff es a
cb Maybe Handle
inh Maybe Handle
outh Maybe Handle
errh ProcessHandle
ph

-- | Lifted 'P.cleanupProcess'.
cleanupProcess
  :: Process :> es
  => (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
  -> Eff es ()
cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Eff es ()
cleanupProcess = IO () -> Eff es ()
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ())
-> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
P.cleanupProcess

----------------------------------------
-- Related utilities

-- | Lifted 'P.getPid'.
getPid :: Process :> es => P.ProcessHandle -> Eff es (Maybe P.Pid)
getPid :: ProcessHandle -> Eff es (Maybe Pid)
getPid = IO (Maybe Pid) -> Eff es (Maybe Pid)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (Maybe Pid) -> Eff es (Maybe Pid))
-> (ProcessHandle -> IO (Maybe Pid))
-> ProcessHandle
-> Eff es (Maybe Pid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO (Maybe Pid)
P.getPid

#if MIN_VERSION_process(1,6,12)
-- | Lifted 'P.getCurrentPid'.
getCurrentPid :: Process :> es => Eff es P.Pid
getCurrentPid = unsafeEff_ P.getCurrentPid
#endif

----------------------------------------
-- Process completion

-- | Lifted 'P.waitForProcess'.
waitForProcess :: Process :> es => P.ProcessHandle -> Eff es ExitCode
waitForProcess :: ProcessHandle -> Eff es ExitCode
waitForProcess = IO ExitCode -> Eff es ExitCode
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO ExitCode -> Eff es ExitCode)
-> (ProcessHandle -> IO ExitCode)
-> ProcessHandle
-> Eff es ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO ExitCode
P.waitForProcess

-- | Lifted 'P.getProcessExitCode'.
getProcessExitCode :: Process :> es => P.ProcessHandle -> Eff es (Maybe ExitCode)
getProcessExitCode :: ProcessHandle -> Eff es (Maybe ExitCode)
getProcessExitCode = IO (Maybe ExitCode) -> Eff es (Maybe ExitCode)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (Maybe ExitCode) -> Eff es (Maybe ExitCode))
-> (ProcessHandle -> IO (Maybe ExitCode))
-> ProcessHandle
-> Eff es (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO (Maybe ExitCode)
P.getProcessExitCode

-- | Lifted 'P.terminateProcess'.
terminateProcess :: Process :> es => P.ProcessHandle -> Eff es ()
terminateProcess :: ProcessHandle -> Eff es ()
terminateProcess = IO () -> Eff es ()
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (ProcessHandle -> IO ()) -> ProcessHandle -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO ()
P.terminateProcess

-- | Lifted 'P.interruptProcessGroupOf'.
interruptProcessGroupOf :: Process :> es => P.ProcessHandle -> Eff es ()
interruptProcessGroupOf :: ProcessHandle -> Eff es ()
interruptProcessGroupOf = IO () -> Eff es ()
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (ProcessHandle -> IO ()) -> ProcessHandle -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO ()
P.interruptProcessGroupOf

----------------------------------------
-- Interprocess communication

-- | Lifted 'P.createPipe'.
createPipe :: Process :> es => Eff es (Handle, Handle)
createPipe :: Eff es (Handle, Handle)
createPipe = IO (Handle, Handle) -> Eff es (Handle, Handle)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ IO (Handle, Handle)
P.createPipe

-- | Lifted 'P.createPipeFd'.
createPipeFd :: Process :> es => Eff es (FD, FD)
createPipeFd :: Eff es (FD, FD)
createPipeFd = IO (FD, FD) -> Eff es (FD, FD)
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ IO (FD, FD)
P.createPipeFd