Show command and arguments for spawned processes in outputHEADmaster

Changelog: Show command and arguments for spawned processes in verbose output

3 files changed, 12 insertions, 4 deletions

diff --git a/src/Output.hs b/src/Output.hs
index b91bbdd..ca79dab 100644
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -53,6 +53,7 @@ data OutputType
     = OutputChildStdout
     | OutputChildStderr
     | OutputChildStdin
+    | OutputChildExec
     | OutputChildInfo
     | OutputChildFail
     | OutputMatch
@@ -83,6 +84,7 @@ outColor :: OutputType -> Text
 outColor OutputChildStdout = T.pack "0"
 outColor OutputChildStderr = T.pack "31"
 outColor OutputChildStdin = T.pack "0"
+outColor OutputChildExec = T.pack "33"
 outColor OutputChildInfo = T.pack "0"
 outColor OutputChildFail = T.pack "31"
 outColor OutputMatch = T.pack "32"
@@ -95,6 +97,7 @@ outSign :: OutputType -> Text
 outSign OutputChildStdout = " "
 outSign OutputChildStderr = T.pack "!"
 outSign OutputChildStdin = T.empty
+outSign OutputChildExec = "*"
 outSign OutputChildInfo = T.pack "."
 outSign OutputChildFail = T.pack "!!"
 outSign OutputMatch = T.pack "+"
@@ -112,6 +115,7 @@ outTestLabel = \case
     OutputChildStdout -> "child-stdout"
     OutputChildStderr -> "child-stderr"
     OutputChildStdin -> "child-stdin"
+    OutputChildExec -> "child-exec"
     OutputChildInfo -> "child-info"
     OutputChildFail -> "child-fail"
     OutputMatch -> "match"
diff --git a/src/Process.hs b/src/Process.hs
index 1389987..a575e76 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -3,7 +3,7 @@ module Process (
     ProcName(..),
     textProcName, unpackProcName,
     send,
-    outProc,
+    outProc, outProcName,
     lineReadingLoop,
     startProcessIOLoops,
     spawnOn,
@@ -88,7 +88,10 @@ send p line = liftIO $ do
     hFlush (procStdin p)
 
 outProc :: MonadOutput m => OutputType -> Process -> Text -> m ()
-outProc otype p line = outLine otype (Just $ textProcName $ procName p) line
+outProc otype p line = outProcName otype (procName p) line
+
+outProcName :: MonadOutput m => OutputType -> ProcName -> Text -> m ()
+outProcName otype pname line = outLine otype (Just $ textProcName pname) line
 
 lineReadingLoop :: MonadOutput m => Process -> Handle -> (Text -> m ()) -> m ()
 lineReadingLoop process h act =
diff --git a/src/Run.hs b/src/Run.hs
index 1a1dea0..436ce6b 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -188,9 +188,10 @@ runStep = \case
             opts <- asks $ teOptions . fst
             let pname = ProcName tname
                 tool = fromMaybe (optDefaultTool opts) (lookup pname $ optProcTools opts)
-                cmd = unwords $ tool : map (T.unpack . escape) args
+                cmd = T.unwords $ T.pack tool : map escape args
                 escape = ("'" <>) . (<> "'") . T.replace "'" "'\\''"
-            withProcess (Right node) pname Nothing cmd $ runStep . inner
+            outProcName OutputChildExec pname cmd
+            withProcess (Right node) pname Nothing (T.unpack cmd) $ runStep . inner
 
     SpawnShell mbname node script inner -> do
         let tname | Just (TypedVarName (VarName name)) <- mbname = name