From 73e9a7a8251212aee0db472a695ddfccd5f1a6a7 Mon Sep 17 00:00:00 2001
From: Favonia <favonia@gmail.com>
Date: Wed, 4 May 2011 06:52:44 -0400
Subject: [PATCH 1/3] Change the POSIX process group API. (trac #5167)

The new interface makes it possible to query the process group
of an existing process by 'getProcessGroupIDOf'. In this patch
'createProcessGroup' and 'setProcessGroupID' are still backward
compatible. However, the API seems to be more consistent if we
change them accordingly.

In addition, this patch assumes that the underlying ProcessGroupID
might be a newtype of CPid. This is also suggested by the
proposal in ticket #5167. If suggested changes are made to the
package base then 'fromIntegral' can be avoided completely
('ProcessGroupID pgid' instead of 'fromIntegral pgid')
---
 System/Posix/Process.hsc  |   41 +++++++++++++++++++++++++++++++++++------
 System/Posix/Signals.hsc  |    2 +-
 System/Posix/Terminal.hsc |    4 ++--
 3 files changed, 38 insertions(+), 9 deletions(-)

diff --git a/System/Posix/Process.hsc b/System/Posix/Process.hsc
index 163c356..a0eff54 100644
--- a/System/Posix/Process.hsc
+++ b/System/Posix/Process.hsc
@@ -29,12 +29,15 @@ module System.Posix.Process (
     -- ** Process environment
     getProcessID,
     getParentProcessID,
-    getProcessGroupID,
 
     -- ** Process groups
+    getProcessGroupID,
+    getProcessGroupIDOf,
     createProcessGroup,
+    createProcessGroupFor,
     joinProcessGroup,
     setProcessGroupID,
+    setProcessGroupIDOf,
 
     -- ** Sessions
     createSession,
@@ -109,14 +112,32 @@ getProcessGroupID :: IO ProcessGroupID
 getProcessGroupID = c_getpgrp
 
 foreign import ccall unsafe "getpgrp"
-  c_getpgrp :: IO CPid
+  c_getpgrp :: IO ProcessGroupID
+
+-- | 'getProcessGroupIDOf' calls @getpgid@ to obtain the
+--   'ProcessGroupID' for process @pid@.
+getProcessGroupIDOf :: ProcessID -> IO ProcessGroupID
+getProcessGroupIDOf pid =
+  throwErrnoIfMinus1 "getProcessGroupIDOf" (c_getpgid pid)
+
+foreign import ccall unsafe "getpgid"
+  c_getpgid :: CPid -> IO ProcessGroupID
 
 -- | @'createProcessGroup' pid@ calls @setpgid@ to make
 --   process @pid@ a new process group leader.
+--   This function will be changed to make the current
+--   process a new process group leader in future versions.
 createProcessGroup :: ProcessID -> IO ProcessGroupID
 createProcessGroup pid = do
   throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid pid 0)
-  return pid
+  return $ fromIntegral pid
+
+-- | @'createProcessGroupFor' pid@ calls @setpgid@ to make
+--   process @pid@ a new process group leader.
+createProcessGroupFor :: ProcessID -> IO ProcessGroupID
+createProcessGroupFor pid = do
+  throwErrnoIfMinus1_ "createProcessGroupFor" (c_setpgid pid 0)
+  return $ fromIntegral pid
 
 -- | @'joinProcessGroup' pgid@ calls @setpgid@ to set the
 --   'ProcessGroupID' of the current process to @pgid@.
@@ -126,12 +147,20 @@ joinProcessGroup pgid =
 
 -- | @'setProcessGroupID' pid pgid@ calls @setpgid@ to set the
 --   'ProcessGroupID' for process @pid@ to @pgid@.
+--   This function will be changed to set the 'ProcessGroupID'
+--   for the current process in future versions.
 setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
 setProcessGroupID pid pgid =
   throwErrnoIfMinus1_ "setProcessGroupID" (c_setpgid pid pgid)
 
+-- | @'setProcessGroupIDOf' pid pgid@ calls @setpgid@ to set the
+--   'ProcessGroupIDOf' for process @pid@ to @pgid@.
+setProcessGroupIDOf :: ProcessID -> ProcessGroupID -> IO ()
+setProcessGroupIDOf pid pgid =
+  throwErrnoIfMinus1_ "setProcessGroupIDOf" (c_setpgid pid pgid)
+
 foreign import ccall unsafe "setpgid"
-  c_setpgid :: CPid -> CPid -> IO CInt
+  c_setpgid :: CPid -> ProcessGroupID -> IO CInt
 
 -- | 'createSession' calls @setsid@ to create a new session
 --   with the current process as session leader.
@@ -139,7 +168,7 @@ createSession :: IO ProcessGroupID
 createSession = throwErrnoIfMinus1 "createSession" c_setsid
 
 foreign import ccall unsafe "setsid"
-  c_setsid :: IO CPid
+  c_setsid :: IO ProcessGroupID
 
 -- -----------------------------------------------------------------------------
 -- Process times
@@ -345,7 +374,7 @@ getGroupProcessStatus :: Bool
 getGroupProcessStatus block stopped pgid =
   alloca $ \wstatp -> do
     pid <- throwErrnoIfMinus1Retry "getGroupProcessStatus"
-		(c_waitpid (-pgid) wstatp (waitOptions block stopped))
+		(c_waitpid (fromIntegral (-pgid)) wstatp (waitOptions block stopped))
     case pid of
       0  -> return Nothing
       _  -> do ps <- readWaitStatus wstatp
diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc
index e156e5b..2d0048e 100644
--- a/System/Posix/Signals.hsc
+++ b/System/Posix/Signals.hsc
@@ -289,7 +289,7 @@ signalProcessGroup sig pgid
   = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg pgid sig)
 
 foreign import ccall unsafe "killpg"
-  c_killpg :: CPid -> CInt -> IO CInt
+  c_killpg :: ProcessGroupID -> CInt -> IO CInt
 
 -- | @raiseSignal int@ calls @kill@ to signal the current process
 --   with interrupt signal @int@. 
diff --git a/System/Posix/Terminal.hsc b/System/Posix/Terminal.hsc
index 54f1589..77930ad 100644
--- a/System/Posix/Terminal.hsc
+++ b/System/Posix/Terminal.hsc
@@ -477,7 +477,7 @@ getTerminalProcessGroupID (Fd fd) = do
   throwErrnoIfMinus1 "getTerminalProcessGroupID" (c_tcgetpgrp fd)
 
 foreign import ccall unsafe "tcgetpgrp"
-  c_tcgetpgrp :: CInt -> IO CPid
+  c_tcgetpgrp :: CInt -> IO ProcessGroupID
 
 -- | @setTerminalProcessGroupID fd pgid@ calls @tcsetpgrp@ to
 --   set the @ProcessGroupID@ of the foreground process group 
@@ -488,7 +488,7 @@ setTerminalProcessGroupID (Fd fd) pgid =
   throwErrnoIfMinus1_ "setTerminalProcessGroupID" (c_tcsetpgrp fd pgid)
 
 foreign import ccall unsafe "tcsetpgrp"
-  c_tcsetpgrp :: CInt -> CPid -> IO CInt
+  c_tcsetpgrp :: CInt -> ProcessGroupID -> IO CInt
 
 -- -----------------------------------------------------------------------------
 -- file descriptor queries
-- 
1.7.4.1