diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-02-15 16:00:59 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-02-15 16:02:10 -0400 |
commit | 0d66a45d49fd2983e5193312523afb96f34f8b76 (patch) | |
tree | b476cea451269a5781ac2265b67746bf559d56c4 | |
parent | 6892102ea2ef394de2a9802aa36dfe19761f37dd (diff) |
simpler more generic processTranscript'
This allows using functions that generate CreateProcess and passing the
result to processTranscript', which is more flexible, and also simpler
than the old interface.
This commit was sponsored by Riku Voipio.
-rw-r--r-- | Build/EvilLinker.hs | 2 | ||||
-rw-r--r-- | Utility/Process.hs | 28 |
2 files changed, 14 insertions, 16 deletions
diff --git a/Build/EvilLinker.hs b/Build/EvilLinker.hs index 94e399dfe..47111d476 100644 --- a/Build/EvilLinker.hs +++ b/Build/EvilLinker.hs @@ -127,7 +127,7 @@ getOutput c ps environ = do putStrLn $ unwords [c, show ps] systemenviron <- getEnvironment let environ' = fromMaybe [] environ ++ systemenviron - out@(_, ok) <- processTranscript' (\p -> p { Utility.Process.env = Just environ' }) c ps Nothing + out@(_, ok) <- processTranscript' ((proc c ps) { Utility.Process.env = Just environ' }) Nothing putStrLn $ unwords [c, "finished", show ok] return out diff --git a/Utility/Process.hs b/Utility/Process.hs index ed02f49e5..6d981cb51 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -174,22 +174,21 @@ createBackgroundProcess p a = a =<< createProcess p -- returns a transcript combining its stdout and stderr, and -- whether it succeeded or failed. processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) -processTranscript = processTranscript' id +processTranscript cmd opts = processTranscript' (proc cmd opts) -processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool) -processTranscript' modproc cmd opts input = do +processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool) +processTranscript' cp input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} (readf, writef) <- System.Posix.IO.createPipe readh <- System.Posix.IO.fdToHandle readf writeh <- System.Posix.IO.fdToHandle writef - p@(_, _, _, pid) <- createProcess $ modproc $ - (proc cmd opts) - { std_in = if isJust input then CreatePipe else Inherit - , std_out = UseHandle writeh - , std_err = UseHandle writeh - } + p@(_, _, _, pid) <- createProcess $ cp + { std_in = if isJust input then CreatePipe else Inherit + , std_out = UseHandle writeh + , std_err = UseHandle writeh + } hClose writeh get <- mkreader readh @@ -200,12 +199,11 @@ processTranscript' modproc cmd opts input = do return (transcript, ok) #else {- This implementation for Windows puts stderr after stdout. -} - p@(_, _, _, pid) <- createProcess $ modproc $ - (proc cmd opts) - { std_in = if isJust input then CreatePipe else Inherit - , std_out = CreatePipe - , std_err = CreatePipe - } + p@(_, _, _, pid) <- createProcess $ cp + { std_in = if isJust input then CreatePipe else Inherit + , std_out = CreatePipe + , std_err = CreatePipe + } getout <- mkreader (stdoutHandle p) geterr <- mkreader (stderrHandle p) |