git.iko.soy/typeable/pandoc
on master help sign in
markdown2pdf: Don't crash if pdflatex's output is not UTF-8.
5eec45eJohn MacFarlane
src/markdown2pdf.hs+45−6
@@ -5,21 +5,60 @@ import Data.Maybe (isNothing)
5import qualified Data.ByteString as BS
5import qualified Data.ByteString as BS
6import Codec.Binary.UTF8.String (decodeString, encodeString)
6import Codec.Binary.UTF8.String (decodeString, encodeString)
7import Data.ByteString.UTF8 (toString)
7import Data.ByteString.UTF8 (toString)
8−import Control.Monad (unless, guard, liftM)
8+import Control.Monad (unless, guard, liftM, when)
9+import Control.Concurrent (putMVar, takeMVar, newEmptyMVar, forkIO)
9−import Control.Exception (tryJust, bracket)
10+import Control.Exception (tryJust, bracket, evaluate)
10
11
11−import System.IO (stderr)
12+import System.IO
12import System.IO.Error (isDoesNotExistError)
13import System.IO.Error (isDoesNotExistError)
13import System.Environment ( getArgs, getProgName )
14import System.Environment ( getArgs, getProgName )
14import qualified Text.Pandoc.UTF8 as UTF8
15import qualified Text.Pandoc.UTF8 as UTF8
15import System.Exit (ExitCode (..), exitWith)
16import System.Exit (ExitCode (..), exitWith)
16import System.FilePath
17import System.FilePath
17import System.Directory
18import System.Directory
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'.)
18−import System.Process (readProcessWithExitCode)
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)
19
58
20run :: FilePath -> [String] -> IO (Either String String)
59run :: FilePath -> [String] -> IO (Either String String)
21run file opts = do
60run file opts = do
22− (code, out, err) <- readProcessWithExitCode (encodeString file)
61+ (code, out, err) <- readProcessWithExitCode' (encodeString file)
23 (map encodeString opts) ""
62 (map encodeString opts) ""
24 let msg = out ++ err
63 let msg = out ++ err
25 case code of
64 case code of
@@ -123,7 +162,7 @@ exit x = do
123
162
124saveStdin :: FilePath -> IO (Either String FilePath)
163saveStdin :: FilePath -> IO (Either String FilePath)
125saveStdin file = do
164saveStdin file = do
126− text <- UTF8.getContents
165+ text <- liftM toString $ BS.getContents
127 UTF8.writeFile file text
166 UTF8.writeFile file text
128 fileExist <- doesFileExist (encodeString file)
167 fileExist <- doesFileExist (encodeString file)
129 case fileExist of
168 case fileExist of