diff options
| -rw-r--r-- | lib/Distribution/Helper.hs | 13 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Process.hs | 35 |
2 files changed, 27 insertions, 21 deletions
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs index 79c9d57..8ce5f94 100644 --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -209,16 +209,9 @@ mkQueryEnv projloc distdir = do cr <- newIORef $ QueryCache Nothing Map.empty return $ QueryEnv { qeReadProcess = \stdin mcwd env exe args -> do - env' <- execEnvOverrides env - let cp = (proc exe args) - { cwd = mcwd - , env = if env == [] then Nothing else Just env' - } - readCreateProcess cp stdin - , qeCallProcess = \mcwd env exe args -> do - let ?verbose = \_ -> False -- TODO: we should get this from env or - -- something - callProcessStderr mcwd env exe args + withVerbosity $ readProcessStderr mcwd env exe args "" + , qeCallProcess = \mcwd env exe args -> + withVerbosity $ callProcessStderr mcwd env exe args , qePrograms = defaultPrograms , qeProjLoc = projloc , qeDistDir = distdir diff --git a/src/CabalHelper/Compiletime/Process.hs b/src/CabalHelper/Compiletime/Process.hs index 948d455..34404ab 100644 --- a/src/CabalHelper/Compiletime/Process.hs +++ b/src/CabalHelper/Compiletime/Process.hs @@ -40,32 +40,45 @@ import CabalHelper.Compiletime.Types import CabalHelper.Compiletime.Log readProcess' :: Verbose => FilePath -> [String] -> String -> IO String -readProcess' exe args inp = do - vLog $ intercalate " " $ map formatProcessArg (exe:args) - outp <- readProcess exe args inp +readProcess' exe args inp = + readProcessStderr Nothing [] exe args inp + +readProcessStderr :: Verbose => Maybe FilePath -> [(String, EnvOverride)] + -> FilePath -> [String] -> String -> IO String +readProcessStderr mcwd env exe args inp = do + logProcessCall mcwd env exe args + env' <- execEnvOverrides env + outp <- readCreateProcess (proc exe args) + { cwd = mcwd + , env = if env == [] then Nothing else Just env' + } inp vLog $ unlines $ map ("=> "++) $ lines outp return outp - -- | Essentially 'System.Process.callProcess' but returns exit code, has -- additional options and logging to stderr when verbosity is enabled. callProcessStderr' :: Verbose => Maybe FilePath -> [(String, EnvOverride)] -> FilePath -> [String] -> IO ExitCode -callProcessStderr' mwd env exe args = do - let cd = case mwd of - Nothing -> []; Just wd -> [ "cd", formatProcessArg wd++";" ] - vLog $ intercalate " " $ - cd ++ map formatProcessArg (map (\(k,v) -> k ++ "=" ++ show v) env ++ exe:args) - +callProcessStderr' mcwd env exe args = do + logProcessCall mcwd env exe args env' <- execEnvOverrides env (_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr , env = if env == [] then Nothing else Just env' - , cwd = mwd + , cwd = mcwd } waitForProcess h +logProcessCall :: Verbose => Maybe FilePath -> [(String, EnvOverride)] + -> FilePath -> [String] -> IO () +logProcessCall mcwd env exe args = do + vLog $ intercalate " " $ cd ++ env_args ++ map formatProcessArg (exe:args) + where + env_args = map (\(k,v) -> k ++ "=" ++ show v) env + cd = case mcwd of + Nothing -> []; Just cwd -> [ "cd", formatProcessArg cwd++";" ] + execEnvOverride :: EnvOverride -> String -> String execEnvOverride (EnvPrepend x) y = x ++ y execEnvOverride (EnvAppend y) x = x ++ y |