From e63f47445f50c64496c71171d938f511dd1a6d4d Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 2 Nov 2015 16:57:45 +0000 Subject: [PATCH] Move createPipe to per-OS modules --- System/Process.hsc | 38 ------------------------------------- System/Process/Internals.hs | 12 ++++++++++++ System/Process/Posix.hs | 9 +++++++++ System/Process/Windows.hs | 22 +++++++++++++++++++++ 4 files changed, 43 insertions(+), 38 deletions(-) diff --git a/System/Process.hsc b/System/Process.hsc index f8431a4b..c0b08eee 100644 --- 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 /* for _close and _pipe */ # include /* 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 index 32052ebc..3a673c7c 100644 --- 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 index ec957430..e9d1e311 100644 --- 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 index bae63c60..676ecbe8 100644 --- 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 /* 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