summaryrefslogtreecommitdiff
path: root/ProcessUtils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'ProcessUtils.hs')
-rw-r--r--ProcessUtils.hs45
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 @@
1module ProcessUtils
2 ( ExitCode(ExitFailure,ExitSuccess)
3 , systemEnv
4 ) where
5
6import GHC.IO.Exception ( ioException, IOErrorType(..) )
7import System.Process
8import System.Posix.Signals
9import System.Process.Internals (runGenProcess_,defaultSignal)
10import System.Environment
11import Data.Maybe ( isNothing )
12import System.IO.Error ( mkIOError, ioeSetErrorString )
13import System.Exit ( ExitCode(..) )
14
15
16-- | systemEnv
17-- This is like System.Process.system except that it lets you set
18-- some environment variables.
19systemEnv :: [(String, String)] -> String -> IO ExitCode
20systemEnv _ "" =
21 ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command")
22systemEnv 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