git.iko.soy/typeable/pandoc
on 34412cf help sign in
typeable/pandoc/src/Text/Pandoc/Process.hs
98 lines 3.6 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 Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
33import Control.Exception
34import Control.Monad (unless)
35import qualified Data.ByteString.Lazy as BL
36import System.Exit (ExitCode (..))
37import System.IO (hClose, hFlush)
38import System.Process
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 strictly, waits until the process
46terminates, and then returns the 'ExitCode' of the process
47and the standard output. stderr is inherited from the parent.
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) -- ^ exitcode, stdout
61pipeProcess mbenv cmd args input =
62 mask $ \restore -> do
63 (Just inh, Just outh, Nothing, pid) <- createProcess (proc cmd args)
64 { env = mbenv,
65 std_in = CreatePipe,
66 std_out = CreatePipe,
67 std_err = Inherit }
68 flip onException
69 (do hClose inh; hClose outh;
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 -- now write and flush any input
76 let writeInput = do
77 unless (BL.null input) $ do
78 BL.hPutStr inh input
79 hFlush inh
80 hClose inh
82 writeInput
84 -- wait on the output
85 waitOut
87 hClose outh
89 -- wait on the process
90 ex <- waitForProcess pid
92 return (ex, out)
94forkWait :: IO a -> IO (IO a)
95forkWait a = do
96 res <- newEmptyMVar
97 _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res
98 return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)