src/Text/Pandoc/Process.hs · typeable/pandoc

git.iko.soy/typeable/pandoc

on 91ef25a help sign in

typeable/pandoc/src/Text/Pandoc/Process.hs

100 lines 3.6 kB history raw

1{-# LANGUAGE NoImplicitPrelude #-}

2{-

5This program is free software; you can redistribute it and/or modify

6it under the terms of the GNU General Public License as published by

7the Free Software Foundation; either version 2 of the License, or

8(at your option) any later version.

10This program is distributed in the hope that it will be useful,

11but WITHOUT ANY WARRANTY; without even the implied warranty of

12MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

13GNU General Public License for more details.

15You should have received a copy of the GNU General Public License

16along with this program; if not, write to the Free Software

17Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

18-}

20{- |

21 Module : Text.Pandoc.Process

23 License : GNU GPL, version 2 or above

25 Maintainer : John MacFarlane <jgm@berkeley.edu>

26 Stability : alpha

27 Portability : portable

29ByteString variant of 'readProcessWithExitCode'.

30-}

31module Text.Pandoc.Process (pipeProcess)

32where

33import Prelude

34import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)

35import Control.Exception

36import Control.Monad (unless)

37import qualified Data.ByteString.Lazy as BL

38import System.Exit (ExitCode (..))

39import System.IO (hClose, hFlush)

40import System.Process

42{- |

43Version of 'System.Process.readProcessWithExitCode' that uses lazy bytestrings

44instead of strings and allows setting environment variables.

46@readProcessWithExitCode@ creates an external process, reads its

47standard output strictly, waits until the process

48terminates, and then returns the 'ExitCode' of the process

49and the standard output. stderr is inherited from the parent.

51If an asynchronous exception is thrown to the thread executing

52@readProcessWithExitCode@, the forked process will be terminated and

53@readProcessWithExitCode@ will wait (block) until the process has been

54terminated.

55-}

57pipeProcess

58 :: Maybe [(String, String)] -- ^ environment variables

59 -> FilePath -- ^ Filename of the executable (see 'proc' for details)

60 -> [String] -- ^ any arguments

61 -> BL.ByteString -- ^ standard input

62 -> IO (ExitCode,BL.ByteString) -- ^ exitcode, stdout

63pipeProcess mbenv cmd args input =

64 mask $ \restore -> do

65 (Just inh, Just outh, Nothing, pid) <- createProcess (proc cmd args)

66 { env = mbenv,

67 std_in = CreatePipe,

68 std_out = CreatePipe,

69 std_err = Inherit }

70 flip onException

71 (do hClose inh; hClose outh;

72 terminateProcess pid; waitForProcess pid) $ restore $ do

73 -- fork off a thread to start consuming stdout

74 out <- BL.hGetContents outh

75 waitOut <- forkWait $ evaluate $ BL.length out

77 -- now write and flush any input

78 let writeInput = do

79 unless (BL.null input) $ do

80 BL.hPutStr inh input

81 hFlush inh

82 hClose inh

84 writeInput

86 -- wait on the output

87 waitOut

89 hClose outh

91 -- wait on the process

92 ex <- waitForProcess pid

94 return (ex, out)

96forkWait :: IO a -> IO (IO a)

97forkWait a = do

98 res <- newEmptyMVar

99 _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res

100 return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)