diff --git a/System/Process.hsc b/System/Process.hsc index 6b870fd8634cb5a95d4af9d39b08e7c706470a0f..37d442fedccfe15404c74332f660af6ee1f8e853 100644 --- a/System/Process.hsc +++ b/System/Process.hsc @@ -57,6 +57,7 @@ module System.Process ( -- Interprocess communication createPipe, + createPipeFd, -- * Old deprecated functions -- | These functions pre-date 'createProcess' which is much more diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs index ef8ff8f828082f3b4a633d533d872f8508913e1a..c4d5be3b4a57c3d6fb5a5530e2f75e61ba81e853 100644 --- a/System/Process/Internals.hs +++ b/System/Process/Internals.hs @@ -38,6 +38,7 @@ module System.Process.Internals ( withFilePathException, withCEnvironment, translate, createPipe, + createPipeFd, interruptProcessGroupOf, ) where @@ -45,6 +46,7 @@ import Foreign.C import System.IO import GHC.IO.Handle.FD (fdToHandle) +import System.Posix.Internals (FD) import System.Process.Common @@ -163,6 +165,17 @@ createPipe :: IO (Handle, Handle) createPipe = createPipeInternal {-# INLINE createPipe #-} +-- --------------------------------------------------------------------------- +-- createPipeFd + +-- | Create a pipe for interprocess communication and return a +-- @(readEnd, writeEnd)@ `FD` pair. +-- +-- @since 1.4.2.0 +createPipeFd :: IO (FD, FD) +createPipeFd = createPipeInternalFd +{-# INLINE createPipeFd #-} + -- ---------------------------------------------------------------------------- -- interruptProcessGroupOf diff --git a/System/Process/Posix.hs b/System/Process/Posix.hs index 612919792e047c0ce4d7a611175313d7e63ccdee..d11e793c3062b0b7fcd5a0e022c35a1baa8db2bb 100644 --- a/System/Process/Posix.hs +++ b/System/Process/Posix.hs @@ -15,6 +15,7 @@ module System.Process.Posix , c_execvpe , pPrPr_disableITimers , createPipeInternal + , createPipeInternalFd , interruptProcessGroupOfInternal ) where @@ -279,6 +280,11 @@ createPipeInternal = do writeh <- Posix.fdToHandle writefd return (readh, writeh) +createPipeInternalFd :: IO (FD, FD) +createPipeInternalFd = do + (Fd readfd, Fd writefd) <- Posix.createPipe + return (readfd, writefd) + interruptProcessGroupOfInternal :: ProcessHandle -- ^ A process in the process group -> IO () diff --git a/System/Process/Windows.hsc b/System/Process/Windows.hsc index a984bae366ddd5b472374521ba4f0aa600d3e47d..c2582fede8dfc53d26fd44dad6ef9c6c8afd91f0 100644 --- a/System/Process/Windows.hsc +++ b/System/Process/Windows.hsc @@ -10,6 +10,7 @@ module System.Process.Windows , stopDelegateControlC , isDefaultSignal , createPipeInternal + , createPipeInternalFd , interruptProcessGroupOfInternal ) where @@ -244,14 +245,19 @@ isDefaultSignal = const False createPipeInternal :: IO (Handle, Handle) createPipeInternal = do - (readfd, writefd) <- allocaArray 2 $ \ pfds -> do + (readfd, writefd) <- createPipeInternalFd + (do readh <- fdToHandle readfd + writeh <- fdToHandle writefd + return (readh, writeh)) `onException` (close' readfd >> close' writefd) + +createPipeInternalFd :: IO (FD, FD) +createPipeInternalFd = do + allocaArray 2 $ \ pfds -> do throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY) readfd <- peek pfds writefd <- peekElemOff pfds 1 return (readfd, writefd) - (do readh <- fdToHandle readfd - writeh <- fdToHandle writefd - return (readh, writeh)) `onException` (close' readfd >> close' writefd) + close' :: CInt -> IO () close' = throwErrnoIfMinus1_ "_close" . c__close diff --git a/changelog.md b/changelog.md index b01b324d174a7f6385aca88e1ffd56f420221317..7a220f7c84a5ecacaf09d12252b3190a575698cd 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,11 @@ # Changelog for [`process` package](http://hackage.haskell.org/package/process) +## 1.4.2.0 *January 2016* + +* Added `createPipeFD` [#52](https://github.com/haskell/process/pull/52) + * New function `createPipeFD` added which returns a POSIX File Descriptor (CInt) + instead of a GHC Handle to a pipe + ## 1.4.1.0 *November 2015* * Use less CPP [#47](https://github.com/haskell/process/pull/47) diff --git a/process.cabal b/process.cabal index ee69285340f78a962fb7ac30902e9cb065cfd140..15f6a6569f5cc6b2a8e60cef910f4226ce120e6d 100644 --- a/process.cabal +++ b/process.cabal @@ -1,5 +1,5 @@ name: process -version: 1.4.1.0 +version: 1.4.2.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE