[commit: packages/process] master, wip/issue15: Implement System.Process.createPipe operation (0246baf)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/process

On branches: master,wip/issue15
Link       : http://ghc.haskell.org/trac/ghc/changeset/0246baf953e6b0d1b511f4d831528a9a5e8b71e2/process

>---------------------------------------------------------------

commit 0246baf953e6b0d1b511f4d831528a9a5e8b71e2
Author: Johan Tibell <johan.tibell at gmail.com>
Date:   Sun Mar 30 17:18:12 2014 +0200

    Implement System.Process.createPipe operation
    
    Neccesary for implementing 'tee' like behavior.
    
    See
    
     - http://comments.gmane.org/gmane.comp.lang.haskell.libraries/21373
     - https://ghc.haskell.org/trac/ghc/ticket/8943
    
    for more details.


>---------------------------------------------------------------

0246baf953e6b0d1b511f4d831528a9a5e8b71e2
 System/{Process.hs => Process.hsc} | 61 ++++++++++++++++++++++++++++----------
 changelog.md                       |  2 ++
 2 files changed, 48 insertions(+), 15 deletions(-)

diff --git a/System/Process.hs b/System/Process.hsc
similarity index 95%
rename from System/Process.hs
rename to System/Process.hsc
index a5f92ff..4fca71e 100644
--- a/System/Process.hs
+++ b/System/Process.hsc
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
 #ifdef __GLASGOW_HASKELL__
 #if __GLASGOW_HASKELL__ >= 709
 {-# LANGUAGE Safe #-}
@@ -25,19 +25,6 @@
 -- ToDo:
 --      * Flag to control whether exiting the parent also kills the child.
 
-{- NOTES on createPipe:
-
-   createPipe is no longer exported, because of the following problems:
-
-        - it wasn't used to implement runInteractiveProcess on Unix, because
-          the file descriptors for the unused ends of the pipe need to be closed
-          in the child process.
-
-        - on Windows, a special version of createPipe is needed that sets
-          the inheritance flags correctly on the ends of the pipe (see
-          mkAnonPipe below).
--}
-
 module System.Process (
     -- * Running sub-processes
     createProcess,
@@ -68,6 +55,9 @@ module System.Process (
     terminateProcess,
     interruptProcessGroupOf,
 
+    -- Interprocess communication
+    createPipe,
+
     -- * Old deprecated functions
     -- | These functions pre-date 'createProcess' which is much more
     -- flexible.
@@ -95,8 +85,14 @@ import System.Exit      ( ExitCode(..) )
 import System.IO
 import System.IO.Error (mkIOError, ioeSetErrorString)
 
-#if !defined(mingw32_HOST_OS)
+#if defined(mingw32_HOST_OS)
+# include <io.h>        /* for _close and _pipe */
+# include <fcntl.h>     /* for _O_BINARY */
+import Control.Exception (onException)
+import Foreign.C.Types (CInt(..), CUInt(..))
+#else
 import System.Posix.Process (getProcessGroupIDOf)
+import qualified System.Posix.IO as Posix
 import System.Posix.Types
 #endif
 
@@ -887,3 +883,38 @@ rawSystem cmd args = system (showCommandForUser cmd args)
 #else
 rawSystem cmd args = system (showCommandForUser cmd args)
 #endif
+
+-- ---------------------------------------------------------------------------
+-- createPipe
+
+-- | Create a pipe for interprocess communication and return a
+-- @(readEnd, writeEnd)@ `Handle` pair.
+--
+-- /Since: 1.2.1.0/
+createPipe :: IO (Handle, Handle)
+#if !mingw32_HOST_OS
+createPipe = do
+    (readfd, writefd) <- Posix.createPipe
+    readh <- Posix.fdToHandle readfd
+    writeh <- Posix.fdToHandle writefd
+    return (readh, writeh)
+#else
+createPipe = do
+    (readfd, writefd) <- 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
+
+foreign import ccall "io.h _pipe" c__pipe ::
+    Ptr CInt -> CUInt -> CInt -> IO CInt
+
+foreign import ccall "io.h _close" c__close ::
+    CInt -> IO CInt
+#endif
diff --git a/changelog.md b/changelog.md
index 8a1d630..13b5824 100644
--- a/changelog.md
+++ b/changelog.md
@@ -14,6 +14,8 @@
   * Expose `createProcess_` function, and document behavior of `UseHandle` for
     `createProcess`. See [issue #2](https://github.com/haskell/process/issues/2).
 
+  * New `System.Process.createPipe` operation
+
 ## 1.2.0.0  *Dec 2013*
 
   * Update to Cabal 1.10 format