From 4125916b67126a0cf17fe5b382a1f37cceec2760 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 13 Sep 2015 13:39:18 -0400 Subject: merge from git-annex --- src/Utility/Process.hs | 40 +++++++++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 15 deletions(-) (limited to 'src/Utility/Process.hs') diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs index bd179d09..c4882a01 100644 --- a/src/Utility/Process.hs +++ b/src/Utility/Process.hs @@ -31,6 +31,7 @@ module Utility.Process ( withQuietOutput, feedWithQuietOutput, createProcess, + waitForProcess, startInteractiveProcess, stdinHandle, stdoutHandle, @@ -42,7 +43,7 @@ module Utility.Process ( import qualified System.Process import qualified System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess) -import System.Process hiding (createProcess, readProcess) +import System.Process hiding (createProcess, readProcess, waitForProcess) import System.Exit import System.IO import System.Log.Logger @@ -345,18 +346,6 @@ oeHandles _ = error "expected oeHandles" processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle processHandle (_, _, _, pid) = pid --- | Debugging trace for a CreateProcess. -debugProcess :: CreateProcess -> IO () -debugProcess p = debugM "Utility.Process" $ unwords [action ++ ":", showCmd p] - where - action - | piped (std_in p) && piped (std_out p) = "chat" - | piped (std_in p) = "feed" - | piped (std_out p) = "read" - | otherwise = "call" - piped Inherit = False - piped _ = True - -- | Shows the command that a CreateProcess will run. showCmd :: CreateProcess -> String showCmd = go . cmdspec @@ -381,9 +370,30 @@ startInteractiveProcess cmd args environ = do (Just from, Just to, _, pid) <- createProcess p return (pid, to, from) --- | Wrapper around 'System.Process.createProcess' from System.Process, --- that does debug logging. +-- | Wrapper around 'System.Process.createProcess' that does debug logging. createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess p = do debugProcess p System.Process.createProcess p + +-- | Debugging trace for a CreateProcess. +debugProcess :: CreateProcess -> IO () +debugProcess p = debugM "Utility.Process" $ unwords + [ action ++ ":" + , showCmd p + ] + where + action + | piped (std_in p) && piped (std_out p) = "chat" + | piped (std_in p) = "feed" + | piped (std_out p) = "read" + | otherwise = "call" + piped Inherit = False + piped _ = True + +-- | Wrapper around 'System.Process.waitForProcess' that does debug logging. +waitForProcess :: ProcessHandle -> IO ExitCode +waitForProcess h = do + r <- System.Process.waitForProcess h + debugM "Utility.Process" ("process done " ++ show r) + return r -- cgit v1.2.3