From ead04c65e06ed47a175624922582a33082585f6d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 29 May 2014 14:29:23 -0400 Subject: merge from git-annex --- src/Utility/Process.hs | 35 ++++++++++++----------------------- 1 file changed, 12 insertions(+), 23 deletions(-) (limited to 'src/Utility') diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs index 549ae570..cd3826d7 100644 --- a/src/Utility/Process.hs +++ b/src/Utility/Process.hs @@ -167,10 +167,10 @@ processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) processTranscript cmd opts input = processTranscript' cmd opts Nothing input processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool) +processTranscript' cmd opts environ input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} -processTranscript' cmd opts environ input = do (readf, writef) <- createPipe readh <- fdToHandle readf writeh <- fdToHandle writef @@ -184,24 +184,13 @@ processTranscript' cmd opts environ input = do hClose writeh get <- mkreader readh - - -- now write and flush any input - case input of - Just s -> do - let inh = stdinHandle p - unless (null s) $ do - hPutStr inh s - hFlush inh - hClose inh - Nothing -> return () - + writeinput input p transcript <- get ok <- checkSuccessProcess pid return (transcript, ok) #else {- This implementation for Windows puts stderr after stdout. -} -processTranscript' cmd opts environ input = do p@(_, _, _, pid) <- createProcess $ (proc cmd opts) { std_in = if isJust input then CreatePipe else Inherit @@ -212,17 +201,9 @@ processTranscript' cmd opts environ input = do getout <- mkreader (stdoutHandle p) geterr <- mkreader (stderrHandle p) - - case input of - Just s -> do - let inh = stdinHandle p - unless (null s) $ do - hPutStr inh s - hFlush inh - hClose inh - Nothing -> return () - + writeinput input p transcript <- (++) <$> getout <*> geterr + ok <- checkSuccessProcess pid return (transcript, ok) #endif @@ -237,6 +218,14 @@ processTranscript' cmd opts environ input = do takeMVar v return s + writeinput (Just s) p = do + let inh = stdinHandle p + unless (null s) $ do + hPutStr inh s + hFlush inh + hClose inh + writeinput Nothing _ = return () + {- Runs a CreateProcessRunner, on a CreateProcess structure, that - is adjusted to pipe only from/to a single StdHandle, and passes - the resulting Handle to an action. -} -- cgit v1.2.3