{-# LINE 1 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE InterruptibleFFI, RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
module System.Posix.Process.Common (
forkProcess,
forkProcessWithUnmask,
exitImmediately,
getProcessID,
getParentProcessID,
getProcessGroupID,
getProcessGroupIDOf,
createProcessGroupFor,
joinProcessGroup,
setProcessGroupIDOf,
createSession,
ProcessTimes(..),
getProcessTimes,
clocksPerSec,
nice,
getProcessPriority,
getProcessGroupPriority,
getUserPriority,
setProcessPriority,
setProcessGroupPriority,
setUserPriority,
ProcessStatus(..),
getProcessStatus,
getAnyProcessStatus,
getGroupProcessStatus,
createProcessGroup,
setProcessGroupID,
) where
import Foreign.C.Error
import Foreign.C.Types
import Foreign.Marshal.Alloc ( alloca, allocaBytes )
import Foreign.Ptr ( Ptr )
import Foreign.StablePtr ( StablePtr, newStablePtr, freeStablePtr )
import Foreign.Storable ( Storable(..) )
import System.Exit
import System.Posix.Process.Internals
import System.Posix.Types
import Control.Monad
import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) )
import GHC.TopHandler ( runIO )
{-# LINE 87 "libraries/unix/System/Posix/Process/Common.hsc" #-}
import GHC.IO ( unsafeUnmask, uninterruptibleMask_ )
{-# LINE 92 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 101 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getProcessID :: IO ProcessID
getProcessID :: IO CPid
getProcessID = IO CPid
c_getpid
foreign import ccall unsafe "getpid"
c_getpid :: IO CPid
{-# LINE 113 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 122 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getParentProcessID :: IO ProcessID
getParentProcessID :: IO CPid
getParentProcessID = IO CPid
c_getppid
foreign import ccall unsafe "getppid"
c_getppid :: IO CPid
{-# LINE 132 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 141 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getProcessGroupID :: IO ProcessGroupID
getProcessGroupID :: IO CPid
getProcessGroupID = IO CPid
c_getpgrp
foreign import ccall unsafe "getpgrp"
c_getpgrp :: IO CPid
{-# LINE 151 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 160 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getProcessGroupIDOf :: ProcessID -> IO ProcessGroupID
getProcessGroupIDOf :: CPid -> IO CPid
getProcessGroupIDOf CPid
pid =
String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getProcessGroupIDOf" (CPid -> IO CPid
c_getpgid CPid
pid)
foreign import ccall unsafe "getpgid"
c_getpgid :: CPid -> IO CPid
{-# LINE 171 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 193 "libraries/unix/System/Posix/Process/Common.hsc" #-}
createProcessGroupFor :: ProcessID -> IO ProcessGroupID
createProcessGroupFor :: CPid -> IO CPid
createProcessGroupFor CPid
pid = do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"createProcessGroupFor" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
0)
CPid -> IO CPid
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CPid
pid
{-# LINE 202 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 211 "libraries/unix/System/Posix/Process/Common.hsc" #-}
joinProcessGroup :: ProcessGroupID -> IO ()
joinProcessGroup :: CPid -> IO ()
joinProcessGroup CPid
pgid =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"joinProcessGroup" (CPid -> CPid -> IO CInt
c_setpgid CPid
0 CPid
pgid)
{-# LINE 219 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 239 "libraries/unix/System/Posix/Process/Common.hsc" #-}
setProcessGroupIDOf :: ProcessID -> ProcessGroupID -> IO ()
setProcessGroupIDOf :: CPid -> CPid -> IO ()
setProcessGroupIDOf CPid
pid CPid
pgid =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessGroupIDOf" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
pgid)
foreign import ccall unsafe "setpgid"
c_setpgid :: CPid -> CPid -> IO CInt
{-# LINE 250 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 259 "libraries/unix/System/Posix/Process/Common.hsc" #-}
createSession :: IO ProcessGroupID
createSession :: IO CPid
createSession = String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"createSession" IO CPid
c_setsid
foreign import ccall unsafe "setsid"
c_setsid :: IO CPid
{-# LINE 269 "libraries/unix/System/Posix/Process/Common.hsc" #-}
data ProcessTimes
= ProcessTimes { ProcessTimes -> CClock
elapsedTime :: ClockTick
, ProcessTimes -> CClock
userTime :: ClockTick
, ProcessTimes -> CClock
systemTime :: ClockTick
, ProcessTimes -> CClock
childUserTime :: ClockTick
, ProcessTimes -> CClock
childSystemTime :: ClockTick
}
{-# LINE 284 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getProcessTimes :: IO ProcessTimes
getProcessTimes :: IO ProcessTimes
getProcessTimes = do
Int -> (Ptr CTms -> IO ProcessTimes) -> IO ProcessTimes
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
32) ((Ptr CTms -> IO ProcessTimes) -> IO ProcessTimes)
-> (Ptr CTms -> IO ProcessTimes) -> IO ProcessTimes
forall a b. (a -> b) -> a -> b
$ \Ptr CTms
p_tms -> do
{-# LINE 290 "libraries/unix/System/Posix/Process/Common.hsc" #-}
elapsed <- throwErrnoIfMinus1 "getProcessTimes" (c_times p_tms)
ut <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p_tms
{-# LINE 292 "libraries/unix/System/Posix/Process/Common.hsc" #-}
st <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p_tms
{-# LINE 293 "libraries/unix/System/Posix/Process/Common.hsc" #-}
cut <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p_tms
{-# LINE 294 "libraries/unix/System/Posix/Process/Common.hsc" #-}
cst <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p_tms
{-# LINE 295 "libraries/unix/System/Posix/Process/Common.hsc" #-}
return (ProcessTimes{ elapsedTime = elapsed,
userTime = ut,
systemTime = st,
childUserTime = cut,
childSystemTime = cst
})
data {-# CTYPE "struct tms" #-} CTms
foreign import capi unsafe "HsUnix.h times"
c_times :: Ptr CTms -> IO CClock
clocksPerSec :: ClockTick
{-# LINE 310 "libraries/unix/System/Posix/Process/Common.hsc" #-}
clocksPerSec = c_clocks_per_sec
foreign import capi unsafe "HsUnix.h __hsunix_clocks_per_second"
c_clocks_per_sec :: CClock
{-# LINE 319 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 333 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 345 "libraries/unix/System/Posix/Process/Common.hsc" #-}
nice :: Int -> IO ()
nice :: Int -> IO ()
nice Int
prio = do
IO ()
resetErrno
CInt
res <- CInt -> IO CInt
c_nice (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prio)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Errno
err <- IO Errno
getErrno
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Errno
err Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
/= Errno
eOK) (String -> IO ()
forall a. String -> IO a
throwErrno String
"nice")
foreign import ccall unsafe "nice"
c_nice :: CInt -> IO CInt
{-# LINE 358 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getProcessPriority :: ProcessID -> IO Int
getProcessGroupPriority :: ProcessGroupID -> IO Int
getUserPriority :: UserID -> IO Int
{-# LINE 378 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getProcessPriority :: CPid -> IO Int
getProcessPriority CPid
pid = do
CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getProcessPriority" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> IO CInt
c_getpriority (CInt
0) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid)
{-# LINE 382 "libraries/unix/System/Posix/Process/Common.hsc" #-}
return (fromIntegral r)
getProcessGroupPriority :: CPid -> IO Int
getProcessGroupPriority CPid
pid = do
CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getProcessPriority" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> IO CInt
c_getpriority (CInt
1) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid)
{-# LINE 387 "libraries/unix/System/Posix/Process/Common.hsc" #-}
return (fromIntegral r)
getUserPriority :: UserID -> IO Int
getUserPriority UserID
uid = do
CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"getUserPriority" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> IO CInt
c_getpriority (CInt
2) (UserID -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UserID
uid)
{-# LINE 392 "libraries/unix/System/Posix/Process/Common.hsc" #-}
return (fromIntegral r)
foreign import ccall unsafe "getpriority"
c_getpriority :: CInt -> CInt -> IO CInt
{-# LINE 398 "libraries/unix/System/Posix/Process/Common.hsc" #-}
setProcessPriority :: ProcessID -> Int -> IO ()
setProcessGroupPriority :: ProcessGroupID -> Int -> IO ()
setUserPriority :: UserID -> Int -> IO ()
{-# LINE 418 "libraries/unix/System/Posix/Process/Common.hsc" #-}
setProcessPriority :: CPid -> Int -> IO ()
setProcessPriority CPid
pid Int
val =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessPriority" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> CInt -> IO CInt
c_setpriority (CInt
0) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val)
{-# LINE 422 "libraries/unix/System/Posix/Process/Common.hsc" #-}
setProcessGroupPriority :: CPid -> Int -> IO ()
setProcessGroupPriority CPid
pid Int
val =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessPriority" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> CInt -> IO CInt
c_setpriority (CInt
1) (CPid -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CPid
pid) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val)
{-# LINE 426 "libraries/unix/System/Posix/Process/Common.hsc" #-}
setUserPriority :: UserID -> Int -> IO ()
setUserPriority UserID
uid Int
val =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setUserPriority" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
CInt -> CInt -> CInt -> IO CInt
c_setpriority (CInt
2) (UserID -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UserID
uid) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val)
{-# LINE 430 "libraries/unix/System/Posix/Process/Common.hsc" #-}
foreign import ccall unsafe "setpriority"
c_setpriority :: CInt -> CInt -> CInt -> IO CInt
{-# LINE 435 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 471 "libraries/unix/System/Posix/Process/Common.hsc" #-}
forkProcess :: IO () -> IO ProcessID
forkProcess :: IO () -> IO CPid
forkProcess IO ()
action = do
MaskingState
mstate <- IO MaskingState
getMaskingState
let action' :: IO ()
action' = case MaskingState
mstate of
MaskingState
Unmasked -> IO () -> IO ()
forall a. IO a -> IO a
unsafeUnmask IO ()
action
MaskingState
MaskedInterruptible -> IO ()
action
MaskingState
MaskedUninterruptible -> IO () -> IO ()
forall a. IO a -> IO a
uninterruptibleMask_ IO ()
action
IO (StablePtr (IO ()))
-> (StablePtr (IO ()) -> IO ())
-> (StablePtr (IO ()) -> IO CPid)
-> IO CPid
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(IO () -> IO (StablePtr (IO ()))
forall a. a -> IO (StablePtr a)
newStablePtr (IO () -> IO ()
forall a. IO a -> IO a
runIO IO ()
action'))
StablePtr (IO ()) -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr
(\StablePtr (IO ())
stable -> String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"forkProcess" (StablePtr (IO ()) -> IO CPid
forkProcessPrim StablePtr (IO ())
stable))
foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CPid
forkProcessWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ProcessID
forkProcessWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO CPid
forkProcessWithUnmask (forall a. IO a -> IO a) -> IO ()
action = IO () -> IO CPid
forkProcess ((forall a. IO a -> IO a) -> IO ()
action IO a -> IO a
forall a. IO a -> IO a
unsafeUnmask)
{-# LINE 497 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 506 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getProcessStatus :: Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus :: Bool -> Bool -> CPid -> IO (Maybe ProcessStatus)
getProcessStatus Bool
block Bool
stopped CPid
pid =
(Ptr CInt -> IO (Maybe ProcessStatus)) -> IO (Maybe ProcessStatus)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe ProcessStatus))
-> IO (Maybe ProcessStatus))
-> (Ptr CInt -> IO (Maybe ProcessStatus))
-> IO (Maybe ProcessStatus)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wstatp -> do
CPid
pid' <- String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"getProcessStatus"
(CPid -> Ptr CInt -> CInt -> IO CPid
c_waitpid CPid
pid Ptr CInt
wstatp (Bool -> Bool -> CInt
waitOptions Bool
block Bool
stopped))
case CPid
pid' of
CPid
0 -> Maybe ProcessStatus -> IO (Maybe ProcessStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessStatus
forall a. Maybe a
Nothing
CPid
_ -> do ProcessStatus
ps <- Ptr CInt -> IO ProcessStatus
readWaitStatus Ptr CInt
wstatp
Maybe ProcessStatus -> IO (Maybe ProcessStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessStatus -> Maybe ProcessStatus
forall a. a -> Maybe a
Just ProcessStatus
ps)
foreign import ccall interruptible "waitpid"
c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
{-# LINE 531 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 543 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getGroupProcessStatus :: Bool
-> Bool
-> ProcessGroupID
-> IO (Maybe (ProcessID, ProcessStatus))
getGroupProcessStatus :: Bool -> Bool -> CPid -> IO (Maybe (CPid, ProcessStatus))
getGroupProcessStatus Bool
block Bool
stopped CPid
pgid =
(Ptr CInt -> IO (Maybe (CPid, ProcessStatus)))
-> IO (Maybe (CPid, ProcessStatus))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (CPid, ProcessStatus)))
-> IO (Maybe (CPid, ProcessStatus)))
-> (Ptr CInt -> IO (Maybe (CPid, ProcessStatus)))
-> IO (Maybe (CPid, ProcessStatus))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
wstatp -> do
CPid
pid <- String -> IO CPid -> IO CPid
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"getGroupProcessStatus"
(CPid -> Ptr CInt -> CInt -> IO CPid
c_waitpid (-CPid
pgid) Ptr CInt
wstatp (Bool -> Bool -> CInt
waitOptions Bool
block Bool
stopped))
case CPid
pid of
CPid
0 -> Maybe (CPid, ProcessStatus) -> IO (Maybe (CPid, ProcessStatus))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CPid, ProcessStatus)
forall a. Maybe a
Nothing
CPid
_ -> do ProcessStatus
ps <- Ptr CInt -> IO ProcessStatus
readWaitStatus Ptr CInt
wstatp
Maybe (CPid, ProcessStatus) -> IO (Maybe (CPid, ProcessStatus))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CPid, ProcessStatus) -> Maybe (CPid, ProcessStatus)
forall a. a -> Maybe a
Just (CPid
pid, ProcessStatus
ps))
{-# LINE 568 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 577 "libraries/unix/System/Posix/Process/Common.hsc" #-}
getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (CPid, ProcessStatus))
getAnyProcessStatus Bool
block Bool
stopped = Bool -> Bool -> CPid -> IO (Maybe (CPid, ProcessStatus))
getGroupProcessStatus Bool
block Bool
stopped CPid
1
{-# LINE 592 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# LINE 594 "libraries/unix/System/Posix/Process/Common.hsc" #-}
waitOptions :: Bool -> Bool -> CInt
waitOptions :: Bool -> Bool -> CInt
waitOptions Bool
False Bool
False = (CInt
1)
{-# LINE 598 "libraries/unix/System/Posix/Process/Common.hsc" #-}
waitOptions False True = (3)
{-# LINE 599 "libraries/unix/System/Posix/Process/Common.hsc" #-}
waitOptions True False = 0
waitOptions Bool
True Bool
True = (CInt
2)
{-# LINE 601 "libraries/unix/System/Posix/Process/Common.hsc" #-}
readWaitStatus :: Ptr CInt -> IO ProcessStatus
readWaitStatus :: Ptr CInt -> IO ProcessStatus
readWaitStatus Ptr CInt
wstatp = do
CInt
wstat <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
wstatp
CInt -> IO ProcessStatus
decipherWaitStatus CInt
wstat
{-# LINE 610 "libraries/unix/System/Posix/Process/Common.hsc" #-}
exitImmediately :: ExitCode -> IO a
exitImmediately :: forall a. ExitCode -> IO a
exitImmediately ExitCode
status = do
()
_ <- CInt -> IO ()
c_exit (ExitCode -> CInt
forall {a}. Num a => ExitCode -> a
exitcode2Int ExitCode
status)
ExitCode -> IO a
forall a. ExitCode -> IO a
exitImmediately ExitCode
status
where
exitcode2Int :: ExitCode -> a
exitcode2Int ExitCode
ExitSuccess = a
0
exitcode2Int (ExitFailure Int
n) = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
foreign import ccall unsafe "exit"
c_exit :: CInt -> IO ()
{-# LINE 649 "libraries/unix/System/Posix/Process/Common.hsc" #-}
{-# DEPRECATED createProcessGroup "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'createProcessGroupFor' instead." #-}
createProcessGroup :: ProcessID -> IO ProcessGroupID
createProcessGroup :: CPid -> IO CPid
createProcessGroup CPid
pid = do
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"createProcessGroup" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
0)
CPid -> IO CPid
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CPid
pid
{-# DEPRECATED setProcessGroupID "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'setProcessGroupIDOf' instead." #-}
setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
setProcessGroupID :: CPid -> CPid -> IO ()
setProcessGroupID CPid
pid CPid
pgid =
String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setProcessGroupID" (CPid -> CPid -> IO CInt
c_setpgid CPid
pid CPid
pgid)
{-# LINE 677 "libraries/unix/System/Posix/Process/Common.hsc" #-}