{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE Trustworthy #-}

module System.Posix.Process.Internals (
       pPrPr_disableITimers, c_execvpe,
       decipherWaitStatus, ProcessStatus(..) ) where

import Foreign
import Foreign.C
import System.Exit
import System.IO.Error
import GHC.Conc (Signal)

-- | The exit status of a process
data ProcessStatus
   = Exited ExitCode        -- ^ the process exited by calling
                            -- @exit()@ or returning from @main@
   | Terminated Signal Bool -- ^ the process was terminated by a
                            -- signal, the @Bool@ is @True@ if a core
                            -- dump was produced
                            --
                            -- @since 2.7.0.0
   | Stopped Signal         -- ^ the process was stopped by a signal
   deriving (ProcessStatus -> ProcessStatus -> Bool
(ProcessStatus -> ProcessStatus -> Bool)
-> (ProcessStatus -> ProcessStatus -> Bool) -> Eq ProcessStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcessStatus -> ProcessStatus -> Bool
== :: ProcessStatus -> ProcessStatus -> Bool
$c/= :: ProcessStatus -> ProcessStatus -> Bool
/= :: ProcessStatus -> ProcessStatus -> Bool
Eq, Eq ProcessStatus
Eq ProcessStatus
-> (ProcessStatus -> ProcessStatus -> Ordering)
-> (ProcessStatus -> ProcessStatus -> Bool)
-> (ProcessStatus -> ProcessStatus -> Bool)
-> (ProcessStatus -> ProcessStatus -> Bool)
-> (ProcessStatus -> ProcessStatus -> Bool)
-> (ProcessStatus -> ProcessStatus -> ProcessStatus)
-> (ProcessStatus -> ProcessStatus -> ProcessStatus)
-> Ord ProcessStatus
ProcessStatus -> ProcessStatus -> Bool
ProcessStatus -> ProcessStatus -> Ordering
ProcessStatus -> ProcessStatus -> ProcessStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProcessStatus -> ProcessStatus -> Ordering
compare :: ProcessStatus -> ProcessStatus -> Ordering
$c< :: ProcessStatus -> ProcessStatus -> Bool
< :: ProcessStatus -> ProcessStatus -> Bool
$c<= :: ProcessStatus -> ProcessStatus -> Bool
<= :: ProcessStatus -> ProcessStatus -> Bool
$c> :: ProcessStatus -> ProcessStatus -> Bool
> :: ProcessStatus -> ProcessStatus -> Bool
$c>= :: ProcessStatus -> ProcessStatus -> Bool
>= :: ProcessStatus -> ProcessStatus -> Bool
$cmax :: ProcessStatus -> ProcessStatus -> ProcessStatus
max :: ProcessStatus -> ProcessStatus -> ProcessStatus
$cmin :: ProcessStatus -> ProcessStatus -> ProcessStatus
min :: ProcessStatus -> ProcessStatus -> ProcessStatus
Ord, Int -> ProcessStatus -> ShowS
[ProcessStatus] -> ShowS
ProcessStatus -> String
(Int -> ProcessStatus -> ShowS)
-> (ProcessStatus -> String)
-> ([ProcessStatus] -> ShowS)
-> Show ProcessStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessStatus -> ShowS
showsPrec :: Int -> ProcessStatus -> ShowS
$cshow :: ProcessStatus -> String
show :: ProcessStatus -> String
$cshowList :: [ProcessStatus] -> ShowS
showList :: [ProcessStatus] -> ShowS
Show)

-- this function disables the itimer, which would otherwise cause confusing
-- signals to be sent to the new process.
foreign import capi unsafe "Rts.h stopTimer"
  pPrPr_disableITimers :: IO ()

foreign import ccall unsafe "__hsunix_execvpe"
  c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt

decipherWaitStatus :: CInt -> IO ProcessStatus
decipherWaitStatus :: CInt -> IO ProcessStatus
decipherWaitStatus CInt
wstat =
  if CInt -> CInt
c_WIFEXITED CInt
wstat CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
      then do
        let exitstatus :: CInt
exitstatus = CInt -> CInt
c_WEXITSTATUS CInt
wstat
        if CInt
exitstatus CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
           then ProcessStatus -> IO ProcessStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessStatus
Exited ExitCode
ExitSuccess)
           else ProcessStatus -> IO ProcessStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessStatus
Exited (Int -> ExitCode
ExitFailure (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
exitstatus)))
      else do
        if CInt -> CInt
c_WIFSIGNALED CInt
wstat CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
           then do
                let termsig :: CInt
termsig    = CInt -> CInt
c_WTERMSIG CInt
wstat
                let coredumped :: Bool
coredumped = CInt -> CInt
c_WCOREDUMP CInt
wstat CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
                ProcessStatus -> IO ProcessStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Bool -> ProcessStatus
Terminated CInt
termsig Bool
coredumped)
           else do
                if CInt -> CInt
c_WIFSTOPPED CInt
wstat CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
                   then do
                        let stopsig :: CInt
stopsig = CInt -> CInt
c_WSTOPSIG CInt
wstat
                        ProcessStatus -> IO ProcessStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ProcessStatus
Stopped CInt
stopsig)
                   else do
                        IOError -> IO ProcessStatus
forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
illegalOperationErrorType
                                   String
"waitStatus" Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)


foreign import capi unsafe "HsUnix.h WIFEXITED"
  c_WIFEXITED :: CInt -> CInt

foreign import capi unsafe "HsUnix.h WEXITSTATUS"
  c_WEXITSTATUS :: CInt -> CInt

foreign import capi unsafe "HsUnix.h WIFSIGNALED"
  c_WIFSIGNALED :: CInt -> CInt

foreign import capi unsafe "HsUnix.h WTERMSIG"
  c_WTERMSIG :: CInt -> CInt

foreign import capi unsafe "HsUnix.h WIFSTOPPED"
  c_WIFSTOPPED :: CInt -> CInt

foreign import capi unsafe "HsUnix.h WSTOPSIG"
  c_WSTOPSIG :: CInt -> CInt

foreign import capi unsafe "HsUnix.h WCOREDUMP"
  c_WCOREDUMP :: CInt -> CInt