@@ -5,21 +5,60 @@ import Data.Maybe (isNothing)
55import qualified Data.ByteString as BS
66import Codec.Binary.UTF8.String (decodeString, encodeString)
77import Data.ByteString.UTF8 (toString)
8−import Control.Monad (unless, guard, liftM)
9−import Control.Exception (tryJust, bracket)
8+import Control.Monad (unless, guard, liftM, when)
9+import Control.Concurrent (putMVar, takeMVar, newEmptyMVar, forkIO)
10+import Control.Exception (tryJust, bracket, evaluate)
1011
11−import System.IO (stderr)
12+import System.IO
1213import System.IO.Error (isDoesNotExistError)
1314import System.Environment ( getArgs, getProgName )
1415import qualified Text.Pandoc.UTF8 as UTF8
1516import System.Exit (ExitCode (..), exitWith)
1617import System.FilePath
1718import System.Directory
18−import System.Process (readProcessWithExitCode)
19+import System.Process
20+
21+-- A variant of 'readProcessWithExitCode' that does not
22+-- cause an error if the output is not UTF-8. (Copied
23+-- with slight variants from 'System.Process'.)
24+readProcessWithExitCode'
25+ :: FilePath -- ^ command to run
26+ -> [String] -- ^ any arguments
27+ -> String -- ^ standard input
28+ -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr
29+readProcessWithExitCode' cmd args input = do
30+ (Just inh, Just outh, Just errh, pid) <-
31+ createProcess (proc cmd args){ std_in = CreatePipe,
32+ std_out = CreatePipe,
33+ std_err = CreatePipe }
34+
35+ outMVar <- newEmptyMVar
36+
37+ -- fork off a thread to start consuming stdout
38+ out <- liftM toString $ BS.hGetContents outh
39+ _ <- forkIO $ evaluate (length out) >> putMVar outMVar ()
40+
41+ -- fork off a thread to start consuming stderr
42+ err <- liftM toString $ BS.hGetContents errh
43+ _ <- forkIO $ evaluate (length err) >> putMVar outMVar ()
44+
45+ -- now write and flush any input
46+ when (not (null input)) $ do hPutStr inh input; hFlush inh
47+ hClose inh -- done with stdin
48+
49+ -- wait on the output
50+ takeMVar outMVar
51+ takeMVar outMVar
52+ hClose outh
53+
54+ -- wait on the process
55+ ex <- waitForProcess pid
56+
57+ return (ex, out, err)
1958
2059run :: FilePath -> [String] -> IO (Either String String)
2160run file opts = do
22− (code, out, err) <- readProcessWithExitCode (encodeString file)
61+ (code, out, err) <- readProcessWithExitCode' (encodeString file)
2362 (map encodeString opts) ""
2463 let msg = out ++ err
2564 case code of
@@ -123,7 +162,7 @@ exit x = do
123162
124163saveStdin :: FilePath -> IO (Either String FilePath)
125164saveStdin file = do
126− text <- UTF8.getContents
165+ text <- liftM toString $ BS.getContents
127166 UTF8.writeFile file text
128167 fileExist <- doesFileExist (encodeString file)
129168 case fileExist of