From 30f91cb5490f9cf40e5570e061c4bfedb1ae2ee4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 6 Mar 2016 15:45:54 -0400 Subject: debugging --- src/System/Console/Concurrent/Internal.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'src/System/Console/Concurrent/Internal.hs') 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 -- cgit v1.2.3