From 9570f59066c1e89500fcd8ab6ac6a401159ece27 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 9 Dec 2016 15:59:03 +0100 Subject: Process.pipeProcess: stream stderr rather than capturing. Signature of pipeProcess has changed: the return value is now IO (ExitCode, ByteString) -- with only stdout. Stderr is just inherited from the parent. This means that stderr from filters will now be streamed as the filters are run. Closes #2729. --- src/Text/Pandoc/PDF.hs | 20 +++++++------------- src/Text/Pandoc/Process.hs | 22 ++++++++-------------- 2 files changed, 15 insertions(+), 27 deletions(-) (limited to 'src') diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index 7aaa257fa..d1d1c803c 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -37,7 +37,7 @@ import qualified Data.ByteString as BS import Data.Monoid ((<>)) import System.Exit (ExitCode (..)) import System.FilePath -import System.IO (stderr, stdout) +import System.IO (stdout) import System.IO.Temp (withTempFile) import System.Directory import Data.Digest.Pure.SHA (showDigest, sha1) @@ -247,11 +247,10 @@ runTeXProgram verbose program args runNumber numRuns tmpDir source = do putStrLn $ "[makePDF] Contents of " ++ file' ++ ":" B.readFile file' >>= B.putStr putStr "\n" - (exit, out, err) <- pipeProcess (Just env'') program programArgs BL.empty + (exit, out) <- pipeProcess (Just env'') program programArgs BL.empty when verbose $ do putStrLn $ "[makePDF] Run #" ++ show runNumber B.hPutStr stdout out - B.hPutStr stderr err putStr "\n" if runNumber <= numRuns then runTeXProgram verbose program args (runNumber + 1) numRuns tmpDir source @@ -264,7 +263,7 @@ runTeXProgram verbose program args runNumber numRuns tmpDir source = do -- See https://github.com/jgm/pandoc/issues/1192. then (Just . B.fromChunks . (:[])) `fmap` BS.readFile pdfFile else return Nothing - return (exit, out <> err, pdf) + return (exit, out, pdf) html2pdf :: Bool -- ^ Verbose output -> [String] -- ^ Args to wkhtmltopdf @@ -286,12 +285,10 @@ html2pdf verbose args source = do putStrLn $ "[makePDF] Contents of " ++ file ++ ":" B.readFile file >>= B.putStr putStr "\n" - (exit, out, err) <- pipeProcess (Just env') "wkhtmltopdf" - programArgs BL.empty + (exit, out) <- pipeProcess (Just env') "wkhtmltopdf" programArgs BL.empty removeFile file when verbose $ do B.hPutStr stdout out - B.hPutStr stderr err putStr "\n" pdfExists <- doesFileExist pdfFile mbPdf <- if pdfExists @@ -303,9 +300,8 @@ html2pdf verbose args source = do removeFile pdfFile return res else return Nothing - let log' = out <> err return $ case (exit, mbPdf) of - (ExitFailure _, _) -> Left log' + (ExitFailure _, _) -> Left out (ExitSuccess, Nothing) -> Left "" (ExitSuccess, Just pdf) -> Right pdf @@ -341,10 +337,9 @@ context2pdf verbose tmpDir source = inDirectory tmpDir $ do putStrLn $ "[makePDF] Contents of " ++ file ++ ":" B.readFile file >>= B.putStr putStr "\n" - (exit, out, err) <- pipeProcess (Just env'') "context" programArgs BL.empty + (exit, out) <- pipeProcess (Just env'') "context" programArgs BL.empty when verbose $ do B.hPutStr stdout out - B.hPutStr stderr err putStr "\n" let pdfFile = replaceExtension file ".pdf" pdfExists <- doesFileExist pdfFile @@ -354,10 +349,9 @@ context2pdf verbose tmpDir source = inDirectory tmpDir $ do -- See https://github.com/jgm/pandoc/issues/1192. then (Just . B.fromChunks . (:[])) `fmap` BS.readFile pdfFile else return Nothing - let log' = out <> err case (exit, mbPdf) of (ExitFailure _, _) -> do - let logmsg = extractConTeXtMsg log' + let logmsg = extractConTeXtMsg out return $ Left logmsg (ExitSuccess, Nothing) -> return $ Left "" (ExitSuccess, Just pdf) -> return $ Right pdf diff --git a/src/Text/Pandoc/Process.hs b/src/Text/Pandoc/Process.hs index bc71f1392..294a38a1b 100644 --- a/src/Text/Pandoc/Process.hs +++ b/src/Text/Pandoc/Process.hs @@ -42,9 +42,9 @@ Version of 'System.Process.readProcessWithExitCode' that uses lazy bytestrings instead of strings and allows setting environment variables. @readProcessWithExitCode@ creates an external process, reads its -standard output and standard error strictly, waits until the process -terminates, and then returns the 'ExitCode' of the process, -the standard output, and the standard error. +standard output strictly, waits until the process +terminates, and then returns the 'ExitCode' of the process +and the standard output. stderr is inherited from the parent. If an asynchronous exception is thrown to the thread executing @readProcessWithExitCode@, the forked process will be terminated and @@ -57,25 +57,21 @@ pipeProcess -> FilePath -- ^ Filename of the executable (see 'proc' for details) -> [String] -- ^ any arguments -> BL.ByteString -- ^ standard input - -> IO (ExitCode,BL.ByteString,BL.ByteString) -- ^ exitcode, stdout, stderr + -> IO (ExitCode,BL.ByteString) -- ^ exitcode, stdout pipeProcess mbenv cmd args input = mask $ \restore -> do - (Just inh, Just outh, Just errh, pid) <- createProcess (proc cmd args) + (Just inh, Just outh, Nothing, pid) <- createProcess (proc cmd args) { env = mbenv, std_in = CreatePipe, std_out = CreatePipe, - std_err = CreatePipe } + std_err = Inherit } flip onException - (do hClose inh; hClose outh; hClose errh; + (do hClose inh; hClose outh; terminateProcess pid; waitForProcess pid) $ restore $ do -- fork off a thread to start consuming stdout out <- BL.hGetContents outh waitOut <- forkWait $ evaluate $ BL.length out - -- fork off a thread to start consuming stderr - err <- BL.hGetContents errh - waitErr <- forkWait $ evaluate $ BL.length err - -- now write and flush any input let writeInput = do unless (BL.null input) $ do @@ -87,15 +83,13 @@ pipeProcess mbenv cmd args input = -- wait on the output waitOut - waitErr hClose outh - hClose errh -- wait on the process ex <- waitForProcess pid - return (ex, out, err) + return (ex, out) forkWait :: IO a -> IO (IO a) forkWait a = do -- cgit v1.2.3