git.iko.soy/typeable/pandoc
on 4eff607 help sign in
typeable/pandoc/src/Text/Pandoc/Process.hs
104 lines 3.8 kB history raw
1{-
2Copyright (C) 2013-2016 John MacFarlane <jgm@berkeley.edu>
4This program is free software; you can redistribute it and/or modify
5it under the terms of the GNU General Public License as published by
6the Free Software Foundation; either version 2 of the License, or
7(at your option) any later version.
9This program is distributed in the hope that it will be useful,
10but WITHOUT ANY WARRANTY; without even the implied warranty of
11MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12GNU General Public License for more details.
14You should have received a copy of the GNU General Public License
15along with this program; if not, write to the Free Software
16Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17-}
19{- |
20 Module : Text.Pandoc.Process
21 Copyright : Copyright (C) 2013-2016 John MacFarlane
22 License : GNU GPL, version 2 or above
24 Maintainer : John MacFarlane <jgm@berkeley.edu>
25 Stability : alpha
26 Portability : portable
28ByteString variant of 'readProcessWithExitCode'.
29-}
30module Text.Pandoc.Process (pipeProcess)
31where
32import System.Process
33import System.Exit (ExitCode (..))
34import Control.Exception
35import System.IO (hClose, hFlush)
36import Control.Concurrent (putMVar, takeMVar, newEmptyMVar, forkIO)
37import Control.Monad (unless)
38import qualified Data.ByteString.Lazy as BL
40{- |
41Version of 'System.Process.readProcessWithExitCode' that uses lazy bytestrings
42instead of strings and allows setting environment variables.
44@readProcessWithExitCode@ creates an external process, reads its
45standard output and standard error strictly, waits until the process
46terminates, and then returns the 'ExitCode' of the process,
47the standard output, and the standard error.
49If an asynchronous exception is thrown to the thread executing
50@readProcessWithExitCode@, the forked process will be terminated and
51@readProcessWithExitCode@ will wait (block) until the process has been
52terminated.
53-}
55pipeProcess
56 :: Maybe [(String, String)] -- ^ environment variables
57 -> FilePath -- ^ Filename of the executable (see 'proc' for details)
58 -> [String] -- ^ any arguments
59 -> BL.ByteString -- ^ standard input
60 -> IO (ExitCode,BL.ByteString,BL.ByteString) -- ^ exitcode, stdout, stderr
61pipeProcess mbenv cmd args input =
62 mask $ \restore -> do
63 (Just inh, Just outh, Just errh, pid) <- createProcess (proc cmd args)
64 { env = mbenv,
65 std_in = CreatePipe,
66 std_out = CreatePipe,
67 std_err = CreatePipe }
68 flip onException
69 (do hClose inh; hClose outh; hClose errh;
70 terminateProcess pid; waitForProcess pid) $ restore $ do
71 -- fork off a thread to start consuming stdout
72 out <- BL.hGetContents outh
73 waitOut <- forkWait $ evaluate $ BL.length out
75 -- fork off a thread to start consuming stderr
76 err <- BL.hGetContents errh
77 waitErr <- forkWait $ evaluate $ BL.length err
79 -- now write and flush any input
80 let writeInput = do
81 unless (BL.null input) $ do
82 BL.hPutStr inh input
83 hFlush inh
84 hClose inh
86 writeInput
88 -- wait on the output
89 waitOut
90 waitErr
92 hClose outh
93 hClose errh
95 -- wait on the process
96 ex <- waitForProcess pid
98 return (ex, out, err)
100forkWait :: IO a -> IO (IO a)
101forkWait a = do
102 res <- newEmptyMVar
103 _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res
104 return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)