summaryrefslogtreecommitdiff
path: root/src/Utility/Process.hs
diff options
context:
space:
mode:
authorJoey Hess2015-09-13 13:39:18 -0400
committerJoey Hess2015-09-13 13:39:31 -0400
commit4125916b67126a0cf17fe5b382a1f37cceec2760 (patch)
treef9128e91a5eef2819676ba14a247667c4fa1d8bd /src/Utility/Process.hs
parentf256b24aa87409a599b388f0a7848aa9abecaa7f (diff)
merge from git-annex
Diffstat (limited to 'src/Utility/Process.hs')
-rw-r--r--src/Utility/Process.hs40
1 files changed, 25 insertions, 15 deletions
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