add debug logging of process exits
This is mostly to be able to see how long a command took to run. Also exit code may be useful. Unofrtunately, I can't put the command name in there, because it's not available at this point, and it would be a much larger change to wrap the ProcessHandle data type to add that. However, it's generally pretty obvious which process exited from context.
This commit is contained in:
parent
7584e47ba3
commit
4665fc9e84
1 changed files with 26 additions and 19 deletions
|
@ -31,6 +31,7 @@ module Utility.Process (
|
||||||
withQuietOutput,
|
withQuietOutput,
|
||||||
feedWithQuietOutput,
|
feedWithQuietOutput,
|
||||||
createProcess,
|
createProcess,
|
||||||
|
waitForProcess,
|
||||||
startInteractiveProcess,
|
startInteractiveProcess,
|
||||||
stdinHandle,
|
stdinHandle,
|
||||||
stdoutHandle,
|
stdoutHandle,
|
||||||
|
@ -42,7 +43,7 @@ module Utility.Process (
|
||||||
|
|
||||||
import qualified System.Process
|
import qualified System.Process
|
||||||
import qualified System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
|
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.Exit
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Log.Logger
|
import System.Log.Logger
|
||||||
|
@ -345,22 +346,6 @@ oeHandles _ = error "expected oeHandles"
|
||||||
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
|
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
|
||||||
processHandle (_, _, _, pid) = pid
|
processHandle (_, _, _, pid) = pid
|
||||||
|
|
||||||
-- | Debugging trace for a CreateProcess.
|
|
||||||
debugProcess :: CreateProcess -> IO ()
|
|
||||||
debugProcess p = do
|
|
||||||
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.
|
-- | Shows the command that a CreateProcess will run.
|
||||||
showCmd :: CreateProcess -> String
|
showCmd :: CreateProcess -> String
|
||||||
showCmd = go . cmdspec
|
showCmd = go . cmdspec
|
||||||
|
@ -385,9 +370,31 @@ startInteractiveProcess cmd args environ = do
|
||||||
(Just from, Just to, _, pid) <- createProcess p
|
(Just from, Just to, _, pid) <- createProcess p
|
||||||
return (pid, to, from)
|
return (pid, to, from)
|
||||||
|
|
||||||
-- | Wrapper around 'System.Process.createProcess' from System.Process,
|
-- | Wrapper around 'System.Process.createProcess' that does debug logging.
|
||||||
-- that does debug logging.
|
|
||||||
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
|
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
|
||||||
createProcess p = do
|
createProcess p = do
|
||||||
debugProcess p
|
debugProcess p
|
||||||
System.Process.createProcess p
|
System.Process.createProcess p
|
||||||
|
|
||||||
|
-- | Debugging trace for a CreateProcess.
|
||||||
|
debugProcess :: CreateProcess -> IO ()
|
||||||
|
debugProcess p = do
|
||||||
|
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
|
||||||
|
|
Loading…
Reference in a new issue