diff options
Diffstat (limited to 'ProcessUtils.hs')
-rw-r--r-- | ProcessUtils.hs | 45 |
1 files changed, 0 insertions, 45 deletions
diff --git a/ProcessUtils.hs b/ProcessUtils.hs deleted file mode 100644 index 4e3ac38..0000000 --- a/ProcessUtils.hs +++ /dev/null | |||
@@ -1,45 +0,0 @@ | |||
1 | module ProcessUtils | ||
2 | ( ExitCode(ExitFailure,ExitSuccess) | ||
3 | , systemEnv | ||
4 | ) where | ||
5 | |||
6 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) | ||
7 | import System.Process | ||
8 | import System.Posix.Signals | ||
9 | import System.Process.Internals (runGenProcess_,defaultSignal) | ||
10 | import System.Environment | ||
11 | import Data.Maybe ( isNothing ) | ||
12 | import System.IO.Error ( mkIOError, ioeSetErrorString ) | ||
13 | import System.Exit ( ExitCode(..) ) | ||
14 | |||
15 | |||
16 | -- | systemEnv | ||
17 | -- This is like System.Process.system except that it lets you set | ||
18 | -- some environment variables. | ||
19 | systemEnv :: [(String, String)] -> String -> IO ExitCode | ||
20 | systemEnv _ "" = | ||
21 | ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command") | ||
22 | systemEnv vars cmd = do | ||
23 | env0 <- getEnvironment | ||
24 | let env1 = filter (isNothing . flip lookup vars . fst) env0 | ||
25 | env = vars ++ env1 | ||
26 | syncProcess "system" $ (shell cmd) {env=Just env} | ||
27 | where | ||
28 | -- This is a non-exported function from System.Process | ||
29 | syncProcess fun c = do | ||
30 | -- The POSIX version of system needs to do some manipulation of signal | ||
31 | -- handlers. Since we're going to be synchronously waiting for the child, | ||
32 | -- we want to ignore ^C in the parent, but handle it the default way | ||
33 | -- in the child (using SIG_DFL isn't really correct, it should be the | ||
34 | -- original signal handler, but the GHC RTS will have already set up | ||
35 | -- its own handler and we don't want to use that). | ||
36 | old_int <- installHandler sigINT Ignore Nothing | ||
37 | old_quit <- installHandler sigQUIT Ignore Nothing | ||
38 | (_,_,_,p) <- runGenProcess_ fun c | ||
39 | (Just defaultSignal) (Just defaultSignal) | ||
40 | r <- waitForProcess p | ||
41 | _ <- installHandler sigINT old_int Nothing | ||
42 | _ <- installHandler sigQUIT old_quit Nothing | ||
43 | return r | ||
44 | |||
45 | |||