Move createPipe to per-OS modules

jamescheney · Nov 2, 2015 · e63f474 · e63f474
1 parent 5d81377
commit e63f474
Show file tree

Hide file tree

Showing 4 changed files with 43 additions and 38 deletions.
diff --git a/System/Process.hsc b/System/Process.hsc
@@ -88,12 +88,9 @@ import System.IO
 import System.IO.Error (mkIOError, ioeSetErrorString)
 
 #if defined(mingw32_HOST_OS)
-# include <io.h>        /* for _close and _pipe */
 # include <fcntl.h>     /* for _O_BINARY */
-import Control.Exception (onException)
 #else
 import System.Posix.Process (getProcessGroupIDOf)
-import qualified System.Posix.IO as Posix
 #if MIN_VERSION_base(4,5,0)
 import System.Posix.Types
 #endif
@@ -934,38 +931,3 @@ 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/System/Process/Internals.hs b/System/Process/Internals.hs
@@ -41,6 +41,7 @@ module System.Process.Internals (
 #endif
     withFilePathException, withCEnvironment,
     translate,
+    createPipe,
     ) where
 
 import Foreign.C
@@ -158,3 +159,14 @@ runGenProcess_ fun c (Just sig) (Just sig') | isDefaultSignal sig && sig == sig'
 runGenProcess_ fun c _ _ = createProcess_ fun c
 
 #endif
+
+-- ---------------------------------------------------------------------------
+-- createPipe
+
+-- | Create a pipe for interprocess communication and return a
+-- @(readEnd, writeEnd)@ `Handle` pair.
+--
+-- @since 1.2.1.0
+createPipe :: IO (Handle, Handle)
+createPipe = createPipeInternal
+{-# INLINE createPipe #-}
diff --git a/System/Process/Posix.hs b/System/Process/Posix.hs
@@ -14,6 +14,7 @@ module System.Process.Posix
     , defaultSignal
     , c_execvpe
     , pPrPr_disableITimers
+    , createPipeInternal
     ) where
 
 import Control.Concurrent
@@ -34,6 +35,7 @@ import System.Posix.Types
 import System.Posix.Internals
 import GHC.IO.Exception
 import System.Posix.Signals as Sig
+import qualified System.Posix.IO as Posix
 
 import System.Process.Common
 
@@ -271,3 +273,10 @@ defaultSignal = CONST_SIG_DFL
 
 isDefaultSignal :: CLong -> Bool
 isDefaultSignal = (== defaultSignal)
+
+createPipeInternal :: IO (Handle, Handle)
+createPipeInternal = do
+    (readfd, writefd) <- Posix.createPipe
+    readh <- Posix.fdToHandle readfd
+    writeh <- Posix.fdToHandle writefd
+    return (readh, writeh)
diff --git a/System/Process/Windows.hs b/System/Process/Windows.hs
@@ -9,6 +9,7 @@ module System.Process.Windows
     , endDelegateControlC
     , stopDelegateControlC
     , isDefaultSignal
+    , createPipeInternal
     ) where
 
 import System.Process.Common
@@ -45,6 +46,7 @@ import System.Process.Common
 # define WINDOWS_CCONV ccall
 #endif
 
+#include <io.h>        /* for _close and _pipe */
 #include "HsProcessConfig.h"
 #include "processFlags.h"
 
@@ -240,3 +242,23 @@ withCEnvironment envir act =
 
 isDefaultSignal :: CLong -> Bool
 isDefaultSignal = const False
+
+createPipeInternal :: IO (Handle, Handle)
+createPipeInternal = 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