{-|
Module      : Effectful.Process.Typed
Description : effectful bindings for typed-process
Copyright   : (c) 2022 Dominik Peteler
License     : BSD-3-Clause
Stability   : stable

This module provides [effectful](https://hackage.haskell.org/package/effectful)
bindings for [typed-process](https://hackage.haskell.org/package/typed-process).
-}
{-# OPTIONS_GHC -fno-warn-dodgy-imports #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
module Effectful.Process.Typed
  ( -- * Process effect
    TypedProcess
  , runTypedProcess

  -- * Launch a process
  , startProcess
  , stopProcess
  , withProcessWait
  , withProcessWait_
  , withProcessTerm
  , withProcessTerm_
  , readProcess
  , readProcess_
  , runProcess
  , runProcess_
  , readProcessStdout
  , readProcessStdout_
  , readProcessStderr
  , readProcessStderr_
  , readProcessInterleaved
  , readProcessInterleaved_

  -- * Process exit code
  , waitExitCode
  , getExitCode
  , checkExitCode

  -- * Re-exports from "System.Process.Typed"
  , module Reexport
#if ! MIN_VERSION_typed_process(0,2,8)
  , ExitCode(..)
#endif
  ) where

import System.Process.Typed as Reexport hiding
  ( startProcess
  , stopProcess
  , withProcessWait
  , withProcessWait_
  , withProcessTerm
  , withProcessTerm_
  , readProcess
  , readProcess_
  , runProcess
  , runProcess_
  , readProcessStdout
  , readProcessStdout_
  , readProcessStderr
  , readProcessStderr_
  , readProcessInterleaved
  , readProcessInterleaved_
  , waitExitCode
  , getExitCode
  , checkExitCode
  )

import Data.ByteString.Lazy (ByteString)
import qualified System.Process.Typed as PT

import Effectful
import qualified Effectful.Process
import Effectful.Dispatch.Static

#if ! MIN_VERSION_typed_process(0,2,8)
import System.Exit (ExitCode(..))
#endif

----------------------------------------
-- Effect & Handler

-- | We provide a type synonym for the 'Effectful.Process.Process' effect since
-- it clashes with 'PT.Process' type of @typed-process@.
type TypedProcess = Effectful.Process.Process

-- | This is merely an alias for 'Effectful.Process.runProcess' since that name
-- clashes with 'runProcess', i.e.:
--
-- > runTypedProcess = Effectful.Process.runProcess
runTypedProcess :: IOE :> es => Eff (TypedProcess : es) a -> Eff es a
runTypedProcess :: forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (TypedProcess : es) a -> Eff es a
runTypedProcess = Eff (TypedProcess : es) a -> Eff es a
forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (TypedProcess : es) a -> Eff es a
Effectful.Process.runProcess

----------------------------------------
-- Launch a process

-- | Lifted 'PT.startProcess'.
startProcess :: TypedProcess :> es
             => PT.ProcessConfig stdin stdout stderr
             -> Eff es (PT.Process stdin stdout stderr)
startProcess :: forall (es :: [Effect]) stdin stdout stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdout stderr
-> Eff es (Process stdin stdout stderr)
startProcess = IO (Process stdin stdout stderr)
-> Eff es (Process stdin stdout stderr)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Process stdin stdout stderr)
 -> Eff es (Process stdin stdout stderr))
-> (ProcessConfig stdin stdout stderr
    -> IO (Process stdin stdout stderr))
-> ProcessConfig stdin stdout stderr
-> Eff es (Process stdin stdout stderr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdout stderr
-> IO (Process stdin stdout stderr)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
PT.startProcess

-- | Lifted 'PT.stopProcess'.
stopProcess :: TypedProcess :> es => PT.Process stdin stdout stderr -> Eff es ()
stopProcess :: forall (es :: [Effect]) stdin stdout stderr.
(TypedProcess :> es) =>
Process stdin stdout stderr -> Eff es ()
stopProcess = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (Process stdin stdout stderr -> IO ())
-> Process stdin stdout stderr
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
PT.stopProcess

-- | Lifted 'PT.withProcessWait'.
withProcessWait :: TypedProcess :> es
                => PT.ProcessConfig stdin stdout stderr
                -> (PT.Process stdin stdout stderr -> Eff es a)
                -> Eff es a
withProcessWait :: forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a) -> Eff es a
withProcessWait = (ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
(ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
liftWithProcess ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO a) -> IO a
forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
PT.withProcessWait

-- | Lifted 'PT.withProcessWait_'.
withProcessWait_ :: TypedProcess :> es
                 => PT.ProcessConfig stdin stdout stderr
                 -> (PT.Process stdin stdout stderr -> Eff es a)
                 -> Eff es a
withProcessWait_ :: forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a) -> Eff es a
withProcessWait_ = (ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
(ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
liftWithProcess ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO a) -> IO a
forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
PT.withProcessWait_

-- | Lifted 'PT.withProcessTerm'.
withProcessTerm :: TypedProcess :> es
                => PT.ProcessConfig stdin stdout stderr
                -> (PT.Process stdin stdout stderr -> Eff es a)
                -> Eff es a
withProcessTerm :: forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a) -> Eff es a
withProcessTerm = (ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
(ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
liftWithProcess ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO a) -> IO a
forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
PT.withProcessTerm

-- | Lifted 'PT.withProcessTerm_'.
withProcessTerm_ :: TypedProcess :> es
                 => PT.ProcessConfig stdin stdout stderr
                 -> (PT.Process stdin stdout stderr -> Eff es a)
                 -> Eff es a
withProcessTerm_ :: forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a) -> Eff es a
withProcessTerm_ = (ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
(ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
liftWithProcess ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO a) -> IO a
forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
PT.withProcessTerm_

-- | Lifted 'PT.readProcess'.
readProcess :: TypedProcess :> es
            => PT.ProcessConfig stdin stdoutIgnored stderrIgnored
            -> Eff es (ExitCode, ByteString, ByteString)
readProcess :: forall (es :: [Effect]) stdin stdoutIgnored stderrIgnored.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ExitCode, ByteString, ByteString)
readProcess = IO (ExitCode, ByteString, ByteString)
-> Eff es (ExitCode, ByteString, ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (ExitCode, ByteString, ByteString)
 -> Eff es (ExitCode, ByteString, ByteString))
-> (ProcessConfig stdin stdoutIgnored stderrIgnored
    -> IO (ExitCode, ByteString, ByteString))
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ExitCode, ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdoutIgnored stderrIgnored
-> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ExitCode, ByteString, ByteString)
PT.readProcess

-- | Lifted 'PT.readProcess_'.
readProcess_ :: TypedProcess :> es
             => PT.ProcessConfig stdin stdoutIgnored stderrIgnored
             -> Eff es (ByteString, ByteString)
readProcess_ :: forall (es :: [Effect]) stdin stdoutIgnored stderrIgnored.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ByteString, ByteString)
readProcess_ = IO (ByteString, ByteString) -> Eff es (ByteString, ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (ByteString, ByteString) -> Eff es (ByteString, ByteString))
-> (ProcessConfig stdin stdoutIgnored stderrIgnored
    -> IO (ByteString, ByteString))
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdoutIgnored stderrIgnored
-> IO (ByteString, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
PT.readProcess_

-- | Lifted 'PT.runProcess'.
runProcess :: TypedProcess :> es
           => PT.ProcessConfig stdin stdout stderr
           -> Eff es ExitCode
runProcess :: forall (es :: [Effect]) stdin stdout stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdout stderr -> Eff es ExitCode
runProcess = IO ExitCode -> Eff es ExitCode
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO ExitCode -> Eff es ExitCode)
-> (ProcessConfig stdin stdout stderr -> IO ExitCode)
-> ProcessConfig stdin stdout stderr
-> Eff es ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdout stderr -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
PT.runProcess

-- | Lifted 'PT.runProcess_'.
runProcess_ :: TypedProcess :> es
            => PT.ProcessConfig stdin stdout stderr
            -> Eff es ()
runProcess_ :: forall (es :: [Effect]) stdin stdout stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdout stderr -> Eff es ()
runProcess_ = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (ProcessConfig stdin stdout stderr -> IO ())
-> ProcessConfig stdin stdout stderr
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdout stderr -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
PT.runProcess_

-- | Lifted 'PT.readProcessStdout'.
readProcessStdout :: TypedProcess :> es
                 => PT.ProcessConfig stdin stdoutIgnored stderr
                 -> Eff es (ExitCode, ByteString)
readProcessStdout :: forall (es :: [Effect]) stdin stdoutIgnored stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderr
-> Eff es (ExitCode, ByteString)
readProcessStdout = IO (ExitCode, ByteString) -> Eff es (ExitCode, ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (ExitCode, ByteString) -> Eff es (ExitCode, ByteString))
-> (ProcessConfig stdin stdoutIgnored stderr
    -> IO (ExitCode, ByteString))
-> ProcessConfig stdin stdoutIgnored stderr
-> Eff es (ExitCode, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdoutIgnored stderr
-> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
PT.readProcessStdout

-- | Lifted 'PT.readProcessStdout_'.
readProcessStdout_ :: TypedProcess :> es
                  => PT.ProcessConfig stdin stdoutIgnored stderr
                  -> Eff es ByteString
readProcessStdout_ :: forall (es :: [Effect]) stdin stdoutIgnored stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderr -> Eff es ByteString
readProcessStdout_ = IO ByteString -> Eff es ByteString
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO ByteString -> Eff es ByteString)
-> (ProcessConfig stdin stdoutIgnored stderr -> IO ByteString)
-> ProcessConfig stdin stdoutIgnored stderr
-> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdoutIgnored stderr -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
PT.readProcessStdout_

-- | Lifted 'PT.readProcessStderr'.
readProcessStderr :: TypedProcess :> es
                 => PT.ProcessConfig stdin stdout stderrIgnored
                 -> Eff es (ExitCode, ByteString)
readProcessStderr :: forall (es :: [Effect]) stdin stdoutIgnored stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderr
-> Eff es (ExitCode, ByteString)
readProcessStderr = IO (ExitCode, ByteString) -> Eff es (ExitCode, ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (ExitCode, ByteString) -> Eff es (ExitCode, ByteString))
-> (ProcessConfig stdin stdout stderrIgnored
    -> IO (ExitCode, ByteString))
-> ProcessConfig stdin stdout stderrIgnored
-> Eff es (ExitCode, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdout stderrIgnored
-> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
PT.readProcessStderr

-- | Lifted 'PT.readProcessStderr_'.
readProcessStderr_ :: TypedProcess :> es
                  => PT.ProcessConfig stdin stdout stderrIgnored
                  -> Eff es ByteString
readProcessStderr_ :: forall (es :: [Effect]) stdin stdoutIgnored stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderr -> Eff es ByteString
readProcessStderr_ = IO ByteString -> Eff es ByteString
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO ByteString -> Eff es ByteString)
-> (ProcessConfig stdin stdout stderrIgnored -> IO ByteString)
-> ProcessConfig stdin stdout stderrIgnored
-> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdout stderrIgnored -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
PT.readProcessStderr_

-- | Lifted 'PT.readProcessInterleaved'.
readProcessInterleaved :: TypedProcess :> es
                      => PT.ProcessConfig stdin stdoutIgnored stderrIgnored
                      -> Eff es (ExitCode, ByteString)
readProcessInterleaved :: forall (es :: [Effect]) stdin stdoutIgnored stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderr
-> Eff es (ExitCode, ByteString)
readProcessInterleaved = IO (ExitCode, ByteString) -> Eff es (ExitCode, ByteString)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (ExitCode, ByteString) -> Eff es (ExitCode, ByteString))
-> (ProcessConfig stdin stdoutIgnored stderrIgnored
    -> IO (ExitCode, ByteString))
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es (ExitCode, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdoutIgnored stderrIgnored
-> IO (ExitCode, ByteString)
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr
-> m (ExitCode, ByteString)
PT.readProcessInterleaved

-- | Lifted 'PT.readProcessInterleaved_'.
readProcessInterleaved_ :: TypedProcess :> es
                       => PT.ProcessConfig stdin stdoutIgnored stderrIgnored
                       -> Eff es ByteString
readProcessInterleaved_ :: forall (es :: [Effect]) stdin stdoutIgnored stderr.
(TypedProcess :> es) =>
ProcessConfig stdin stdoutIgnored stderr -> Eff es ByteString
readProcessInterleaved_ = IO ByteString -> Eff es ByteString
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO ByteString -> Eff es ByteString)
-> (ProcessConfig stdin stdoutIgnored stderrIgnored
    -> IO ByteString)
-> ProcessConfig stdin stdoutIgnored stderrIgnored
-> Eff es ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig stdin stdoutIgnored stderrIgnored -> IO ByteString
forall (m :: * -> *) stdin stdoutIgnored stderr.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderr -> m ByteString
PT.readProcessInterleaved_

----------------------------------------
-- Process exit code

-- | Lifted 'PT.waitExitCode'.
waitExitCode :: TypedProcess :> es
             => PT.Process stdin stdout stderr
             -> Eff es ExitCode
waitExitCode :: forall (es :: [Effect]) stdin stdout stderr.
(TypedProcess :> es) =>
Process stdin stdout stderr -> Eff es ExitCode
waitExitCode = IO ExitCode -> Eff es ExitCode
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO ExitCode -> Eff es ExitCode)
-> (Process stdin stdout stderr -> IO ExitCode)
-> Process stdin stdout stderr
-> Eff es ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
PT.waitExitCode

---- | Lifted 'PT.waitExitCodeSTM'.
--waitExitCodeSTM :: TypedProcess :> es
--                => PT.Process stdin stdout stderr
--                -> Eff es ExitCode
--waitExitCodeSTM = unsafeEff_ . PT.waitExitCode

-- | Lifted 'PT.getExitCode'.
getExitCode :: TypedProcess :> es
            => PT.Process stdin stdout stderr
            -> Eff es (Maybe ExitCode)
getExitCode :: forall (es :: [Effect]) stdin stdout stderr.
(TypedProcess :> es) =>
Process stdin stdout stderr -> Eff es (Maybe ExitCode)
getExitCode = IO (Maybe ExitCode) -> Eff es (Maybe ExitCode)
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO (Maybe ExitCode) -> Eff es (Maybe ExitCode))
-> (Process stdin stdout stderr -> IO (Maybe ExitCode))
-> Process stdin stdout stderr
-> Eff es (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> IO (Maybe ExitCode)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m (Maybe ExitCode)
PT.getExitCode

---- | Lifted 'PT.getExitCodeSTM'.
--getExitCodeSTM :: TypedProcess :> es
--               => PT.Process stdin stdout stderr
--               -> Eff es (Maybe ExitCode)
--getExitCodeSTM = unsafeEff_ . PT.getExitCodeSTM

-- | Lifted 'PT.checkExitCode'.
checkExitCode :: TypedProcess :> es
              => PT.Process stdin stdout stderr
              -> Eff es ()
checkExitCode :: forall (es :: [Effect]) stdin stdout stderr.
(TypedProcess :> es) =>
Process stdin stdout stderr -> Eff es ()
checkExitCode = IO () -> Eff es ()
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ())
-> (Process stdin stdout stderr -> IO ())
-> Process stdin stdout stderr
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
PT.checkExitCode

---- | Lifted 'PT.checkExitCodeSTM'.
--checkExitCodeSTM :: TypedProcess :> es
--                 => PT.Process stdin stdout stderr
--                 -> Eff es ()
--checkExitCodeSTM = unsafeEff_ . PT.checkExitCodeSTM

----------------------------------------
-- Helpers

liftWithProcess :: TypedProcess :> es
                => (PT.ProcessConfig stdin stdout stderr -> (PT.Process stdin stdout stderr -> IO a) -> IO a)
                -> PT.ProcessConfig stdin stdout stderr
                -> (PT.Process stdin stdout stderr -> Eff es a)
                -> Eff es a
liftWithProcess :: forall (es :: [Effect]) stdin stdout stderr a.
(TypedProcess :> es) =>
(ProcessConfig stdin stdout stderr
 -> (Process stdin stdout stderr -> IO a) -> IO a)
-> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> Eff es a)
-> Eff es a
liftWithProcess ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO a) -> IO a
k ProcessConfig stdin stdout stderr
pc Process stdin stdout stderr -> Eff es a
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es ->
  Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
es (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
runInIO ->
    ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> IO a) -> IO a
k ProcessConfig stdin stdout stderr
pc (Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO (Eff es a -> IO a)
-> (Process stdin stdout stderr -> Eff es a)
-> Process stdin stdout stderr
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> Eff es a
f)