module CabalHelper.Compiletime.Process
( module CabalHelper.Compiletime.Process
, module System.Process
) where
import Data.Char
import Data.List
import Data.Maybe
import qualified Data.Map.Strict as Map
import GHC.IO.Exception (IOErrorType(OtherError))
import System.IO
import System.IO.Error
import System.Environment
import System.Exit
import System.Process
import CabalHelper.Compiletime.Types
import CabalHelper.Compiletime.Log
readProcess' :: Verbose => FilePath -> [String] -> String -> IO String
readProcess' :: FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess' FilePath
exe [FilePath]
args FilePath
inp =
Verbose =>
Maybe FilePath
-> [(FilePath, EnvOverride)]
-> FilePath
-> [FilePath]
-> FilePath
-> IO FilePath
Maybe FilePath
-> [(FilePath, EnvOverride)]
-> FilePath
-> [FilePath]
-> FilePath
-> IO FilePath
readProcessStderr Maybe FilePath
forall a. Maybe a
Nothing [] FilePath
exe [FilePath]
args FilePath
inp
readProcessStderr :: Verbose => Maybe FilePath -> [(String, EnvOverride)]
-> FilePath -> [String] -> String -> IO String
readProcessStderr :: Maybe FilePath
-> [(FilePath, EnvOverride)]
-> FilePath
-> [FilePath]
-> FilePath
-> IO FilePath
readProcessStderr Maybe FilePath
mcwd [(FilePath, EnvOverride)]
env FilePath
exe [FilePath]
args FilePath
inp = do
Verbose =>
Maybe FilePath
-> [(FilePath, EnvOverride)] -> FilePath -> [FilePath] -> IO ()
Maybe FilePath
-> [(FilePath, EnvOverride)] -> FilePath -> [FilePath] -> IO ()
logProcessCall Maybe FilePath
mcwd [(FilePath, EnvOverride)]
env FilePath
exe [FilePath]
args
[(FilePath, FilePath)]
env' <- [(FilePath, EnvOverride)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
execEnvOverrides [(FilePath, EnvOverride)]
env ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(FilePath, FilePath)]
getEnvironment
FilePath
outp <- CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> [FilePath] -> CreateProcess
proc FilePath
exe [FilePath]
args)
{ cwd :: Maybe FilePath
cwd = Maybe FilePath
mcwd
, env :: Maybe [(FilePath, FilePath)]
env = if [(FilePath, EnvOverride)]
env [(FilePath, EnvOverride)] -> [(FilePath, EnvOverride)] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing else [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env'
} FilePath
inp
FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"=> "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
outp
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
outp
callProcessStderr'
:: Verbose => Maybe FilePath -> [(String, EnvOverride)]
-> FilePath -> [String] -> IO ExitCode
callProcessStderr' :: Maybe FilePath
-> [(FilePath, EnvOverride)]
-> FilePath
-> [FilePath]
-> IO ExitCode
callProcessStderr' Maybe FilePath
mcwd [(FilePath, EnvOverride)]
env FilePath
exe [FilePath]
args = do
Verbose =>
Maybe FilePath
-> [(FilePath, EnvOverride)] -> FilePath -> [FilePath] -> IO ()
Maybe FilePath
-> [(FilePath, EnvOverride)] -> FilePath -> [FilePath] -> IO ()
logProcessCall Maybe FilePath
mcwd [(FilePath, EnvOverride)]
env FilePath
exe [FilePath]
args
[(FilePath, FilePath)]
env' <- [(FilePath, EnvOverride)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
execEnvOverrides [(FilePath, EnvOverride)]
env ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(FilePath, FilePath)]
getEnvironment
(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
h) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (FilePath -> [FilePath] -> CreateProcess
proc FilePath
exe [FilePath]
args)
{ std_out :: StdStream
std_out = Handle -> StdStream
UseHandle Handle
stderr
, env :: Maybe [(FilePath, FilePath)]
env = if [(FilePath, EnvOverride)]
env [(FilePath, EnvOverride)] -> [(FilePath, EnvOverride)] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing else [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
env'
, cwd :: Maybe FilePath
cwd = Maybe FilePath
mcwd
}
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h
logProcessCall :: Verbose => Maybe FilePath -> [(String, EnvOverride)]
-> FilePath -> [String] -> IO ()
logProcessCall :: Maybe FilePath
-> [(FilePath, EnvOverride)] -> FilePath -> [FilePath] -> IO ()
logProcessCall Maybe FilePath
mcwd [(FilePath, EnvOverride)]
env FilePath
exe [FilePath]
args = do
FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, Verbose) => FilePath -> m ()
vLog (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
cd [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
env_args [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
formatProcessArg (FilePath
exeFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
args)
where
env_args :: [FilePath]
env_args = ((FilePath, EnvOverride) -> FilePath)
-> [(FilePath, EnvOverride)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
k,EnvOverride
v) -> FilePath
k FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ EnvOverride -> FilePath
forall a. Show a => a -> FilePath
show EnvOverride
v) [(FilePath, EnvOverride)]
env
cd :: [FilePath]
cd = case Maybe FilePath
mcwd of
Maybe FilePath
Nothing -> []; Just FilePath
cwd -> [ FilePath
"cd", FilePath -> FilePath
formatProcessArg FilePath
cwdFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
";" ]
execEnvOverride :: EnvOverride -> String -> Maybe String
execEnvOverride :: EnvOverride -> FilePath -> Maybe FilePath
execEnvOverride (EnvPrepend FilePath
x) FilePath
y = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
y)
execEnvOverride (EnvAppend FilePath
y) FilePath
x = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
y)
execEnvOverride (EnvSet FilePath
x) FilePath
_ = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
x
execEnvOverride EnvOverride
EnvUnset FilePath
_ = Maybe FilePath
forall a. Maybe a
Nothing
execEnvOverrides
:: [(String, EnvOverride)] -> [(String, String)] -> [(String, String)]
execEnvOverrides :: [(FilePath, EnvOverride)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
execEnvOverrides [(FilePath, EnvOverride)]
overrides [(FilePath, FilePath)]
env =
Map FilePath FilePath -> [(FilePath, FilePath)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map FilePath FilePath -> [(FilePath, FilePath)])
-> Map FilePath FilePath -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (Map FilePath FilePath
-> (FilePath, EnvOverride) -> Map FilePath FilePath)
-> Map FilePath FilePath
-> [(FilePath, EnvOverride)]
-> Map FilePath FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map FilePath FilePath
-> (FilePath, EnvOverride) -> Map FilePath FilePath
forall k.
Ord k =>
Map k FilePath -> (k, EnvOverride) -> Map k FilePath
f ([(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(FilePath, FilePath)]
env) [(FilePath, EnvOverride)]
overrides
where
f :: Map k FilePath -> (k, EnvOverride) -> Map k FilePath
f Map k FilePath
em (k
k, EnvOverride
o) = (Maybe FilePath -> Maybe FilePath)
-> k -> Map k FilePath -> Map k FilePath
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (EnvOverride -> FilePath -> Maybe FilePath
execEnvOverride EnvOverride
o (FilePath -> Maybe FilePath)
-> (Maybe FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"") k
k Map k FilePath
em
callProcessStderr :: Verbose => Maybe FilePath -> [(String, EnvOverride)]
-> FilePath -> [String] -> IO ()
callProcessStderr :: Maybe FilePath
-> [(FilePath, EnvOverride)] -> FilePath -> [FilePath] -> IO ()
callProcessStderr Maybe FilePath
mwd [(FilePath, EnvOverride)]
env FilePath
exe [FilePath]
args = do
ExitCode
rv <- Verbose =>
Maybe FilePath
-> [(FilePath, EnvOverride)]
-> FilePath
-> [FilePath]
-> IO ExitCode
Maybe FilePath
-> [(FilePath, EnvOverride)]
-> FilePath
-> [FilePath]
-> IO ExitCode
callProcessStderr' Maybe FilePath
mwd [(FilePath, EnvOverride)]
env FilePath
exe [FilePath]
args
case ExitCode
rv of
ExitCode
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure Int
v -> FilePath -> FilePath -> [FilePath] -> Int -> IO ()
forall a. FilePath -> FilePath -> [FilePath] -> Int -> IO a
processFailedException FilePath
"callProcessStderr" FilePath
exe [FilePath]
args Int
v
processFailedException :: String -> String -> [String] -> Int -> IO a
processFailedException :: FilePath -> FilePath -> [FilePath] -> Int -> IO a
processFailedException FilePath
fn FilePath
exe [FilePath]
args Int
rv =
IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
OtherError FilePath
msg Maybe Handle
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
where
msg :: FilePath
msg = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ FilePath
fn, FilePath
": ", FilePath
exe, FilePath
" "
, FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
formatProcessArg [FilePath]
args)
, FilePath
" (exit " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
rv FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
]
formatProcessArg :: String -> String
formatProcessArg :: FilePath -> FilePath
formatProcessArg FilePath
xs
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace FilePath
xs = FilePath
"'"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
xs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"
| Bool
otherwise = FilePath
xs