{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessStatus -> ProcessStatus -> Bool
$c/= :: ProcessStatus -> ProcessStatus -> Bool
== :: ProcessStatus -> ProcessStatus -> Bool
$c== :: ProcessStatus -> ProcessStatus -> Bool
Eq, Eq 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
min :: ProcessStatus -> ProcessStatus -> ProcessStatus
$cmin :: ProcessStatus -> ProcessStatus -> ProcessStatus
max :: ProcessStatus -> ProcessStatus -> ProcessStatus
$cmax :: ProcessStatus -> ProcessStatus -> ProcessStatus
>= :: ProcessStatus -> ProcessStatus -> Bool
$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
compare :: ProcessStatus -> ProcessStatus -> Ordering
$ccompare :: ProcessStatus -> ProcessStatus -> Ordering
Ord, Int -> ProcessStatus -> ShowS
[ProcessStatus] -> ShowS
ProcessStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessStatus] -> ShowS
$cshowList :: [ProcessStatus] -> ShowS
show :: ProcessStatus -> String
$cshow :: ProcessStatus -> String
showsPrec :: Int -> ProcessStatus -> ShowS
$cshowsPrec :: Int -> 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 forall a. Eq a => a -> a -> Bool
/= CInt
0
      then do
        let exitstatus :: CInt
exitstatus = CInt -> CInt
c_WEXITSTATUS CInt
wstat
        if CInt
exitstatus forall a. Eq a => a -> a -> Bool
== CInt
0
           then forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessStatus
Exited ExitCode
ExitSuccess)
           else forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> ProcessStatus
Exited (Int -> ExitCode
ExitFailure (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
exitstatus)))
      else do
        if CInt -> CInt
c_WIFSIGNALED CInt
wstat 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 forall a. Eq a => a -> a -> Bool
/= CInt
0
                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 forall a. Eq a => a -> a -> Bool
/= CInt
0
                   then do
                        let stopsig :: CInt
stopsig = CInt -> CInt
c_WSTOPSIG CInt
wstat
                        forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> ProcessStatus
Stopped CInt
stopsig)
                   else do
                        forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
illegalOperationErrorType
                                   String
"waitStatus" forall a. Maybe a
Nothing 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