[commit: packages/process] less-cpp, master: Move interruptProcessGroupOf into per-OS modules (6a8ca1e)

git at git.haskell.org git at git.haskell.org
Tue Dec 15 13:34:43 UTC 2015


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

On branches: less-cpp,master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6a8ca1ea4376bf93ac8fcfe88ffa6d9f860c9687/process

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

commit 6a8ca1ea4376bf93ac8fcfe88ffa6d9f860c9687
Author: Michael Snoyman <michael at fpcomplete.com>
Date:   Mon Nov 2 17:02:44 2015 +0000

    Move interruptProcessGroupOf into per-OS modules


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

6a8ca1ea4376bf93ac8fcfe88ffa6d9f860c9687
 System/Process.hsc          | 38 --------------------------------------
 System/Process/Internals.hs | 17 +++++++++++++++++
 System/Process/Posix.hs     | 13 +++++++++++++
 System/Process/Windows.hs   | 23 +++++++++++++++++++++++
 4 files changed, 53 insertions(+), 38 deletions(-)

diff --git a/System/Process.hsc b/System/Process.hsc
index c0b08ee..de07225 100644
--- a/System/Process.hsc
+++ b/System/Process.hsc
@@ -90,7 +90,6 @@ import System.IO.Error (mkIOError, ioeSetErrorString)
 #if defined(mingw32_HOST_OS)
 # include <fcntl.h>     /* for _O_BINARY */
 #else
-import System.Posix.Process (getProcessGroupIDOf)
 #if MIN_VERSION_base(4,5,0)
 import System.Posix.Types
 #endif
@@ -98,12 +97,6 @@ import System.Posix.Types
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) )
-# if defined(mingw32_HOST_OS)
-import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT)
-import System.Win32.Process (getProcessId)
-# else
-import System.Posix.Signals
-# endif
 #endif
 
 -- ----------------------------------------------------------------------------
@@ -689,37 +682,6 @@ terminateProcess ph = do
 
 
 -- ----------------------------------------------------------------------------
--- interruptProcessGroupOf
-
--- | Sends an interrupt signal to the process group of the given process.
---
--- On Unix systems, it sends the group the SIGINT signal.
---
--- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for
--- processes created using 'createProcess' and setting the 'create_group' flag
-
-interruptProcessGroupOf
-    :: ProcessHandle    -- ^ A process in the process group
-    -> IO ()
-interruptProcessGroupOf ph = do
-    withProcessHandle ph $ \p_ -> do
-        case p_ of
-            ClosedHandle _ -> return ()
-            OpenHandle h -> do
-#if mingw32_HOST_OS
-                pid <- getProcessId h
-                generateConsoleCtrlEvent cTRL_BREAK_EVENT pid
--- We can't use an #elif here, because MIN_VERSION_unix isn't defined
--- on Windows, so on Windows cpp fails:
--- error: missing binary operator before token "("
-#else
-                pgid <- getProcessGroupIDOf h
-                signalProcessGroup sigINT pgid
-#endif
-                return ()
-
-
--- ----------------------------------------------------------------------------
 -- Interface to C bits
 
 foreign import ccall unsafe "terminateProcess"
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index 3a673c7..69ecd2b 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -42,6 +42,7 @@ module System.Process.Internals (
     withFilePathException, withCEnvironment,
     translate,
     createPipe,
+    interruptProcessGroupOf,
     ) where
 
 import Foreign.C
@@ -170,3 +171,19 @@ runGenProcess_ fun c _ _ = createProcess_ fun c
 createPipe :: IO (Handle, Handle)
 createPipe = createPipeInternal
 {-# INLINE createPipe #-}
+
+
+-- ----------------------------------------------------------------------------
+-- interruptProcessGroupOf
+
+-- | Sends an interrupt signal to the process group of the given process.
+--
+-- On Unix systems, it sends the group the SIGINT signal.
+--
+-- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for
+-- processes created using 'createProcess' and setting the 'create_group' flag
+
+interruptProcessGroupOf
+    :: ProcessHandle    -- ^ A process in the process group
+    -> IO ()
+interruptProcessGroupOf = interruptProcessGroupOfInternal
diff --git a/System/Process/Posix.hs b/System/Process/Posix.hs
index e9d1e31..a68d942 100644
--- a/System/Process/Posix.hs
+++ b/System/Process/Posix.hs
@@ -15,6 +15,7 @@ module System.Process.Posix
     , c_execvpe
     , pPrPr_disableITimers
     , createPipeInternal
+    , interruptProcessGroupOfInternal
     ) where
 
 import Control.Concurrent
@@ -36,6 +37,7 @@ import System.Posix.Internals
 import GHC.IO.Exception
 import System.Posix.Signals as Sig
 import qualified System.Posix.IO as Posix
+import System.Posix.Process (getProcessGroupIDOf)
 
 import System.Process.Common
 
@@ -280,3 +282,14 @@ createPipeInternal = do
     readh <- Posix.fdToHandle readfd
     writeh <- Posix.fdToHandle writefd
     return (readh, writeh)
+
+interruptProcessGroupOfInternal
+    :: ProcessHandle    -- ^ A process in the process group
+    -> IO ()
+interruptProcessGroupOfInternal ph = do
+    withProcessHandle ph $ \p_ -> do
+        case p_ of
+            ClosedHandle _ -> return ()
+            OpenHandle h -> do
+                pgid <- getProcessGroupIDOf h
+                signalProcessGroup sigINT pgid
diff --git a/System/Process/Windows.hs b/System/Process/Windows.hs
index 676ecbe..51a4c51 100644
--- a/System/Process/Windows.hs
+++ b/System/Process/Windows.hs
@@ -10,6 +10,7 @@ module System.Process.Windows
     , stopDelegateControlC
     , isDefaultSignal
     , createPipeInternal
+    , interruptProcessGroupOfInternal
     ) where
 
 import System.Process.Common
@@ -37,6 +38,8 @@ import GHC.IO.IOMode
 import System.Directory         ( doesFileExist )
 import System.Environment       ( getEnv )
 import System.FilePath
+import System.Win32.Console (generateConsoleCtrlEvent, cTRL_BREAK_EVENT)
+import System.Win32.Process (getProcessId)
 
 import System.Process.Common
 
@@ -262,3 +265,23 @@ foreign import ccall "io.h _pipe" c__pipe ::
 
 foreign import ccall "io.h _close" c__close ::
     CInt -> IO CInt
+
+interruptProcessGroupOfInternal
+    :: ProcessHandle    -- ^ A process in the process group
+    -> IO ()
+interruptProcessGroupOfInternal ph = do
+    withProcessHandle ph $ \p_ -> do
+        case p_ of
+            ClosedHandle _ -> return ()
+            OpenHandle h -> do
+#if mingw32_HOST_OS
+                pid <- getProcessId h
+                generateConsoleCtrlEvent cTRL_BREAK_EVENT pid
+-- We can't use an #elif here, because MIN_VERSION_unix isn't defined
+-- on Windows, so on Windows cpp fails:
+-- error: missing binary operator before token "("
+#else
+                pgid <- getProcessGroupIDOf h
+                signalProcessGroup sigINT pgid
+#endif
+                return ()



More information about the ghc-commits mailing list