summaryrefslogtreecommitdiff
path: root/src/System
diff options
context:
space:
mode:
authorJoey Hess2016-03-06 15:45:54 -0400
committerJoey Hess2016-03-06 15:46:27 -0400
commit30f91cb5490f9cf40e5570e061c4bfedb1ae2ee4 (patch)
tree097e152c6cd9a38fc6bd0a4709421fc4be83a02a /src/System
parente01349e3100bb7a2c6cd13594f9ac56beb6b793d (diff)
debugging
Diffstat (limited to 'src/System')
-rw-r--r--src/System/Console/Concurrent/Internal.hs13
1 files changed, 13 insertions, 0 deletions
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
index 985bc130..5b9cf454 100644
--- a/src/System/Console/Concurrent/Internal.hs
+++ b/src/System/Console/Concurrent/Internal.hs
@@ -31,6 +31,7 @@ import qualified Data.Text as T
import qualified Data.Text.IO as T
import Control.Applicative
import Prelude
+import System.Log.Logger
import Utility.Monad
import Utility.Exception
@@ -286,18 +287,30 @@ fgProcess p = do
r@(_, _, _, h) <- P.createProcess p
`onException` dropOutputLock
registerOutputThread
+ debug ["fgProcess", showProc p]
-- Wait for the process to exit and drop the lock.
asyncProcessWaiter $ do
void $ tryIO $ P.waitForProcess h
unregisterOutputThread
dropOutputLock
+ debug ["fgProcess done", showProc p]
return (toConcurrentProcessHandle r)
+
+debug :: [String] -> IO ()
+debug = debugM "concurrent-output" . unwords
+
+showProc :: P.CreateProcess -> String
+showProc = go . P.cmdspec
+ where
+ go (P.ShellCommand s) = s
+ go (P.RawCommand c ps) = show (c, ps)
#ifndef mingw32_HOST_OS
bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
bgProcess p = do
(toouth, fromouth) <- pipe
(toerrh, fromerrh) <- pipe
+ debug ["bgProcess", showProc p]
let p' = p
{ P.std_out = rediroutput (P.std_out p) toouth
, P.std_err = rediroutput (P.std_err p) toerrh