simplify
This was a pre-withCreateProcess attempt at doing the same thing, so can just call boolSystem now that it uses withCreateProcess. There's a slight behavior change, since it used to wait, after an async exception, for the command to finish, before re-throwing the exception. Now, it rethrows the exception right away. I don't think that impact any of the users of this.
This commit is contained in:
parent
e1fc4f7594
commit
53263efe4b
1 changed files with 3 additions and 17 deletions
|
@ -1,6 +1,6 @@
|
|||
{- Running a long or expensive batch operation niced.
|
||||
-
|
||||
- Copyright 2013 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- License: BSD-2-clause
|
||||
-}
|
||||
|
@ -22,7 +22,6 @@ import Common
|
|||
import Control.Concurrent.Async
|
||||
import System.Posix.Process
|
||||
#endif
|
||||
import qualified Control.Exception as E
|
||||
|
||||
{- Runs an operation, at batch priority.
|
||||
-
|
||||
|
@ -75,11 +74,7 @@ toBatchCommand v = do
|
|||
return $ batchmaker v
|
||||
|
||||
{- Runs a command in a way that's suitable for batch jobs that can be
|
||||
- interrupted.
|
||||
-
|
||||
- If the calling thread receives an async exception, it sends the
|
||||
- command a SIGTERM, and after the command finishes shuttting down,
|
||||
- it re-raises the async exception. -}
|
||||
- interrupted. -}
|
||||
batchCommand :: String -> [CommandParam] -> IO Bool
|
||||
batchCommand command params = batchCommandEnv command params Nothing
|
||||
|
||||
|
@ -87,13 +82,4 @@ batchCommandEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bo
|
|||
batchCommandEnv command params environ = do
|
||||
batchmaker <- getBatchCommandMaker
|
||||
let (command', params') = batchmaker (command, params)
|
||||
let p = proc command' $ toCommand params'
|
||||
(_, _, _, pid) <- createProcess $ p { env = environ }
|
||||
r <- E.try (waitForProcess pid) :: IO (Either E.SomeException ExitCode)
|
||||
case r of
|
||||
Right ExitSuccess -> return True
|
||||
Right _ -> return False
|
||||
Left asyncexception -> do
|
||||
terminateProcess pid
|
||||
void $ waitForProcess pid
|
||||
E.throwIO asyncexception
|
||||
boolSystemEnv command' params' environ
|
||||
|
|
Loading…
Reference in a new issue