diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/ProcessUtils.hs | 49 |
1 files changed, 48 insertions, 1 deletions
diff --git a/lib/ProcessUtils.hs b/lib/ProcessUtils.hs index a6902be..492d666 100644 --- a/lib/ProcessUtils.hs +++ b/lib/ProcessUtils.hs | |||
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE CPP #-} | 1 | {-# LANGUAGE CPP #-} |
2 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | module ProcessUtils | 3 | module ProcessUtils |
3 | ( ExitCode(ExitFailure,ExitSuccess) | 4 | ( ExitCode(ExitFailure,ExitSuccess) |
4 | , systemEnv | 5 | , systemEnv |
@@ -7,16 +8,19 @@ module ProcessUtils | |||
7 | ) where | 8 | ) where |
8 | 9 | ||
9 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) | 10 | import GHC.IO.Exception ( ioException, IOErrorType(..) ) |
11 | import System.FilePath | ||
12 | import System.Directory | ||
10 | import System.Process | 13 | import System.Process |
11 | import System.Posix.Signals | 14 | import System.Posix.Signals |
12 | import System.Process.Internals (runGenProcess_,defaultSignal) | 15 | import System.Process.Internals (runGenProcess_,defaultSignal) |
13 | import System.Environment | 16 | import System.Environment |
14 | import Data.Maybe ( isNothing ) | 17 | import Data.Maybe ( isNothing, fromMaybe ) |
15 | import System.IO.Error ( mkIOError, ioeSetErrorString ) | 18 | import System.IO.Error ( mkIOError, ioeSetErrorString ) |
16 | import System.Exit ( ExitCode(..) ) | 19 | import System.Exit ( ExitCode(..) ) |
17 | import System.IO | 20 | import System.IO |
18 | import Control.Applicative | 21 | import Control.Applicative |
19 | import Control.Exception (bracket) | 22 | import Control.Exception (bracket) |
23 | import qualified Data.ByteString as S | ||
20 | 24 | ||
21 | 25 | ||
22 | -- | systemEnv | 26 | -- | systemEnv |
@@ -102,3 +106,46 @@ readProcessWithErrorH cmd args stdin erH = do | |||
102 | hPutStr sinh stdin | 106 | hPutStr sinh stdin |
103 | hClose sinh | 107 | hClose sinh |
104 | hGetContents sout ) | 108 | hGetContents sout ) |
109 | |||
110 | -- | run an external command. | ||
111 | -- | ||
112 | -- Arguments: | ||
113 | -- | ||
114 | -- [ cmd ] command to run | ||
115 | -- | ||
116 | -- [ input ] input to command (if any) | ||
117 | -- | ||
118 | -- Returns: | ||
119 | -- | ||
120 | -- [ code ] exit code returned by command | ||
121 | -- | ||
122 | -- [ output ] captured stdout of command | ||
123 | -- | ||
124 | -- [ err ] captured stderr of command | ||
125 | runExternal :: String -> Maybe String -> IO (Int,(S.ByteString,S.ByteString)) | ||
126 | runExternal cmd input = do | ||
127 | cwd <- getCurrentDirectory | ||
128 | putStr $ takeFileName cwd ++ "> " ++ cmd | ||
129 | ++ case input of | ||
130 | Nothing -> "\n" | ||
131 | Just s -> " <<EOF\n" ++ s ++ "EOF\n" | ||
132 | let p = (shell cmd) { std_in = maybe Inherit (const CreatePipe) input | ||
133 | , std_out = CreatePipe | ||
134 | , std_err = CreatePipe } | ||
135 | (mb_in,mb_out,mb_err,process) <- createProcess p | ||
136 | case mb_in of | ||
137 | Nothing -> return () | ||
138 | Just hin -> hPutStr hin (fromMaybe "" input) >> hClose hin | ||
139 | out <- case mb_out of | ||
140 | Just hout -> S.hGetContents hout | ||
141 | Nothing -> return "" | ||
142 | err <- case mb_err of | ||
143 | Just herr -> S.hGetContents herr | ||
144 | Nothing -> return "" | ||
145 | code <- do | ||
146 | c <- waitForProcess process | ||
147 | return $ case c of | ||
148 | ExitSuccess -> 0 | ||
149 | ExitFailure x -> x | ||
150 | return (code,(out,err)) | ||
151 | |||