diff options
Diffstat (limited to 'Utility/Process/Transcript.hs')
| -rw-r--r-- | Utility/Process/Transcript.hs | 22 |
1 files changed, 12 insertions, 10 deletions
diff --git a/Utility/Process/Transcript.hs b/Utility/Process/Transcript.hs index 0dbe428f7..0dbbd443a 100644 --- a/Utility/Process/Transcript.hs +++ b/Utility/Process/Transcript.hs @@ -1,6 +1,6 @@ {- Process transcript - - - Copyright 2012-2015 Joey Hess <id@joeyh.name> + - Copyright 2012-2018 Joey Hess <id@joeyh.name> - - License: BSD-2-clause -} @@ -13,6 +13,7 @@ module Utility.Process.Transcript where import Utility.Process import System.IO +import System.Exit import Control.Concurrent import qualified Control.Exception as E import Control.Monad @@ -24,14 +25,19 @@ import Control.Applicative import Data.Maybe import Prelude --- | Runs a process, optionally feeding it some input, and --- returns a transcript combining its stdout and stderr, and --- whether it succeeded or failed. +-- | Runs a process and returns a transcript combining its stdout and +-- stderr, and whether it succeeded or failed. processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) processTranscript cmd opts = processTranscript' (proc cmd opts) +-- | Also feeds the process some input. processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool) processTranscript' cp input = do + (t, c) <- processTranscript'' cp input + return (t, c == ExitSuccess) + +processTranscript'' :: CreateProcess -> Maybe String -> IO (String, ExitCode) +processTranscript'' cp input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} @@ -48,9 +54,6 @@ processTranscript' cp input = do get <- mkreader readh writeinput input p transcript <- get - - ok <- checkSuccessProcess pid - return (transcript, ok) #else {- This implementation for Windows puts stderr after stdout. -} p@(_, _, _, pid) <- createProcess $ cp @@ -63,10 +66,9 @@ processTranscript' cp input = do geterr <- mkreader (stderrHandle p) writeinput input p transcript <- (++) <$> getout <*> geterr - - ok <- checkSuccessProcess pid - return (transcript, ok) #endif + code <- waitForProcess pid + return (transcript, code) where mkreader h = do s <- hGetContents h |