{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Interacting with external processes.
--
-- This module provides a layer on top of "System.Process.Typed", with
-- the following additions:
--
-- * For efficiency, it will cache @PATH@ lookups.
--
-- * For convenience, you can set the working directory and env vars
--   overrides in a 'RIO' environment instead of on the individual
--   calls to the process.
--
-- * Built-in support for logging at the debug level.
--
-- In order to switch over to this API, the main idea is:
--
-- * Like most of the rio library, you need to create an environment
--   value (this time 'ProcessContext'), and include it in your 'RIO'
--   environment. See 'mkProcessContext'.
--
-- * Instead of using the 'System.Process.Typed.proc' function from
--   "System.Process.Typed" for creating a 'ProcessConfig', use the
--   locally defined 'proc' function, which will handle overriding
--   environment variables, looking up paths, performing logging, etc.
--
-- Once you have your 'ProcessConfig', use the standard functions from
-- 'System.Process.Typed' (reexported here for convenient) for running
-- the 'ProcessConfig'.
--
-- @since 0.0.3.0
module RIO.Process
  ( -- * Process context
    ProcessContext
  , HasProcessContext (..)
  , EnvVars
  , mkProcessContext
  , mkDefaultProcessContext
  , modifyEnvVars
  , withModifyEnvVars
  , lookupEnvFromContext
  , withWorkingDir
    -- ** Lenses
  , workingDirL
  , envVarsL
  , envVarsStringsL
  , exeSearchPathL
    -- ** Actions
  , resetExeCache
    -- * Configuring
  , proc
    -- * Spawning (run child process)
  , withProcess
  , withProcess_
  , withProcessWait
  , withProcessWait_
  , withProcessTerm
  , withProcessTerm_
    -- * Exec (replacing current process)
  , exec
  , execSpawn
    -- * Environment helper
  , LoggedProcessContext (..)
  , withProcessContextNoLogging
    -- * Exceptions
  , ProcessException (..)
    -- * Utilities
  , doesExecutableExist
  , findExecutable
  , exeExtensions
  , augmentPath
  , augmentPathMap
  , showProcessArgDebug
    -- * Reexports
  , 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

-- | The environment variable map
--
-- @since 0.0.3.0
type EnvVars = Map Text Text

-- | Context in which to run processes.
--
-- @since 0.0.3.0
data ProcessContext = ProcessContext
    { ProcessContext -> EnvVars
pcTextMap :: !EnvVars
    -- ^ Environment variables as map

    , ProcessContext -> [(String, String)]
pcStringList :: ![(String, String)]
    -- ^ Environment variables as association list

    , ProcessContext -> [String]
pcPath :: ![FilePath]
    -- ^ List of directories searched for executables (@PATH@)

    , ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache :: !(IORef (Map FilePath (Either ProcessException FilePath)))
    -- ^ Cache of already looked up executable paths.

    , ProcessContext -> [String]
pcExeExtensions :: [String]
    -- ^ @[""]@ on non-Windows systems, @["", ".exe", ".bat"]@ on Windows

    , ProcessContext -> Maybe String
pcWorkingDir :: !(Maybe FilePath)
    -- ^ Override the working directory.
    }

-- | Exception type which may be generated in this module.
--
-- /NOTE/ Other exceptions may be thrown by underlying libraries!
--
-- @since 0.0.3.0
data ProcessException
    = NoPathFound
    | ExecutableNotFound String [FilePath]
    | ExecutableNotFoundAt FilePath
    | PathsInvalidInPath [FilePath]
    deriving Typeable
instance Show ProcessException where
    show :: ProcessException -> String
show ProcessException
NoPathFound = String
"PATH not found in ProcessContext"
    show (ExecutableNotFound String
name [String]
path) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Executable named "
        , String
name
        , String
" not found on path: "
        , [String] -> String
forall a. Show a => a -> String
show [String]
path
        ]
    show (ExecutableNotFoundAt String
name) =
        String
"Did not find executable at specified path: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
    show (PathsInvalidInPath [String]
paths) = [String] -> String
unlines ([String] -> String) -> [String] -> String
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 "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
FP.searchPathSeparator String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
        , String
"Please fix the following paths and try again:"
        ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
paths
instance Exception ProcessException

-- | Get the 'ProcessContext' from the environment.
--
-- @since 0.0.3.0
class HasProcessContext env where
  processContextL :: Lens' env ProcessContext
instance HasProcessContext ProcessContext where
  processContextL :: (ProcessContext -> f ProcessContext)
-> ProcessContext -> f ProcessContext
processContextL = (ProcessContext -> f ProcessContext)
-> ProcessContext -> f ProcessContext
forall a. a -> a
id

data EnvVarFormat = EVFWindows | EVFNotWindows

currentEnvVarFormat :: EnvVarFormat
currentEnvVarFormat :: EnvVarFormat
currentEnvVarFormat =
#if WINDOWS
  EVFWindows
#else
  EnvVarFormat
EVFNotWindows
#endif

-- Don't use CPP so that the Windows code path is at least type checked
-- regularly
isWindows :: Bool
isWindows :: Bool
isWindows = case EnvVarFormat
currentEnvVarFormat of
              EnvVarFormat
EVFWindows -> Bool
True
              EnvVarFormat
EVFNotWindows -> Bool
False

-- | Override the working directory processes run in. @Nothing@ means
-- the current process's working directory.
--
-- @since 0.0.3.0
workingDirL :: HasProcessContext env => Lens' env (Maybe FilePath)
workingDirL :: Lens' env (Maybe String)
workingDirL = (ProcessContext -> f ProcessContext) -> env -> f env
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL((ProcessContext -> f ProcessContext) -> env -> f env)
-> ((Maybe String -> f (Maybe String))
    -> ProcessContext -> f ProcessContext)
-> (Maybe String -> f (Maybe String))
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> Maybe String)
-> (ProcessContext -> Maybe String -> ProcessContext)
-> Lens ProcessContext ProcessContext (Maybe String) (Maybe String)
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 })

-- | Get the environment variables. We cannot provide a @Lens@ here,
-- since updating the environment variables requires an @IO@ action to
-- allocate a new @IORef@ for holding the executable path cache.
--
-- @since 0.0.3.0
envVarsL :: HasProcessContext env => SimpleGetter env EnvVars
envVarsL :: SimpleGetter env EnvVars
envVarsL = (ProcessContext -> Const r ProcessContext) -> env -> Const r env
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL((ProcessContext -> Const r ProcessContext) -> env -> Const r env)
-> ((EnvVars -> Const r EnvVars)
    -> ProcessContext -> Const r ProcessContext)
-> (EnvVars -> Const r EnvVars)
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> EnvVars) -> SimpleGetter ProcessContext EnvVars
forall s a. (s -> a) -> SimpleGetter s a
to ProcessContext -> EnvVars
pcTextMap

-- | Get the 'EnvVars' as an associated list of 'String's.
--
-- Useful for interacting with other libraries.
--
-- @since 0.0.3.0
envVarsStringsL :: HasProcessContext env => SimpleGetter env [(String, String)]
envVarsStringsL :: SimpleGetter env [(String, String)]
envVarsStringsL = (ProcessContext -> Const r ProcessContext) -> env -> Const r env
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL((ProcessContext -> Const r ProcessContext) -> env -> Const r env)
-> (([(String, String)] -> Const r [(String, String)])
    -> ProcessContext -> Const r ProcessContext)
-> ([(String, String)] -> Const r [(String, String)])
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> [(String, String)])
-> SimpleGetter ProcessContext [(String, String)]
forall s a. (s -> a) -> SimpleGetter s a
to ProcessContext -> [(String, String)]
pcStringList

-- | Get the list of directories searched for executables (the @PATH@).
--
-- Similar to 'envVarMapL', this cannot be a full @Lens@.
--
-- @since 0.0.3.0
exeSearchPathL :: HasProcessContext env => SimpleGetter env [FilePath]
exeSearchPathL :: SimpleGetter env [String]
exeSearchPathL = (ProcessContext -> Const r ProcessContext) -> env -> Const r env
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL((ProcessContext -> Const r ProcessContext) -> env -> Const r env)
-> (([String] -> Const r [String])
    -> ProcessContext -> Const r ProcessContext)
-> ([String] -> Const r [String])
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> [String])
-> SimpleGetter ProcessContext [String]
forall s a. (s -> a) -> SimpleGetter s a
to ProcessContext -> [String]
pcPath

-- | Create a new 'ProcessContext' from the given environment variable map.
--
-- @since 0.0.3.0
mkProcessContext :: MonadIO m => EnvVars -> m ProcessContext
mkProcessContext :: EnvVars -> m ProcessContext
mkProcessContext EnvVars
tm' = do
    IORef (Map String (Either ProcessException String))
ref <- Map String (Either ProcessException String)
-> m (IORef (Map String (Either ProcessException String)))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Map String (Either ProcessException String)
forall k a. Map k a
Map.empty
    ProcessContext -> m ProcessContext
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContext :: EnvVars
-> [(String, String)]
-> [String]
-> IORef (Map String (Either ProcessException String))
-> [String]
-> Maybe String
-> ProcessContext
ProcessContext
        { pcTextMap :: EnvVars
pcTextMap = EnvVars
tm
        , pcStringList :: [(String, String)]
pcStringList = ((Text, Text) -> (String, String))
-> [(Text, Text)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack (Text -> String)
-> (Text -> String) -> (Text, Text) -> (String, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> String
T.unpack) ([(Text, Text)] -> [(String, String)])
-> [(Text, Text)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ EnvVars -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList EnvVars
tm
        , pcPath :: [String]
pcPath =
             (if Bool
isWindows then (String
"."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id)
             ([String] -> (Text -> [String]) -> Maybe Text -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (String -> [String]
FP.splitSearchPath (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Text -> EnvVars -> Maybe Text
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 = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
defaultPATHEXT
                                             (Text -> EnvVars -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"PATHEXT" EnvVars
tm)
                      in (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
";" Text
pathext
                else [String
""]
        , pcWorkingDir :: Maybe String
pcWorkingDir = Maybe String
forall a. Maybe a
Nothing
        }
  where
    -- Fix case insensitivity of the PATH environment variable on Windows.
    tm :: EnvVars
tm
        | Bool
isWindows = [(Text, Text)] -> EnvVars
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> EnvVars) -> [(Text, Text)] -> EnvVars
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Text
T.toUpper) ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ EnvVars -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList EnvVars
tm'
        | Bool
otherwise = EnvVars
tm'
    -- Default value for PATHTEXT on Windows versions after Windows XP. (The
    -- documentation of the default at
    -- https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/start
    -- is incomplete.)
    defaultPATHEXT :: Text
defaultPATHEXT = Text
".COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC"


-- | Reset the executable cache.
--
-- @since 0.0.3.0
resetExeCache :: (MonadIO m, MonadReader env m, HasProcessContext env) => m ()
resetExeCache :: m ()
resetExeCache = do
  ProcessContext
pc <- Getting ProcessContext env ProcessContext -> m ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
  IORef (Map String (Either ProcessException String))
-> (Map String (Either ProcessException String)
    -> (Map String (Either ProcessException String), ()))
-> m ()
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef (ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache ProcessContext
pc) ((Map String (Either ProcessException String), ())
-> Map String (Either ProcessException String)
-> (Map String (Either ProcessException String), ())
forall a b. a -> b -> a
const (Map String (Either ProcessException String), ())
forall a. Monoid a => a
mempty)

-- | Same as 'mkProcessContext' but uses the system environment (from
-- 'System.Environment.getEnvironment').
--
-- @since 0.0.3.0
mkDefaultProcessContext :: MonadIO m => m ProcessContext
mkDefaultProcessContext :: m ProcessContext
mkDefaultProcessContext =
    IO ProcessContext -> m ProcessContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessContext -> m ProcessContext)
-> IO ProcessContext -> m ProcessContext
forall a b. (a -> b) -> a -> b
$
    IO [(String, String)]
getEnvironment IO [(String, String)]
-> ([(String, String)] -> IO ProcessContext) -> IO ProcessContext
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          EnvVars -> IO ProcessContext
forall (m :: * -> *). MonadIO m => EnvVars -> m ProcessContext
mkProcessContext
        (EnvVars -> IO ProcessContext)
-> ([(String, String)] -> EnvVars)
-> [(String, String)]
-> IO ProcessContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> EnvVars
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> EnvVars)
-> ([(String, String)] -> [(Text, Text)])
-> [(String, String)]
-> EnvVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> (Text, Text))
-> [(String, String)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text)
-> (String -> Text) -> (String, String) -> (Text, Text)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> Text
T.pack)

-- | Modify the environment variables of a 'ProcessContext'. This will not
-- change the working directory.
--
-- Note that this requires 'MonadIO', as it will create a new 'IORef'
-- for the cache.
--
-- @since 0.0.3.0
modifyEnvVars
  :: MonadIO m
  => ProcessContext
  -> (EnvVars -> EnvVars)
  -> m ProcessContext
modifyEnvVars :: ProcessContext -> (EnvVars -> EnvVars) -> m ProcessContext
modifyEnvVars ProcessContext
pc EnvVars -> EnvVars
f = do
  ProcessContext
pc' <- EnvVars -> m ProcessContext
forall (m :: * -> *). MonadIO m => EnvVars -> m ProcessContext
mkProcessContext (EnvVars -> EnvVars
f (EnvVars -> EnvVars) -> EnvVars -> EnvVars
forall a b. (a -> b) -> a -> b
$ ProcessContext -> EnvVars
pcTextMap ProcessContext
pc)
  ProcessContext -> m ProcessContext
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessContext
pc' { pcWorkingDir :: Maybe String
pcWorkingDir = ProcessContext -> Maybe String
pcWorkingDir ProcessContext
pc }

-- | Use 'modifyEnvVars' to create a new 'ProcessContext', and then
-- use it in the provided action.
--
-- @since 0.0.3.0
withModifyEnvVars
  :: (HasProcessContext env, MonadReader env m, MonadIO m)
  => (EnvVars -> EnvVars)
  -> m a
  -> m a
withModifyEnvVars :: (EnvVars -> EnvVars) -> m a -> m a
withModifyEnvVars EnvVars -> EnvVars
f m a
inner = do
  ProcessContext
pc <- Getting ProcessContext env ProcessContext -> m ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
  ProcessContext
pc' <- ProcessContext -> (EnvVars -> EnvVars) -> m ProcessContext
forall (m :: * -> *).
MonadIO m =>
ProcessContext -> (EnvVars -> EnvVars) -> m ProcessContext
modifyEnvVars ProcessContext
pc EnvVars -> EnvVars
f
  (env -> env) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (ASetter env env ProcessContext ProcessContext
-> ProcessContext -> env -> env
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter env env ProcessContext ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL ProcessContext
pc') m a
inner

-- | Look into the `ProcessContext` and return the specified environmet variable if one is
-- available.
--
-- @since 0.1.14.0
lookupEnvFromContext :: (MonadReader env m, HasProcessContext env) => Text -> m (Maybe Text)
lookupEnvFromContext :: Text -> m (Maybe Text)
lookupEnvFromContext Text
envName = Text -> EnvVars -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
envName (EnvVars -> Maybe Text) -> m EnvVars -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting EnvVars env EnvVars -> m EnvVars
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EnvVars env EnvVars
forall env. HasProcessContext env => SimpleGetter env EnvVars
envVarsL

-- | Set the working directory to be used by child processes.
--
-- @since 0.0.3.0
withWorkingDir
  :: (HasProcessContext env, MonadReader env m, MonadIO m)
  => FilePath
  -> m a
  -> m a
withWorkingDir :: String -> m a -> m a
withWorkingDir = (env -> env) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((env -> env) -> m a -> m a)
-> (String -> env -> env) -> String -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter env env (Maybe String) (Maybe String)
-> Maybe String -> env -> env
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter env env (Maybe String) (Maybe String)
forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL (Maybe String -> env -> env)
-> (String -> Maybe String) -> String -> env -> env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just

-- | Perform pre-call-process tasks.  Ensure the working directory exists and find the
-- executable path.
--
-- Throws a 'ProcessException' if unsuccessful.
--
-- NOT CURRENTLY EXPORTED
preProcess
  :: (HasProcessContext env, MonadReader env m, MonadIO m)
  => String            -- ^ Command name
  -> m FilePath
preProcess :: String -> m String
preProcess String
name = do
  String
name' <- String -> m (Either ProcessException String)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m (Either ProcessException String)
findExecutable String
name m (Either ProcessException String)
-> (Either ProcessException String -> m String) -> m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProcessException -> m String)
-> (String -> m String)
-> Either ProcessException String
-> m String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ProcessException -> m String
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return
  Maybe String
wd <- Getting (Maybe String) env (Maybe String) -> m (Maybe String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) env (Maybe String)
forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Bool -> String -> IO ()
D.createDirectoryIfMissing Bool
True) Maybe String
wd
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name'

-- | Log running a process with its arguments, for debugging (-v).
--
-- This logs one message before running the process and one message after.
--
-- NOT CURRENTLY EXPORTED
withProcessTimeLog
  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)
  => Maybe FilePath -- ^ working dirj
  -> String -- ^ executable
  -> [String] -- ^ arguments
  -> m a
  -> m a
withProcessTimeLog :: 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 Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (String -> Text) -> [String] -> [Text]
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
dir
  Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder
"Run process" Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
dirMsg Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
cmdText)
  Double
start <- m Double
forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
  a
x <- m a
proc'
  Double
end <- m Double
forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
  let diff :: Double
diff = Double
end Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start
  Bool
useColor <- Getting Bool env Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool env Bool
forall env. HasLogFunc env => SimpleGetter env Bool
logFuncUseColorL
  Int -> Utf8Builder
accentColors <- Getting (Int -> Utf8Builder) env (Int -> Utf8Builder)
-> m (Int -> Utf8Builder)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Int -> Utf8Builder) env (Int -> Utf8Builder)
forall env. HasLogFunc env => SimpleGetter env (Int -> Utf8Builder)
logFuncAccentColorsL
  Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug
      (Utf8Builder
"Process finished in " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
      (if Bool
useColor then Int -> Utf8Builder
accentColors Int
0 else Utf8Builder
"") Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> -- accent color 0
      Double -> Utf8Builder
timeSpecMilliSecondText Double
diff Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
      (if Bool
useColor then Utf8Builder
"\ESC[0m" else Utf8Builder
"") Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> -- reset
       Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
cmdText)
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

timeSpecMilliSecondText :: Double -> Utf8Builder
timeSpecMilliSecondText :: Double -> Utf8Builder
timeSpecMilliSecondText Double
d = Int -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) :: Int) Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"ms"

-- | Provide a 'ProcessConfig' based on the 'ProcessContext' in
-- scope. Deals with resolving the full path, setting the child
-- process's environment variables, setting the working directory, and
-- wrapping the call with 'withProcessTimeLog' for debugging output.
--
-- This is intended to be analogous to the @proc@ function provided by
-- the @System.Process.Typed@ module, but has a different type
-- signature to (1) allow it to perform @IO@ actions for looking up
-- paths, and (2) allow logging and timing of the running action.
--
-- @since 0.0.3.0
proc
  :: (HasProcessContext env, HasLogFunc env, MonadReader env m, MonadIO m, HasCallStack)
  => FilePath -- ^ command to run
  -> [String] -- ^ command line arguments
  -> (ProcessConfig () () () -> m a)
  -> m a
proc :: String -> [String] -> (ProcessConfig () () () -> m a) -> m a
proc String
name0 [String]
args ProcessConfig () () () -> m a
inner = do
  String
name <- String -> m String
forall env (m :: * -> *).
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m String
preProcess String
name0
  Maybe String
wd <- Getting (Maybe String) env (Maybe String) -> m (Maybe String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) env (Maybe String)
forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL
  [(String, String)]
envStrings <- Getting [(String, String)] env [(String, String)]
-> m [(String, String)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(String, String)] env [(String, String)]
forall env.
HasProcessContext env =>
SimpleGetter env [(String, String)]
envVarsStringsL

  Maybe String -> String -> [String] -> m a -> m a
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
    (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ ProcessConfig () () () -> m a
inner
    (ProcessConfig () () () -> m a) -> ProcessConfig () () () -> m a
forall a b. (a -> b) -> a -> b
$ [(String, String)]
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
[(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(String, String)]
envStrings
    (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ (ProcessConfig () () () -> ProcessConfig () () ())
-> (String -> ProcessConfig () () () -> ProcessConfig () () ())
-> Maybe String
-> ProcessConfig () () ()
-> ProcessConfig () () ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProcessConfig () () () -> ProcessConfig () () ()
forall a. a -> a
id String -> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdout stderr.
String
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir Maybe String
wd
    (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () () -> ProcessConfig () () ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
P.proc String
name [String]
args

-- | Same as 'P.withProcess', but generalized to 'MonadUnliftIO'.
--
-- @since 0.0.3.0
withProcess
  :: MonadUnliftIO m
  => ProcessConfig stdin stdout stderr
  -> (Process stdin stdout stderr -> m a)
  -> m a
withProcess :: 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 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) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> 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
P.withProcessTerm ProcessConfig stdin stdout stderr
pc (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (Process stdin stdout stderr -> m a)
-> Process stdin stdout stderr
-> IO a
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" #-}

-- | Same as 'P.withProcess_', but generalized to 'MonadUnliftIO'.
--
-- @since 0.0.3.0
withProcess_
  :: MonadUnliftIO m
  => ProcessConfig stdin stdout stderr
  -> (Process stdin stdout stderr -> m a)
  -> m a
withProcess_ :: 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 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) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> 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
P.withProcessTerm_ ProcessConfig stdin stdout stderr
pc (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (Process stdin stdout stderr -> m a)
-> Process stdin stdout stderr
-> IO a
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" #-}

-- | Same as 'P.withProcessWait', but generalized to 'MonadUnliftIO'.
--
-- @since 0.1.10.0
withProcessWait
  :: MonadUnliftIO m
  => ProcessConfig stdin stdout stderr
  -> (Process stdin stdout stderr -> m a)
  -> m a
withProcessWait :: 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 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) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> 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
P.withProcessWait ProcessConfig stdin stdout stderr
pc (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (Process stdin stdout stderr -> m a)
-> Process stdin stdout stderr
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)

-- | Same as 'P.withProcessWait_', but generalized to 'MonadUnliftIO'.
--
-- @since 0.1.10.0
withProcessWait_
  :: MonadUnliftIO m
  => ProcessConfig stdin stdout stderr
  -> (Process stdin stdout stderr -> m a)
  -> m a
withProcessWait_ :: 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 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) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> 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
P.withProcessWait_ ProcessConfig stdin stdout stderr
pc (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (Process stdin stdout stderr -> m a)
-> Process stdin stdout stderr
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)

-- | Same as 'P.withProcessTerm', but generalized to 'MonadUnliftIO'.
--
-- @since 0.1.10.0
withProcessTerm
  :: MonadUnliftIO m
  => ProcessConfig stdin stdout stderr
  -> (Process stdin stdout stderr -> m a)
  -> m a
withProcessTerm :: 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 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) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> 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
P.withProcessTerm ProcessConfig stdin stdout stderr
pc (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (Process stdin stdout stderr -> m a)
-> Process stdin stdout stderr
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)

-- | Same as 'P.withProcessTerm_', but generalized to 'MonadUnliftIO'.
--
-- @since 0.1.10.0
withProcessTerm_
  :: MonadUnliftIO m
  => ProcessConfig stdin stdout stderr
  -> (Process stdin stdout stderr -> m a)
  -> m a
withProcessTerm_ :: 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 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) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> 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
P.withProcessTerm_ ProcessConfig stdin stdout stderr
pc (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a)
-> (Process stdin stdout stderr -> m a)
-> Process stdin stdout stderr
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m a
f)

-- | A convenience environment combining a 'LogFunc' and a 'ProcessContext'
--
-- @since 0.0.3.0
data LoggedProcessContext = LoggedProcessContext ProcessContext LogFunc

instance HasLogFunc LoggedProcessContext where
  logFuncL :: (LogFunc -> f LogFunc)
-> LoggedProcessContext -> f LoggedProcessContext
logFuncL = (LoggedProcessContext -> LogFunc)
-> (LoggedProcessContext -> LogFunc -> LoggedProcessContext)
-> Lens' LoggedProcessContext LogFunc
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 :: (ProcessContext -> f ProcessContext)
-> LoggedProcessContext -> f LoggedProcessContext
processContextL = (LoggedProcessContext -> ProcessContext)
-> (LoggedProcessContext -> ProcessContext -> LoggedProcessContext)
-> Lens' LoggedProcessContext ProcessContext
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)

-- | Run an action using a 'LoggedProcessContext' with default
-- settings and no logging.
--
-- @since 0.0.3.0
withProcessContextNoLogging :: MonadIO m => RIO LoggedProcessContext a -> m a
withProcessContextNoLogging :: RIO LoggedProcessContext a -> m a
withProcessContextNoLogging RIO LoggedProcessContext a
inner = do
  ProcessContext
pc <- m ProcessContext
forall (m :: * -> *). MonadIO m => m ProcessContext
mkDefaultProcessContext
  LoggedProcessContext -> RIO LoggedProcessContext a -> m a
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (ProcessContext -> LogFunc -> LoggedProcessContext
LoggedProcessContext ProcessContext
pc LogFunc
forall a. Monoid a => a
mempty) RIO LoggedProcessContext a
inner

-- | Execute a process within the configured environment.
--
-- Execution will not return, because either:
--
-- 1) On non-windows, execution is taken over by execv of the
-- sub-process. This allows signals to be propagated (#527)
--
-- 2) On windows, an 'ExitCode' exception will be thrown.
--
-- @since 0.0.3.0
exec :: (HasProcessContext env, HasLogFunc env) => String -> [String] -> RIO env b
#ifdef WINDOWS
exec = execSpawn
#else
exec :: String -> [String] -> RIO env b
exec String
cmd0 [String]
args = do
    Maybe String
wd <- Getting (Maybe String) env (Maybe String) -> RIO env (Maybe String)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) env (Maybe String)
forall env. HasProcessContext env => Lens' env (Maybe String)
workingDirL
    [(String, String)]
envStringsL <- Getting [(String, String)] env [(String, String)]
-> RIO env [(String, String)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(String, String)] env [(String, String)]
forall env.
HasProcessContext env =>
SimpleGetter env [(String, String)]
envVarsStringsL
    String
cmd <- String -> RIO env String
forall env (m :: * -> *).
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m String
preProcess String
cmd0
    Maybe String -> String -> [String] -> RIO env b -> RIO env b
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 (RIO env b -> RIO env b) -> RIO env b -> RIO env b
forall a b. (a -> b) -> a -> b
$ IO b -> RIO env b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> RIO env b) -> IO b -> RIO env b
forall a b. (a -> b) -> a -> b
$ do
      Maybe String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe String
wd String -> IO ()
setCurrentDirectory
      String -> Bool -> [String] -> Maybe [(String, String)] -> IO b
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile String
cmd Bool
True [String]
args (Maybe [(String, String)] -> IO b)
-> Maybe [(String, String)] -> IO b
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
envStringsL
#endif

-- | Like 'exec', but does not use 'execv' on non-windows. This way,
-- there is a sub-process, which is helpful in some cases
-- (<https://github.com/commercialhaskell/stack/issues/1306>).
--
-- This function only exits by throwing 'ExitCode'.
--
-- @since 0.0.3.0
execSpawn :: (HasProcessContext env, HasLogFunc env) => String -> [String] -> RIO env a
execSpawn :: String -> [String] -> RIO env a
execSpawn String
cmd [String]
args = String
-> [String]
-> (ProcessConfig () () () -> RIO env ExitCode)
-> RIO env ExitCode
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 (ProcessConfig () () () -> RIO env ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> RIO env ExitCode)
-> (ProcessConfig () () () -> ProcessConfig () () ())
-> ProcessConfig () () ()
-> RIO env ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamSpec 'STInput ()
-> ProcessConfig () () () -> ProcessConfig () () ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin StreamSpec 'STInput ()
forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
inherit) RIO env ExitCode -> (ExitCode -> RIO env a) -> RIO env a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> RIO env a) -> (ExitCode -> IO a) -> ExitCode -> RIO env a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith

-- | Check if the given executable exists on the given PATH.
--
-- @since 0.0.3.0
doesExecutableExist
  :: (MonadIO m, MonadReader env m, HasProcessContext env)
  => String            -- ^ Name of executable
  -> m Bool
doesExecutableExist :: String -> m Bool
doesExecutableExist = (Either ProcessException String -> Bool)
-> m (Either ProcessException String) -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either ProcessException String -> Bool
forall a b. Either a b -> Bool
isRight (m (Either ProcessException String) -> m Bool)
-> (String -> m (Either ProcessException String))
-> String
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (Either ProcessException String)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m (Either ProcessException String)
findExecutable

-- | Find the complete path for the given executable name.
--
-- On POSIX systems, filenames that match but are not exectuables are excluded.
--
-- On Windows systems, the executable names tried, in turn, are the supplied
-- name (only if it has an extension) and that name extended by each of the
-- 'exeExtensions'. Also, this function may behave differently from
-- 'RIO.Directory.findExecutable'. The latter excludes as executables filenames
-- without a @.bat@, @.cmd@, @.com@ or @.exe@ extension (case-insensitive).
--
-- @since 0.0.3.0
findExecutable
  :: (MonadIO m, MonadReader env m, HasProcessContext env)
  => String
  -- ^ Name of executable
  -> m (Either ProcessException FilePath)
  -- ^ Full path to that executable on success
findExecutable :: String -> m (Either ProcessException String)
findExecutable String
name | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
FP.isPathSeparator String
name = do
  [String]
names <- String -> m [String]
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m [String]
addPcExeExtensions String
name
  m (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> m (Either ProcessException String)
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
m (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> m (Either ProcessException String)
testFPs (Either ProcessException String
-> m (Either ProcessException String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProcessException String
 -> m (Either ProcessException String))
-> Either ProcessException String
-> m (Either ProcessException String)
forall a b. (a -> b) -> a -> b
$ ProcessException -> Either ProcessException String
forall a b. a -> Either a b
Left (ProcessException -> Either ProcessException String)
-> ProcessException -> Either ProcessException String
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 <- Getting ProcessContext env ProcessContext -> m ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
  Map String (Either ProcessException String)
m <- IORef (Map String (Either ProcessException String))
-> m (Map String (Either ProcessException String))
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (IORef (Map String (Either ProcessException String))
 -> m (Map String (Either ProcessException String)))
-> IORef (Map String (Either ProcessException String))
-> m (Map String (Either ProcessException String))
forall a b. (a -> b) -> a -> b
$ ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache ProcessContext
pc
  case String
-> Map String (Either ProcessException String)
-> Maybe (Either ProcessException String)
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 -> Either ProcessException String
-> m (Either ProcessException String)
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 [] = Either ProcessException String
-> f (Either ProcessException String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProcessException String
 -> f (Either ProcessException String))
-> Either ProcessException String
-> f (Either ProcessException String)
forall a b. (a -> b) -> a -> b
$ ProcessException -> Either ProcessException String
forall a b. a -> Either a b
Left (ProcessException -> Either ProcessException String)
-> ProcessException -> Either ProcessException String
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 <- String -> f [String]
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
String -> m [String]
addPcExeExtensions (String -> f [String]) -> String -> f [String]
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
FP.</> String
name
            f (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> f (Either ProcessException String)
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 <- [String] -> m (Either ProcessException String)
forall env (f :: * -> *).
(MonadReader env f, MonadIO f, HasProcessContext env) =>
[String] -> f (Either ProcessException String)
loop ([String] -> m (Either ProcessException String))
-> [String] -> m (Either ProcessException String)
forall a b. (a -> b) -> a -> b
$ ProcessContext -> [String]
pcPath ProcessContext
pc
      () <- IORef (Map String (Either ProcessException String))
-> (Map String (Either ProcessException String)
    -> (Map String (Either ProcessException String), ()))
-> m ()
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef (ProcessContext
-> IORef (Map String (Either ProcessException String))
pcExeCache ProcessContext
pc) ((Map String (Either ProcessException String)
  -> (Map String (Either ProcessException String), ()))
 -> m ())
-> (Map String (Either ProcessException String)
    -> (Map String (Either ProcessException String), ()))
-> m ()
forall a b. (a -> b) -> a -> b
$ \Map String (Either ProcessException String)
m' ->
          (String
-> Either ProcessException String
-> Map String (Either ProcessException String)
-> Map String (Either ProcessException String)
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', ())
      Either ProcessException String
-> m (Either ProcessException String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ProcessException String
epath

-- | A helper function to add the executable extensions of the process context
-- to a file path. On Windows, the original file path is included, if it has an
-- existing extension.
addPcExeExtensions
  :: (MonadIO m, MonadReader env m, HasProcessContext env)
  => FilePath -> m [FilePath]
addPcExeExtensions :: String -> m [String]
addPcExeExtensions String
fp = do
  ProcessContext
pc <- Getting ProcessContext env ProcessContext -> m ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
  [String] -> m [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ (if Bool
isWindows Bool -> Bool -> Bool
&& String -> Bool
FP.hasExtension String
fp then (String
fpString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall a. a -> a
id)
         (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++) (ProcessContext -> [String]
pcExeExtensions ProcessContext
pc))

-- | A helper function to test whether file paths are to an executable
testFPs
  :: (MonadIO m, MonadReader env m, HasProcessContext env)
  => m (Either ProcessException FilePath)
  -- ^ Default if no executable exists at any file path
  -> (FilePath -> IO FilePath)
  -- ^ Modification to apply to a file path, if an executable exists there
  -> [FilePath]
  -- ^ File paths to test, in turn
  -> m (Either ProcessException FilePath)
testFPs :: 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 <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
D.doesFileExist String
fp
  Bool
existsExec <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ if Bool
exists
    then if Bool
isWindows then Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else IO Bool
isExecutable
    else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  if Bool
existsExec then IO (Either ProcessException String)
-> m (Either ProcessException String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessException String)
 -> m (Either ProcessException String))
-> IO (Either ProcessException String)
-> m (Either ProcessException String)
forall a b. (a -> b) -> a -> b
$ String -> Either ProcessException String
forall a b. b -> Either a b
Right (String -> Either ProcessException String)
-> IO String -> IO (Either ProcessException String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
modify String
fp else m (Either ProcessException String)
-> (String -> IO String)
-> [String]
-> m (Either ProcessException String)
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 (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Permissions
D.getPermissions String
fp

-- | Get the filename extensions for executable files, including the dot (if
-- any).
--
-- On POSIX systems, this is @[""]@.
--
-- On Windows systems, the list is determined by the value of the @PATHEXT@
-- environment variable, if it present in the environment. If the variable is
-- absent, this is its default value on a Windows system. This function may,
-- therefore, behave differently from 'RIO.Directory.exeExtension',
-- which returns only @".exe"@.
--
-- @since 0.1.13.0
exeExtensions :: (MonadIO m, MonadReader env m, HasProcessContext env)
              => m [String]
exeExtensions :: m [String]
exeExtensions = do
  ProcessContext
pc <- Getting ProcessContext env ProcessContext -> m ProcessContext
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProcessContext env ProcessContext
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
  [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ ProcessContext -> [String]
pcExeExtensions ProcessContext
pc

-- | Augment the PATH environment variable with the given extra paths.
--
-- @since 0.0.3.0
augmentPath :: [FilePath] -> Maybe Text -> Either ProcessException Text
augmentPath :: [String] -> Maybe Text -> Either ProcessException Text
augmentPath [String]
dirs Maybe Text
mpath =
  case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char
FP.searchPathSeparator Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [String]
dirs of
    [] -> Text -> Either ProcessException Text
forall a b. b -> Either a b
Right
            (Text -> Either ProcessException Text)
-> Text -> Either ProcessException Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
FP.searchPathSeparator)
            ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.dropTrailingPathSeparator) [String]
dirs
            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
mpath
    [String]
illegal -> ProcessException -> Either ProcessException Text
forall a b. a -> Either a b
Left (ProcessException -> Either ProcessException Text)
-> ProcessException -> Either ProcessException Text
forall a b. (a -> b) -> a -> b
$ [String] -> ProcessException
PathsInvalidInPath [String]
illegal

-- | Apply 'augmentPath' on the PATH value in the given 'EnvVars'.
--
-- @since 0.0.3.0
augmentPathMap :: [FilePath] -> EnvVars -> Either ProcessException EnvVars
augmentPathMap :: [String] -> EnvVars -> Either ProcessException EnvVars
augmentPathMap [String]
dirs EnvVars
origEnv =
  do Text
path <- [String] -> Maybe Text -> Either ProcessException Text
augmentPath [String]
dirs Maybe Text
mpath
     EnvVars -> Either ProcessException EnvVars
forall (m :: * -> *) a. Monad m => a -> m a
return (EnvVars -> Either ProcessException EnvVars)
-> EnvVars -> Either ProcessException EnvVars
forall a b. (a -> b) -> a -> b
$ Text -> Text -> EnvVars -> EnvVars
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
"PATH" Text
path EnvVars
origEnv
  where
    mpath :: Maybe Text
mpath = Text -> EnvVars -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"PATH" EnvVars
origEnv

-- | Show a process arg including speechmarks when necessary. Just for
-- debugging purposes, not functionally important.
--
-- @since 0.0.3.0
showProcessArgDebug :: String -> Text
showProcessArgDebug :: String -> Text
showProcessArgDebug String
x
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
special String
x Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x = String -> Text
T.pack (ShowS
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