From fbf425fbef1c1e60fcdddfbd9b25976162725f97 Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 24 Apr 2016 18:43:00 -0400 Subject: Refactored build of executable and library. --- lib/ProcessUtils.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 lib/ProcessUtils.hs (limited to 'lib/ProcessUtils.hs') diff --git a/lib/ProcessUtils.hs b/lib/ProcessUtils.hs new file mode 100644 index 0000000..4e3ac38 --- /dev/null +++ b/lib/ProcessUtils.hs @@ -0,0 +1,45 @@ +module ProcessUtils + ( ExitCode(ExitFailure,ExitSuccess) + , systemEnv + ) where + +import GHC.IO.Exception ( ioException, IOErrorType(..) ) +import System.Process +import System.Posix.Signals +import System.Process.Internals (runGenProcess_,defaultSignal) +import System.Environment +import Data.Maybe ( isNothing ) +import System.IO.Error ( mkIOError, ioeSetErrorString ) +import System.Exit ( ExitCode(..) ) + + +-- | systemEnv +-- This is like System.Process.system except that it lets you set +-- some environment variables. +systemEnv :: [(String, String)] -> String -> IO ExitCode +systemEnv _ "" = + ioException (ioeSetErrorString (mkIOError InvalidArgument "system" Nothing Nothing) "null command") +systemEnv vars cmd = do + env0 <- getEnvironment + let env1 = filter (isNothing . flip lookup vars . fst) env0 + env = vars ++ env1 + syncProcess "system" $ (shell cmd) {env=Just env} + where + -- This is a non-exported function from System.Process + syncProcess fun c = do + -- The POSIX version of system needs to do some manipulation of signal + -- handlers. Since we're going to be synchronously waiting for the child, + -- we want to ignore ^C in the parent, but handle it the default way + -- in the child (using SIG_DFL isn't really correct, it should be the + -- original signal handler, but the GHC RTS will have already set up + -- its own handler and we don't want to use that). + old_int <- installHandler sigINT Ignore Nothing + old_quit <- installHandler sigQUIT Ignore Nothing + (_,_,_,p) <- runGenProcess_ fun c + (Just defaultSignal) (Just defaultSignal) + r <- waitForProcess p + _ <- installHandler sigINT old_int Nothing + _ <- installHandler sigQUIT old_quit Nothing + return r + + -- cgit v1.2.3