|
| 1 | +{-# LANGUAGE CPP #-} |
| 2 | +{-# LANGUAGE RankNTypes #-} |
| 3 | + |
| 4 | +module System.Process.CommunicationHandle |
| 5 | + ( -- * 'CommunicationHandle': a 'Handle' that can be serialised, |
| 6 | + -- enabling inter-process communication. |
| 7 | + CommunicationHandle |
| 8 | + -- NB: opaque, as the representation depends on the operating system |
| 9 | + , openCommunicationHandleRead |
| 10 | + , openCommunicationHandleWrite |
| 11 | + , closeCommunicationHandle |
| 12 | + -- * Creating 'CommunicationHandle's to communicate with |
| 13 | + -- a child process |
| 14 | + , createWeReadTheyWritePipe |
| 15 | + , createTheyReadWeWritePipe |
| 16 | + -- * High-level API |
| 17 | + , readCreateProcessWithExitCodeCommunicationHandle |
| 18 | + ) |
| 19 | + where |
| 20 | + |
| 21 | +import GHC.IO.Handle (Handle) |
| 22 | + |
| 23 | +import System.Process.CommunicationHandle.Internal |
| 24 | +import System.Process.Internals |
| 25 | + ( CreateProcess(..), ignoreSigPipe, withForkWait ) |
| 26 | +import System.Process |
| 27 | + ( withCreateProcess, waitForProcess ) |
| 28 | + |
| 29 | +import GHC.IO (evaluate) |
| 30 | +import GHC.IO.Handle (hClose) |
| 31 | +import System.Exit (ExitCode) |
| 32 | + |
| 33 | +import Control.DeepSeq (NFData, rnf) |
| 34 | + |
| 35 | +-------------------------------------------------------------------------------- |
| 36 | +-- Communication handles. |
| 37 | + |
| 38 | +-- | Turn the 'CommunicationHandle' into a 'Handle' that can be read from |
| 39 | +-- in the current process. |
| 40 | +-- |
| 41 | +-- @since 1.6.20.0 |
| 42 | +openCommunicationHandleRead :: CommunicationHandle -> IO Handle |
| 43 | +openCommunicationHandleRead = useCommunicationHandle True |
| 44 | + |
| 45 | +-- | Turn the 'CommunicationHandle' into a 'Handle' that can be written to |
| 46 | +-- in the current process. |
| 47 | +-- |
| 48 | +-- @since 1.6.20.0 |
| 49 | +openCommunicationHandleWrite :: CommunicationHandle -> IO Handle |
| 50 | +openCommunicationHandleWrite = useCommunicationHandle False |
| 51 | + |
| 52 | +-------------------------------------------------------------------------------- |
| 53 | +-- Creating pipes. |
| 54 | + |
| 55 | +-- | Create a pipe @(weRead,theyWrite)@ that the current process can read from, |
| 56 | +-- and whose write end can be passed to a child process in order to receive data from it. |
| 57 | +-- |
| 58 | +-- See 'CommunicationHandle'. |
| 59 | +-- |
| 60 | +-- @since 1.6.20.0 |
| 61 | +createWeReadTheyWritePipe |
| 62 | + :: IO (Handle, CommunicationHandle) |
| 63 | +createWeReadTheyWritePipe = |
| 64 | + createCommunicationPipe id False |
| 65 | + -- safe choice: passAsyncHandleToChild = False, in case the child cannot |
| 66 | + -- deal with async I/O (see e.g. https://gitlab.haskell.org/ghc/ghc/-/issues/21610#note_431632) |
| 67 | + -- expert users can invoke createCommunicationPipe from |
| 68 | + -- System.Process.CommunicationHandle.Internals if they are sure that the |
| 69 | + -- child process they will communicate with supports async I/O on Windows |
| 70 | + |
| 71 | +-- | Create a pipe @(theyRead,weWrite)@ that the current process can write to, |
| 72 | +-- and whose read end can be passed to a child process in order to send data to it. |
| 73 | +-- |
| 74 | +-- See 'CommunicationHandle'. |
| 75 | +-- |
| 76 | +-- @since 1.6.20.0 |
| 77 | +createTheyReadWeWritePipe |
| 78 | + :: IO (CommunicationHandle, Handle) |
| 79 | +createTheyReadWeWritePipe = |
| 80 | + sw <$> createCommunicationPipe sw False |
| 81 | + -- safe choice: passAsyncHandleToChild = False, in case the child cannot |
| 82 | + -- deal with async I/O (see e.g. https://gitlab.haskell.org/ghc/ghc/-/issues/21610#note_431632) |
| 83 | + -- expert users can invoke createCommunicationPipe from |
| 84 | + -- System.Process.CommunicationHandle.Internals if they are sure that the |
| 85 | + -- child process they will communicate with supports async I/O on Windows |
| 86 | + where |
| 87 | + sw (a,b) = (b,a) |
| 88 | + |
| 89 | +-------------------------------------------------------------------------------- |
| 90 | + |
| 91 | +-- | A version of 'readCreateProcessWithExitCode' that communicates with the |
| 92 | +-- child process through a pair of 'CommunicationHandle's. |
| 93 | +-- |
| 94 | +-- Example usage: |
| 95 | +-- |
| 96 | +-- > readCreateProcessWithExitCodeCommunicationHandle |
| 97 | +-- > (\(chTheyRead, chTheyWrite) -> proc "child-exe" [show chTheyRead, show chTheyWrite]) |
| 98 | +-- > (\ hWeRead -> hGetContents hWeRead) |
| 99 | +-- > (\ hWeWrite -> hPut hWeWrite "xyz") |
| 100 | +-- |
| 101 | +-- where @child-exe@ is a separate executable that is implemented as: |
| 102 | +-- |
| 103 | +-- > main = do |
| 104 | +-- > [chRead, chWrite] <- getArgs |
| 105 | +-- > hRead <- openCommunicationHandleRead $ read chRead |
| 106 | +-- > hWrite <- openCommunicationHandleWrite $ read chWrite |
| 107 | +-- > input <- hGetContents hRead |
| 108 | +-- > hPut hWrite $ someFn input |
| 109 | +-- > hClose hWrite |
| 110 | +-- |
| 111 | +-- @since 1.6.20.0 |
| 112 | +readCreateProcessWithExitCodeCommunicationHandle |
| 113 | + :: NFData a |
| 114 | + => ((CommunicationHandle, CommunicationHandle) -> CreateProcess) |
| 115 | + -- ^ Process to spawn, given a @(read, write)@ pair of |
| 116 | + -- 'CommunicationHandle's that are inherited by the spawned process |
| 117 | + -> (Handle -> IO a) |
| 118 | + -- ^ read action |
| 119 | + -> (Handle -> IO ()) |
| 120 | + -- ^ write action |
| 121 | + -> IO (ExitCode, a) |
| 122 | +readCreateProcessWithExitCodeCommunicationHandle mkProg readAction writeAction = do |
| 123 | + (chTheyRead, hWeWrite ) <- createTheyReadWeWritePipe |
| 124 | + (hWeRead , chTheyWrite) <- createWeReadTheyWritePipe |
| 125 | + let cp = mkProg (chTheyRead, chTheyWrite) |
| 126 | + -- The following implementation parallels 'readCreateProcess' |
| 127 | + withCreateProcess cp $ \ _ _ _ ph -> do |
| 128 | + -- Close the parent's references to the 'CommunicationHandle's after they |
| 129 | + -- have been inherited by the child (we don't want to keep pipe ends open). |
| 130 | + closeCommunicationHandle chTheyWrite |
| 131 | + closeCommunicationHandle chTheyRead |
| 132 | + |
| 133 | + -- Fork off a thread that waits on the output. |
| 134 | + output <- readAction hWeRead |
| 135 | + withForkWait (evaluate $ rnf output) $ \ waitOut -> do |
| 136 | + ignoreSigPipe $ writeAction hWeWrite |
| 137 | + ignoreSigPipe $ hClose hWeWrite |
| 138 | + waitOut |
| 139 | + hClose hWeRead |
| 140 | + |
| 141 | + ex <- waitForProcess ph |
| 142 | + return (ex, output) |
0 commit comments