{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module RIO.Process
(
ProcessContext
, HasProcessContext (..)
, EnvVars
, mkProcessContext
, mkDefaultProcessContext
, modifyEnvVars
, withModifyEnvVars
, lookupEnvFromContext
, withWorkingDir
, workingDirL
, envVarsL
, envVarsStringsL
, exeSearchPathL
, resetExeCache
, proc
, withProcess
, withProcess_
, withProcessWait
, withProcessWait_
, withProcessTerm
, withProcessTerm_
, exec
, execSpawn
, LoggedProcessContext (..)
, withProcessContextNoLogging
, ProcessException (..)
, doesExecutableExist
, findExecutable
, exeExtensions
, augmentPath
, augmentPathMap
, augmentPathMap'
, showProcessArgDebug
, P.ProcessConfig
, P.StreamSpec
, P.StreamType (..)
, P.Process
, P.setStdin
, P.setStdout
, P.setStderr
, P.setCloseFds
, P.setCreateGroup
, P.setDelegateCtlc
#if MIN_VERSION_process(1, 3, 0)
, P.setDetachConsole
, P.setCreateNewConsole
, P.setNewSession
#endif
#if MIN_VERSION_process(1, 4, 0) && !WINDOWS
, P.setChildGroup
, P.setChildUser
#endif
, P.mkStreamSpec
, P.inherit
, P.closed
, P.byteStringInput
, P.byteStringOutput
, P.createPipe
, P.useHandleOpen
, P.useHandleClose
, P.startProcess
, P.stopProcess
, P.readProcess
, P.readProcess_
, P.runProcess
, P.runProcess_
, P.readProcessStdout
, P.readProcessStdout_
, P.readProcessStderr
, P.readProcessStderr_
, P.waitExitCode
, P.waitExitCodeSTM
, P.getExitCode
, P.getExitCodeSTM
, P.checkExitCode
, P.checkExitCodeSTM
, P.getStdin
, P.getStdout
, P.getStderr
, P.ExitCodeException (..)
, P.ByteStringOutputException (..)
, P.unsafeProcessHandle
) where
import RIO.Prelude.Display
import RIO.Prelude.Reexports
import RIO.Prelude.Logger
import RIO.Prelude.RIO
import RIO.Prelude.Lens
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified System.Directory as D
import System.Environment (getEnvironment)
import System.Exit (exitWith)
import qualified System.FilePath as FP
import qualified System.Process.Typed as P
import System.Process.Typed hiding
(withProcess, withProcess_,
withProcessWait, withProcessWait_,
withProcessTerm, withProcessTerm_,
proc)
#ifndef WINDOWS
import System.Directory (setCurrentDirectory)
import System.Posix.Process (executeFile)
#endif
type EnvVars = Map Text Text
data ProcessContext = ProcessContext
{ ProcessContext -> EnvVars
pcTextMap :: !EnvVars
, ProcessContext -> [(String, String)]
pcStringList :: ![(String, String)]
, ProcessContext -> [String]
pcPath :: ![FilePath]
, ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache :: !(IORef (Map FilePath (Either ProcessException FilePath)))
, ProcessContext -> [String]
pcExeExtensions :: [String]
, ProcessContext -> Maybe String
pcWorkingDir :: !(Maybe FilePath)
}
data ProcessException
= NoPathFound
| ExecutableNotFound String [FilePath]
| ExecutableNotFoundAt FilePath
| PathsInvalidInPath [FilePath]
deriving (Typeable, ProcessException -> ProcessException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessException -> ProcessException -> Bool
$c/= :: ProcessException -> ProcessException -> Bool
== :: ProcessException -> ProcessException -> Bool
$c== :: ProcessException -> ProcessException -> Bool
Eq)
instance Show ProcessException where
show :: ProcessException -> String
show ProcessException
NoPathFound = String
"PATH not found in ProcessContext"
show (ExecutableNotFound String
name [String]
path) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Executable named "
, String
name
, String
" not found on path: "
, forall a. Show a => a -> String
show [String]
path
]
show (ExecutableNotFoundAt String
name) =
String
"Did not find executable at specified path: " forall a. [a] -> [a] -> [a]
++ String
name
show (PathsInvalidInPath [String]
paths) = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
[ "Would need to add some paths to the PATH environment variable \
\to continue, but they would be invalid because they contain a "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
FP.searchPathSeparator forall a. [a] -> [a] -> [a]
++ String
"."
, String
"Please fix the following paths and try again:"
] forall a. [a] -> [a] -> [a]
++ [String]
paths
instance Exception ProcessException
class HasProcessContext env where
processContextL :: Lens' env ProcessContext
instance HasProcessContext ProcessContext where
processContextL :: Lens' ProcessContext ProcessContext
processContextL = forall a. a -> a
id
data EnvVarFormat = EVFWindows | EVFNotWindows
currentEnvVarFormat :: EnvVarFormat
currentEnvVarFormat :: EnvVarFormat
currentEnvVarFormat =
#if WINDOWS
EVFWindows
#else
EnvVarFormat
EVFNotWindows
#endif
isWindows :: Bool
isWindows :: Bool
isWindows = case EnvVarFormat
currentEnvVarFormat of
EnvVarFormat
EVFWindows -> Bool
True
EnvVarFormat
EVFNotWindows -> Bool
False
workingDirL :: HasProcessContext env => Lens' env (Maybe FilePath)
workingDirL :: forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL = forall env. HasProcessContext env => Lens' env ProcessContext
processContextLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProcessContext -> Maybe String
pcWorkingDir (\ProcessContext
x Maybe String
y -> ProcessContext
x { pcWorkingDir :: Maybe String
pcWorkingDir = Maybe String
y })
envVarsL :: HasProcessContext env => SimpleGetter env EnvVars
envVarsL :: forall env. HasProcessContext env => SimpleGetter env EnvVars
envVarsL = forall env. HasProcessContext env => Lens' env ProcessContext
processContextLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ProcessContext -> EnvVars
pcTextMap
envVarsStringsL :: HasProcessContext env => SimpleGetter env [(String, String)]
= forall env. HasProcessContext env => Lens' env ProcessContext
processContextLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ProcessContext -> [(String, String)]
pcStringList
exeSearchPathL :: HasProcessContext env => SimpleGetter env [FilePath]
exeSearchPathL :: forall env. HasProcessContext env => SimpleGetter env [String]
exeSearchPathL = forall env. HasProcessContext env => Lens' env ProcessContext
processContextLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ProcessContext -> [String]
pcPath
mkProcessContext :: MonadIO m => EnvVars -> m ProcessContext
mkProcessContext :: forall (m :: * -> *). MonadIO m => EnvVars -> m ProcessContext
mkProcessContext (EnvVars -> EnvVars
normalizePathEnv -> EnvVars
tm) = do
IORef (Map String (Either ProcessException String))
ref <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall k a. Map k a
Map.empty
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContext
{ pcTextMap :: EnvVars
pcTextMap = EnvVars
tm
, pcStringList :: [(String, String)]
pcStringList = forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> String
T.unpack) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList EnvVars
tm
, pcPath :: [String]
pcPath =
(if Bool
isWindows then (String
"."forall a. a -> [a] -> [a]
:) else forall a. a -> a
id)
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> [String]
FP.splitSearchPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"PATH" EnvVars
tm))
, pcExeCache :: IORef (Map String (Either ProcessException String))
pcExeCache = IORef (Map String (Either ProcessException String))
ref
, pcExeExtensions :: [String]
pcExeExtensions =
if Bool
isWindows
then let pathext :: Text
pathext = forall a. a -> Maybe a -> a
fromMaybe Text
defaultPATHEXT
(forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"PATHEXT" EnvVars
tm)
in forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
";" Text
pathext
else [String
""]
, pcWorkingDir :: Maybe String
pcWorkingDir = forall a. Maybe a
Nothing
}
where
defaultPATHEXT :: Text
defaultPATHEXT = Text
".COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC"
normalizePathEnv :: EnvVars -> EnvVars
normalizePathEnv :: EnvVars -> EnvVars
normalizePathEnv EnvVars
env
| Bool
isWindows = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
T.toUpper) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList EnvVars
env
| Bool
otherwise = EnvVars
env
resetExeCache :: (MonadIO m, MonadReader env m, HasProcessContext env) => m ()
resetExeCache :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
m ()
resetExeCache = do
ProcessContext
pc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef (ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache ProcessContext
pc) (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
mkDefaultProcessContext :: MonadIO m => m ProcessContext
mkDefaultProcessContext :: forall (m :: * -> *). MonadIO m => m ProcessContext
mkDefaultProcessContext =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
IO [(String, String)]
getEnvironment forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *). MonadIO m => EnvVars -> m ProcessContext
mkProcessContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Text
T.pack)
modifyEnvVars
:: MonadIO m
=> ProcessContext
-> (EnvVars -> EnvVars)
-> m ProcessContext
modifyEnvVars :: forall (m :: * -> *).
MonadIO m =>
ProcessContext -> (EnvVars -> EnvVars) -> m ProcessContext
modifyEnvVars ProcessContext
pc EnvVars -> EnvVars
f = do
ProcessContext
pc' <- forall (m :: * -> *). MonadIO m => EnvVars -> m ProcessContext
mkProcessContext (EnvVars -> EnvVars
f forall a b. (a -> b) -> a -> b
$ ProcessContext -> EnvVars
pcTextMap ProcessContext
pc)
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContext
pc' { pcWorkingDir :: Maybe String
pcWorkingDir = ProcessContext -> Maybe String
pcWorkingDir ProcessContext
pc }
withModifyEnvVars
:: (HasProcessContext env, MonadReader env m, MonadIO m)
=> (EnvVars -> EnvVars)
-> m a
-> m a
withModifyEnvVars :: forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
(EnvVars -> EnvVars) -> m a -> m a
withModifyEnvVars EnvVars -> EnvVars
f m a
inner = do
ProcessContext
pc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
ProcessContext
pc' <- forall (m :: * -> *).
MonadIO m =>
ProcessContext -> (EnvVars -> EnvVars) -> m ProcessContext
modifyEnvVars ProcessContext
pc EnvVars -> EnvVars
f
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasProcessContext env => Lens' env ProcessContext
processContextL ProcessContext
pc') m a
inner
lookupEnvFromContext :: (MonadReader env m, HasProcessContext env) => Text -> m (Maybe Text)
lookupEnvFromContext :: forall env (m :: * -> *).
(MonadReader env m, HasProcessContext env) =>
Text -> m (Maybe Text)
lookupEnvFromContext Text
envName = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
envName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => SimpleGetter env EnvVars
envVarsL
withWorkingDir
:: (HasProcessContext env, MonadReader env m, MonadIO m)
=> FilePath
-> m a
-> m a
withWorkingDir :: forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m a -> m a
withWorkingDir = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
preProcess
:: (HasProcessContext env, MonadReader env m, MonadIO m)
=> String
-> m FilePath
preProcess :: forall env (m :: * -> *).
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m String
preProcess String
name = do
String
name' <- forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m (Either ProcessException String)
findExecutable String
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (m :: * -> *) a. Monad m => a -> m a
return
Maybe String
wd <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Bool -> String -> IO ()
D.createDirectoryIfMissing Bool
True) Maybe String
wd
forall (m :: * -> *) a. Monad m => a -> m a
return String
name'
withProcessTimeLog
:: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)
=> Maybe FilePath
-> String
-> [String]
-> m a
-> m a
withProcessTimeLog :: forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Maybe String -> String -> [String] -> m a -> m a
withProcessTimeLog Maybe String
mdir String
name [String]
args m a
proc' = do
let cmdText :: Text
cmdText =
Text -> [Text] -> Text
T.intercalate
Text
" "
(String -> Text
T.pack String
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map String -> Text
showProcessArgDebug [String]
args)
dirMsg :: Text
dirMsg =
case Maybe String
mdir of
Maybe String
Nothing -> Text
""
Just String
dir -> Text
" within " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
dir
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Run process" forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
dirMsg forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
cmdText)
Double
start <- forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
a
x <- m a
proc'
Double
end <- forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
let diff :: Double
diff = Double
end forall a. Num a => a -> a -> a
- Double
start
Bool
useColor <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasLogFunc env => SimpleGetter env Bool
logFuncUseColorL
Int -> Utf8Builder
accentColors <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasLogFunc env => SimpleGetter env (Int -> Utf8Builder)
logFuncAccentColorsL
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug
(Utf8Builder
"Process finished in " forall a. Semigroup a => a -> a -> a
<>
(if Bool
useColor then Int -> Utf8Builder
accentColors Int
0 else Utf8Builder
"") forall a. Semigroup a => a -> a -> a
<>
Double -> Utf8Builder
timeSpecMilliSecondText Double
diff forall a. Semigroup a => a -> a -> a
<>
(if Bool
useColor then Utf8Builder
"\ESC[0m" else Utf8Builder
"") forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
": " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
cmdText)
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
timeSpecMilliSecondText :: Double -> Utf8Builder
timeSpecMilliSecondText :: Double -> Utf8Builder
timeSpecMilliSecondText Double
d = forall a. Display a => a -> Utf8Builder
display (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
d forall a. Num a => a -> a -> a
* Double
1000) :: Int) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"ms"
proc
:: (HasProcessContext env, HasLogFunc env, MonadReader env m, MonadIO m, HasCallStack)
=> FilePath
-> [String]
-> (ProcessConfig () () () -> m a)
-> m a
proc :: forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
name0 [String]
args ProcessConfig () () () -> m a
inner = do
String
name <- forall env (m :: * -> *).
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m String
preProcess String
name0
Maybe String
wd <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL
[(String, String)]
envStrings <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env [(String, String)]
envVarsStringsL
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Maybe String -> String -> [String] -> m a -> m a
withProcessTimeLog Maybe String
wd String
name [String]
args
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () () -> m a
inner
forall a b. (a -> b) -> a -> b
$ forall stdin stdout stderr.
[(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(String, String)]
envStrings
forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall stdin stdout stderr.
String
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir Maybe String
wd
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
P.proc String
name [String]
args
withProcess
:: MonadUnliftIO m
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcess :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess ProcessConfig stdin stdout stderr
pc Process stdin stdout stderr -> m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
P.withProcessTerm ProcessConfig stdin stdout stderr
pc (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)
{-# DEPRECATED withProcess "Please consider using withProcessWait, or instead use withProcessTerm" #-}
withProcess_
:: MonadUnliftIO m
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcess_ :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcess_ ProcessConfig stdin stdout stderr
pc Process stdin stdout stderr -> m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
P.withProcessTerm_ ProcessConfig stdin stdout stderr
pc (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)
{-# DEPRECATED withProcess_ "Please consider using withProcessWait, or instead use withProcessTerm" #-}
withProcessWait
:: MonadUnliftIO m
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessWait :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait ProcessConfig stdin stdout stderr
pc Process stdin stdout stderr -> m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
P.withProcessWait ProcessConfig stdin stdout stderr
pc (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)
withProcessWait_
:: MonadUnliftIO m
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessWait_ :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait_ ProcessConfig stdin stdout stderr
pc Process stdin stdout stderr -> m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
P.withProcessWait_ ProcessConfig stdin stdout stderr
pc (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)
withProcessTerm
:: MonadUnliftIO m
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessTerm :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm ProcessConfig stdin stdout stderr
pc Process stdin stdout stderr -> m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
P.withProcessTerm ProcessConfig stdin stdout stderr
pc (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)
withProcessTerm_
:: MonadUnliftIO m
=> ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a)
-> m a
withProcessTerm_ :: forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm_ ProcessConfig stdin stdout stderr
pc Process stdin stdout stderr -> m a
f = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) stdin stdout stderr a.
MonadUnliftIO m =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
P.withProcessTerm_ ProcessConfig stdin stdout stderr
pc (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)
data LoggedProcessContext = LoggedProcessContext ProcessContext LogFunc
instance HasLogFunc LoggedProcessContext where
logFuncL :: Lens' LoggedProcessContext LogFunc
logFuncL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(LoggedProcessContext ProcessContext
_ LogFunc
lf) -> LogFunc
lf) (\(LoggedProcessContext ProcessContext
pc LogFunc
_) LogFunc
lf -> ProcessContext -> LogFunc -> LoggedProcessContext
LoggedProcessContext ProcessContext
pc LogFunc
lf)
instance HasProcessContext LoggedProcessContext where
processContextL :: Lens' LoggedProcessContext ProcessContext
processContextL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(LoggedProcessContext ProcessContext
x LogFunc
_) -> ProcessContext
x) (\(LoggedProcessContext ProcessContext
_ LogFunc
lf) ProcessContext
pc -> ProcessContext -> LogFunc -> LoggedProcessContext
LoggedProcessContext ProcessContext
pc LogFunc
lf)
withProcessContextNoLogging :: MonadIO m => RIO LoggedProcessContext a -> m a
withProcessContextNoLogging :: forall (m :: * -> *) a.
MonadIO m =>
RIO LoggedProcessContext a -> m a
withProcessContextNoLogging RIO LoggedProcessContext a
inner = do
ProcessContext
pc <- forall (m :: * -> *). MonadIO m => m ProcessContext
mkDefaultProcessContext
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (ProcessContext -> LogFunc -> LoggedProcessContext
LoggedProcessContext ProcessContext
pc forall a. Monoid a => a
mempty) RIO LoggedProcessContext a
inner
exec :: (HasProcessContext env, HasLogFunc env) => String -> [String] -> RIO env b
#ifdef WINDOWS
exec = execSpawn
#else
exec :: forall env b.
(HasProcessContext env, HasLogFunc env) =>
String -> [String] -> RIO env b
exec String
cmd0 [String]
args = do
Maybe String
wd <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL
[(String, String)]
envStringsL <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env.
HasProcessContext env =>
SimpleGetter env [(String, String)]
envVarsStringsL
String
cmd <- forall env (m :: * -> *).
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m String
preProcess String
cmd0
forall (m :: * -> *) env a.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Maybe String -> String -> [String] -> m a -> m a
withProcessTimeLog Maybe String
wd String
cmd [String]
args forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
wd String -> IO ()
setCurrentDirectory
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
cmd Bool
True [String]
args forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [(String, String)]
envStringsL
#endif
execSpawn :: (HasProcessContext env, HasLogFunc env) => String -> [String] -> RIO env a
execSpawn :: forall env b.
(HasProcessContext env, HasLogFunc env) =>
String -> [String] -> RIO env b
execSpawn String
cmd [String]
args = forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
cmd [String]
args (forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ExitCode -> IO a
exitWith
doesExecutableExist
:: (MonadIO m, MonadReader env m, HasProcessContext env)
=> String
-> m Bool
doesExecutableExist :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m Bool
doesExecutableExist = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m (Either ProcessException String)
findExecutable
findExecutable
:: (MonadIO m, MonadReader env m, HasProcessContext env)
=> String
-> m (Either ProcessException FilePath)
findExecutable :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m (Either ProcessException String)
findExecutable String
name | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
FP.isPathSeparator String
name = do
[String]
names <- forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m [String]
addPcExeExtensions String
name
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
m (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> m (Either ProcessException String)
testFPs (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> ProcessException
ExecutableNotFoundAt String
name) String -> IO String
D.makeAbsolute [String]
names
findExecutable String
name = do
ProcessContext
pc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
Map String (Either ProcessException String)
m <- forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef forall a b. (a -> b) -> a -> b
$ ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache ProcessContext
pc
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Map String (Either ProcessException String)
m of
Just Either ProcessException String
epath -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ProcessException String
epath
Maybe (Either ProcessException String)
Nothing -> do
let loop :: [String] -> f (Either ProcessException String)
loop [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessException
ExecutableNotFound String
name (ProcessContext -> [String]
pcPath ProcessContext
pc)
loop (String
dir:[String]
dirs) = do
[String]
fps <- forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m [String]
addPcExeExtensions forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
FP.</> String
name
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
m (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> m (Either ProcessException String)
testFPs ([String] -> f (Either ProcessException String)
loop [String]
dirs) String -> IO String
D.makeAbsolute [String]
fps
Either ProcessException String
epath <- forall {env} {f :: * -> *}.
(MonadReader env f, MonadIO f, HasProcessContext env) =>
[String] -> f (Either ProcessException String)
loop forall a b. (a -> b) -> a -> b
$ ProcessContext -> [String]
pcPath ProcessContext
pc
() <- forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef (ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache ProcessContext
pc) forall a b. (a -> b) -> a -> b
$ \Map String (Either ProcessException String)
m' ->
(forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name Either ProcessException String
epath Map String (Either ProcessException String)
m', ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ProcessException String
epath
addPcExeExtensions
:: (MonadIO m, MonadReader env m, HasProcessContext env)
=> FilePath -> m [FilePath]
addPcExeExtensions :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m [String]
addPcExeExtensions String
fp = do
ProcessContext
pc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (if Bool
isWindows Bool -> Bool -> Bool
&& String -> Bool
FP.hasExtension String
fp then (String
fpforall a. a -> [a] -> [a]
:) else forall a. a -> a
id)
(forall a b. (a -> b) -> [a] -> [b]
map (String
fp forall a. [a] -> [a] -> [a]
++) (ProcessContext -> [String]
pcExeExtensions ProcessContext
pc))
testFPs
:: (MonadIO m, MonadReader env m, HasProcessContext env)
=> m (Either ProcessException FilePath)
-> (FilePath -> IO FilePath)
-> [FilePath]
-> m (Either ProcessException FilePath)
testFPs :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
m (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> m (Either ProcessException String)
testFPs m (Either ProcessException String)
ifNone String -> IO String
_ [] = m (Either ProcessException String)
ifNone
testFPs m (Either ProcessException String)
ifNone String -> IO String
modify (String
fp:[String]
fps) = do
Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
D.doesFileExist String
fp
Bool
existsExec <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ if Bool
exists
then if Bool
isWindows then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else IO Bool
isExecutable
else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
if Bool
existsExec then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
modify String
fp else forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
m (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> m (Either ProcessException String)
testFPs m (Either ProcessException String)
ifNone String -> IO String
modify [String]
fps
where
isExecutable :: IO Bool
isExecutable = Permissions -> Bool
D.executable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Permissions
D.getPermissions String
fp
exeExtensions :: (MonadIO m, MonadReader env m, HasProcessContext env)
=> m [String]
exeExtensions :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
m [String]
exeExtensions = do
ProcessContext
pc <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProcessContext -> [String]
pcExeExtensions ProcessContext
pc
augmentPath :: [FilePath] -> Maybe Text -> Either ProcessException Text
augmentPath :: [String] -> Maybe Text -> Either ProcessException Text
augmentPath [String]
dirs Maybe Text
mpath =
case forall a. (a -> Bool) -> [a] -> [a]
filter (Char
FP.searchPathSeparator forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [String]
dirs of
[] -> forall a b. b -> Either a b
Right
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
FP.searchPathSeparator)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.dropTrailingPathSeparator) [String]
dirs
forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe Text
mpath
[String]
illegal -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> ProcessException
PathsInvalidInPath [String]
illegal
augmentPathMap :: [FilePath] -> EnvVars -> Either ProcessException EnvVars
augmentPathMap :: [String] -> EnvVars -> Either ProcessException EnvVars
augmentPathMap = Text -> [String] -> EnvVars -> Either ProcessException EnvVars
augmentPathMap' Text
"PATH"
augmentPathMap'
:: Text
-> [FilePath]
-> EnvVars
-> Either ProcessException EnvVars
augmentPathMap' :: Text -> [String] -> EnvVars -> Either ProcessException EnvVars
augmentPathMap' Text
envVar [String]
dirs (EnvVars -> EnvVars
normalizePathEnv -> EnvVars
origEnv) =
do Text
path <- [String] -> Maybe Text -> Either ProcessException Text
augmentPath [String]
dirs Maybe Text
mpath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
envVar Text
path EnvVars
origEnv
where
mpath :: Maybe Text
mpath = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
envVar EnvVars
origEnv
showProcessArgDebug :: String -> Text
showProcessArgDebug :: String -> Text
showProcessArgDebug String
x
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
special String
x Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x = String -> Text
T.pack (forall a. Show a => a -> String
show String
x)
| Bool
otherwise = String -> Text
T.pack String
x
where special :: Char -> Bool
special Char
'"' = Bool
True
special Char
' ' = Bool
True
special Char
_ = Bool
False