diff options
Diffstat (limited to 'src/Text/Pandoc/Process.hs')
| -rw-r--r-- | src/Text/Pandoc/Process.hs | 34 |
1 files changed, 14 insertions, 20 deletions
diff --git a/src/Text/Pandoc/Process.hs b/src/Text/Pandoc/Process.hs index bc71f1392..27807a8c8 100644 --- a/src/Text/Pandoc/Process.hs +++ b/src/Text/Pandoc/Process.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2013-2016 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2013-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Process - Copyright : Copyright (C) 2013-2016 John MacFarlane + Copyright : Copyright (C) 2013-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -29,22 +29,22 @@ ByteString variant of 'readProcessWithExitCode'. -} module Text.Pandoc.Process (pipeProcess) where -import System.Process -import System.Exit (ExitCode (..)) +import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar) import Control.Exception -import System.IO (hClose, hFlush) -import Control.Concurrent (putMVar, takeMVar, newEmptyMVar, forkIO) import Control.Monad (unless) import qualified Data.ByteString.Lazy as BL +import System.Exit (ExitCode (..)) +import System.IO (hClose, hFlush) +import System.Process {- | 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 |