Add verbose logging support for readProcess calls

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