aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-03-06 20:07:38 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-03-06 20:09:05 -0400
commit9323cf08529894b5e5030fb6f51b90f97cc33d48 (patch)
tree7d714983ecf574b2d40caeb1949a9e34409f593d
parent7ddf8b2408b9f3c4900a13c4b9d47420005c8090 (diff)
merge from propellor
-rw-r--r--Utility/Process.hs13
1 files changed, 7 insertions, 6 deletions
diff --git a/Utility/Process.hs b/Utility/Process.hs
index e12b9700e..ed02f49e5 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -18,6 +18,7 @@ module Utility.Process (
readProcessEnv,
writeReadProcessEnv,
forceSuccessProcess,
+ forceSuccessProcess',
checkSuccessProcess,
ignoreFailureProcess,
createProcessSuccess,
@@ -129,12 +130,12 @@ writeReadProcessEnv cmd args environ writestdin adjusthandle = do
-- | Waits for a ProcessHandle, and throws an IOError if the process
-- did not exit successfully.
forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()
-forceSuccessProcess p pid = do
- code <- waitForProcess pid
- case code of
- ExitSuccess -> return ()
- ExitFailure n -> ioError $ userError $
- showCmd p ++ " exited " ++ show n
+forceSuccessProcess p pid = waitForProcess pid >>= forceSuccessProcess' p
+
+forceSuccessProcess' :: CreateProcess -> ExitCode -> IO ()
+forceSuccessProcess' _ ExitSuccess = return ()
+forceSuccessProcess' p (ExitFailure n) = fail $
+ showCmd p ++ " exited " ++ show n
-- | Waits for a ProcessHandle and returns True if it exited successfully.
-- Note that using this with createProcessChecked will throw away