{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Streamly.Internal.System.Process.Posix
(
Process
, newProcess
, wait
, getStatus
, mkPipe
, mkStdioPipes
)
where
import Control.Concurrent
(MVar, newMVar, readMVar, withMVar, modifyMVar, modifyMVar_)
import Control.Exception (catch, throwIO, Exception(..), onException)
import Control.Monad (void)
import Data.Bifunctor (first)
import Data.Tuple (swap)
import GHC.IO.Device (IODeviceType(..))
import GHC.IO.Encoding (getLocaleEncoding)
import GHC.IO.Handle.FD (mkHandleFromFD)
import System.IO (IOMode(..), Handle)
import System.IO.Error (isDoesNotExistError)
import System.Posix.IO (createPipe, dupTo, closeFd)
import System.Posix.Process (forkProcess, executeFile, ProcessStatus)
import System.Posix.Types (ProcessID, Fd(..), CDev, CIno)
import System.Posix.Internals (fdGetMode)
import qualified GHC.IO.FD as FD
import qualified System.Posix.Process as Posix
setBinaryMode :: FD.FD -> IO ()
#if defined(mingw32_HOST_OS)
setBinaryMode fd = do
_ <- setmode (FD.fdFD fd) True
return ()
#else
setBinaryMode :: FD -> IO ()
setBinaryMode FD
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif
stdioFdToHandle ::
Bool -> Maybe IOMode -> Maybe (IODeviceType, CDev, CIno) -> Fd -> IO Handle
stdioFdToHandle :: Bool
-> Maybe IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Fd
-> IO Handle
stdioFdToHandle Bool
binary Maybe IOMode
mbIOMode Maybe (IODeviceType, CDev, CIno)
mbStat (Fd CInt
fdint) = do
IOMode
iomode <-
case Maybe IOMode
mbIOMode of
Just IOMode
mode -> IOMode -> IO IOMode
forall (m :: * -> *) a. Monad m => a -> m a
return IOMode
mode
Maybe IOMode
Nothing -> CInt -> IO IOMode
fdGetMode CInt
fdint
(FD
fd, IODeviceType
fd_type) <- CInt
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD CInt
fdint IOMode
iomode Maybe (IODeviceType, CDev, CIno)
mbStat
Bool
False
Bool
False
FD -> IO ()
setBinaryMode FD
fd
Maybe TextEncoding
enc <- if Bool
binary then Maybe TextEncoding -> IO (Maybe TextEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextEncoding
forall a. Maybe a
Nothing else (TextEncoding -> Maybe TextEncoding)
-> IO TextEncoding -> IO (Maybe TextEncoding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding
let fd_str :: [Char]
fd_str = [Char]
"<stdioFdToHandle file descriptor: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FD -> [Char]
forall a. Show a => a -> [Char]
show FD
fd [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">"
FD
-> IODeviceType
-> [Char]
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fd IODeviceType
fd_type [Char]
fd_str IOMode
iomode Bool
True Maybe TextEncoding
enc
data Direction = ParentToChild | ChildToParent deriving (Int -> Direction -> [Char] -> [Char]
[Direction] -> [Char] -> [Char]
Direction -> [Char]
(Int -> Direction -> [Char] -> [Char])
-> (Direction -> [Char])
-> ([Direction] -> [Char] -> [Char])
-> Show Direction
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Direction] -> [Char] -> [Char]
$cshowList :: [Direction] -> [Char] -> [Char]
show :: Direction -> [Char]
$cshow :: Direction -> [Char]
showsPrec :: Int -> Direction -> [Char] -> [Char]
$cshowsPrec :: Int -> Direction -> [Char] -> [Char]
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq)
mkPipe :: Direction -> IO (Fd, Fd, (IO (), IO (), IO ()))
mkPipe :: Direction -> IO (Fd, Fd, (IO (), IO (), IO ()))
mkPipe Direction
direction = do
let setDirection :: (a, a) -> (a, a)
setDirection = if Direction
direction Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
ParentToChild then (a, a) -> (a, a)
forall a. a -> a
id else (a, a) -> (a, a)
forall a b. (a, b) -> (b, a)
swap
(Fd
child, Fd
parent) <- ((Fd, Fd) -> (Fd, Fd)) -> IO (Fd, Fd) -> IO (Fd, Fd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Fd, Fd) -> (Fd, Fd)
forall a. (a, a) -> (a, a)
setDirection IO (Fd, Fd)
createPipe
let parentAction :: IO ()
parentAction = Fd -> IO ()
closeFd Fd
child
childAction :: IO ()
childAction = Fd -> IO ()
closeFd Fd
parent
failureAction :: IO ()
failureAction = Fd -> IO ()
closeFd Fd
child IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fd -> IO ()
closeFd Fd
parent
(Fd, Fd, (IO (), IO (), IO ()))
-> IO (Fd, Fd, (IO (), IO (), IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Fd
parent, Fd
child, (IO ()
parentAction, IO ()
childAction, IO ()
failureAction))
mkPipeDupChild :: Direction -> Fd -> IO (Fd, (IO (), IO (), IO ()))
mkPipeDupChild :: Direction -> Fd -> IO (Fd, (IO (), IO (), IO ()))
mkPipeDupChild Direction
direction Fd
childFd = do
let setDirection :: (a, a) -> (a, a)
setDirection = if Direction
direction Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
ParentToChild then (a, a) -> (a, a)
forall a. a -> a
id else (a, a) -> (a, a)
forall a b. (a, b) -> (b, a)
swap
(Fd
child, Fd
parent) <- ((Fd, Fd) -> (Fd, Fd)) -> IO (Fd, Fd) -> IO (Fd, Fd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Fd, Fd) -> (Fd, Fd)
forall a. (a, a) -> (a, a)
setDirection IO (Fd, Fd)
createPipe
let parentAction :: IO ()
parentAction = Fd -> IO ()
closeFd Fd
child
childAction :: IO ()
childAction =
Fd -> IO ()
closeFd Fd
parent IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Fd -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Fd -> Fd -> IO Fd
dupTo Fd
child Fd
childFd) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fd -> IO ()
closeFd Fd
child
failureAction :: IO ()
failureAction = Fd -> IO ()
closeFd Fd
child IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fd -> IO ()
closeFd Fd
parent
(Fd, (IO (), IO (), IO ())) -> IO (Fd, (IO (), IO (), IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Fd
parent, (IO ()
parentAction, IO ()
childAction, IO ()
failureAction))
mkStdioPipes :: Bool -> IO ((Handle, Handle, Maybe Handle, Handle, Handle), IO (), IO (), IO ())
mkStdioPipes :: Bool
-> IO
((Handle, Handle, Maybe Handle, Handle, Handle), IO (), IO (),
IO ())
mkStdioPipes Bool
pipeStdErr = do
(Fd
inp, (IO ()
inpParent, IO ()
inpChild, IO ()
inpFail)) <- Direction -> Fd -> IO (Fd, (IO (), IO (), IO ()))
mkPipeDupChild Direction
ParentToChild Fd
0
(Fd
out, (IO ()
outParent, IO ()
outChild, IO ()
outFail)) <- Direction -> Fd -> IO (Fd, (IO (), IO (), IO ()))
mkPipeDupChild Direction
ChildToParent Fd
1
IO (Fd, (IO (), IO (), IO ()))
-> IO () -> IO (Fd, (IO (), IO (), IO ()))
forall a b. IO a -> IO b -> IO a
`onException` IO ()
inpFail
(Maybe Fd
err, (IO ()
errParent, IO ()
errChild, IO ()
errFail)) <-
if Bool
pipeStdErr
then (Fd -> Maybe Fd)
-> (Fd, (IO (), IO (), IO ())) -> (Maybe Fd, (IO (), IO (), IO ()))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Fd -> Maybe Fd
forall a. a -> Maybe a
Just ((Fd, (IO (), IO (), IO ())) -> (Maybe Fd, (IO (), IO (), IO ())))
-> IO (Fd, (IO (), IO (), IO ()))
-> IO (Maybe Fd, (IO (), IO (), IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Direction -> Fd -> IO (Fd, (IO (), IO (), IO ()))
mkPipeDupChild Direction
ChildToParent Fd
2
IO (Fd, (IO (), IO (), IO ()))
-> IO () -> IO (Fd, (IO (), IO (), IO ()))
forall a b. IO a -> IO b -> IO a
`onException` (IO ()
inpFail IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
outFail)
else (Maybe Fd, (IO (), IO (), IO ()))
-> IO (Maybe Fd, (IO (), IO (), IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Fd
forall a. Maybe a
Nothing, (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
let parentAction :: IO ()
parentAction = IO ()
inpParent IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
outParent IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
errParent
childAction :: IO ()
childAction = IO ()
inpChild IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
outChild IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
errChild
failureAction :: IO ()
failureAction = IO ()
inpFail IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
outFail IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
errFail
Handle
inpH <- IOMode -> Fd -> IO Handle
toHandle IOMode
WriteMode Fd
inp
Handle
outH <- IOMode -> Fd -> IO Handle
toHandle IOMode
ReadMode Fd
out
Maybe Handle
errH <-
case Maybe Fd
err of
Just Fd
x -> Handle -> Maybe Handle
forall a. a -> Maybe a
Just (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMode -> Fd -> IO Handle
toHandle IOMode
ReadMode Fd
x
Maybe Fd
Nothing -> Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
Nothing
let ehParent :: a
ehParent = a
forall a. HasCallStack => a
undefined
let ehChild :: a
ehChild = a
forall a. HasCallStack => a
undefined
((Handle, Handle, Maybe Handle, Handle, Handle), IO (), IO (),
IO ())
-> IO
((Handle, Handle, Maybe Handle, Handle, Handle), IO (), IO (),
IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ( (Handle
inpH, Handle
outH, Maybe Handle
errH, Handle
forall a. a
ehParent, Handle
forall a. a
ehChild)
, IO ()
parentAction
, IO ()
childAction
, IO ()
failureAction
)
where
toHandle :: IOMode -> Fd -> IO Handle
toHandle IOMode
mode = Bool
-> Maybe IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Fd
-> IO Handle
stdioFdToHandle Bool
False (IOMode -> Maybe IOMode
forall a. a -> Maybe a
Just IOMode
mode) ((IODeviceType, CDev, CIno) -> Maybe (IODeviceType, CDev, CIno)
forall a. a -> Maybe a
Just (IODeviceType
Stream, CDev
0, CIno
0))
data Process =
Process
ProcessID
(MVar ())
(MVar (Maybe ProcessStatus))
pidToProcess :: ProcessID -> Maybe ProcessStatus -> IO Process
pidToProcess :: ProcessID -> Maybe ProcessStatus -> IO Process
pidToProcess ProcessID
pid Maybe ProcessStatus
status = do
MVar ()
waitLock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
MVar (Maybe ProcessStatus)
st <- Maybe ProcessStatus -> IO (MVar (Maybe ProcessStatus))
forall a. a -> IO (MVar a)
newMVar Maybe ProcessStatus
status
Process -> IO Process
forall (m :: * -> *) a. Monad m => a -> m a
return (Process -> IO Process) -> Process -> IO Process
forall a b. (a -> b) -> a -> b
$ ProcessID -> MVar () -> MVar (Maybe ProcessStatus) -> Process
Process ProcessID
pid MVar ()
waitLock MVar (Maybe ProcessStatus)
st
newProcess ::
IO ()
-> FilePath
-> [String]
-> Maybe [(String, String)]
-> IO Process
newProcess :: IO ()
-> [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> IO Process
newProcess IO ()
action [Char]
path [[Char]]
args Maybe [([Char], [Char])]
env = do
ProcessID
pid <- IO () -> IO ProcessID
forkProcess IO ()
forall b. IO b
exec
ProcessID -> Maybe ProcessStatus -> IO Process
pidToProcess ProcessID
pid Maybe ProcessStatus
forall a. Maybe a
Nothing
where
exec :: IO b
exec = IO ()
action IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Bool -> [[Char]] -> Maybe [([Char], [Char])] -> IO b
forall a.
[Char] -> Bool -> [[Char]] -> Maybe [([Char], [Char])] -> IO a
executeFile [Char]
path Bool
True [[Char]]
args Maybe [([Char], [Char])]
env
newtype ProcessDoesNotExist = ProcessDoesNotExist ProcessID deriving Int -> ProcessDoesNotExist -> [Char] -> [Char]
[ProcessDoesNotExist] -> [Char] -> [Char]
ProcessDoesNotExist -> [Char]
(Int -> ProcessDoesNotExist -> [Char] -> [Char])
-> (ProcessDoesNotExist -> [Char])
-> ([ProcessDoesNotExist] -> [Char] -> [Char])
-> Show ProcessDoesNotExist
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [ProcessDoesNotExist] -> [Char] -> [Char]
$cshowList :: [ProcessDoesNotExist] -> [Char] -> [Char]
show :: ProcessDoesNotExist -> [Char]
$cshow :: ProcessDoesNotExist -> [Char]
showsPrec :: Int -> ProcessDoesNotExist -> [Char] -> [Char]
$cshowsPrec :: Int -> ProcessDoesNotExist -> [Char] -> [Char]
Show
instance Exception ProcessDoesNotExist where
displayException :: ProcessDoesNotExist -> [Char]
displayException (ProcessDoesNotExist ProcessID
pid) =
[Char]
"Bug: Process with pid " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ProcessID -> [Char]
forall a. Show a => a -> [Char]
show ProcessID
pid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" does not exist."
wait :: Process -> IO ProcessStatus
wait :: Process -> IO ProcessStatus
wait (Process ProcessID
pid MVar ()
waitLock MVar (Maybe ProcessStatus)
procStatus) = do
Maybe ProcessStatus
status <- MVar (Maybe ProcessStatus) -> IO (Maybe ProcessStatus)
forall a. MVar a -> IO a
readMVar MVar (Maybe ProcessStatus)
procStatus
case Maybe ProcessStatus
status of
Just ProcessStatus
st -> ProcessStatus -> IO ProcessStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessStatus
st
Maybe ProcessStatus
Nothing -> MVar () -> (() -> IO ProcessStatus) -> IO ProcessStatus
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
waitLock ((() -> IO ProcessStatus) -> IO ProcessStatus)
-> (() -> IO ProcessStatus) -> IO ProcessStatus
forall a b. (a -> b) -> a -> b
$ \() -> IO ProcessStatus
waitStatus IO ProcessStatus
-> (IOError -> IO ProcessStatus) -> IO ProcessStatus
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO ProcessStatus
eChild
where
waitStatus :: IO ProcessStatus
waitStatus = do
Maybe ProcessStatus
st <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
Posix.getProcessStatus Bool
True Bool
False ProcessID
pid
case Maybe ProcessStatus
st of
Maybe ProcessStatus
Nothing -> [Char] -> IO ProcessStatus
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ProcessStatus) -> [Char] -> IO ProcessStatus
forall a b. (a -> b) -> a -> b
$ [Char]
"wait: Bug: Posix.getProcessStatus "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"returned Nothing in blocking mode"
Just ProcessStatus
s -> do
MVar (Maybe ProcessStatus)
-> (Maybe ProcessStatus -> IO (Maybe ProcessStatus)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Maybe ProcessStatus)
procStatus ((Maybe ProcessStatus -> IO (Maybe ProcessStatus)) -> IO ())
-> (Maybe ProcessStatus -> IO (Maybe ProcessStatus)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe ProcessStatus
_ -> Maybe ProcessStatus -> IO (Maybe ProcessStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessStatus
st
ProcessStatus -> IO ProcessStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessStatus
s
eChild :: IOError -> IO ProcessStatus
eChild IOError
e = do
if IOError -> Bool
isDoesNotExistError IOError
e
then do
Maybe ProcessStatus
st <- MVar (Maybe ProcessStatus) -> IO (Maybe ProcessStatus)
forall a. MVar a -> IO a
readMVar MVar (Maybe ProcessStatus)
procStatus
case Maybe ProcessStatus
st of
Maybe ProcessStatus
Nothing -> ProcessDoesNotExist -> IO ProcessStatus
forall e a. Exception e => e -> IO a
throwIO (ProcessDoesNotExist -> IO ProcessStatus)
-> ProcessDoesNotExist -> IO ProcessStatus
forall a b. (a -> b) -> a -> b
$ ProcessID -> ProcessDoesNotExist
ProcessDoesNotExist ProcessID
pid
Just ProcessStatus
s -> ProcessStatus -> IO ProcessStatus
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessStatus
s
else IOError -> IO ProcessStatus
forall e a. Exception e => e -> IO a
throwIO IOError
e
getStatus :: Process -> IO (Maybe ProcessStatus)
getStatus :: Process -> IO (Maybe ProcessStatus)
getStatus proc :: Process
proc@(Process ProcessID
pid MVar ()
_ MVar (Maybe ProcessStatus)
procStatus) = do
Maybe (Maybe ProcessStatus)
r <- MVar (Maybe ProcessStatus)
-> (Maybe ProcessStatus
-> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus)))
-> IO (Maybe (Maybe ProcessStatus))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar
MVar (Maybe ProcessStatus)
procStatus
((Maybe ProcessStatus
-> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus)))
-> IO (Maybe (Maybe ProcessStatus)))
-> (Maybe ProcessStatus
-> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus)))
-> IO (Maybe (Maybe ProcessStatus))
forall a b. (a -> b) -> a -> b
$ \Maybe ProcessStatus
old ->
case Maybe ProcessStatus
old of
Just ProcessStatus
_ -> (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
-> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ProcessStatus
old, Maybe ProcessStatus -> Maybe (Maybe ProcessStatus)
forall a. a -> Maybe a
Just Maybe ProcessStatus
old)
Maybe ProcessStatus
Nothing -> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
fetchStatus IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
-> (IOError
-> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus)))
-> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` IOError -> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
forall a a. IOError -> IO (Maybe a, Maybe a)
eChild
case Maybe (Maybe ProcessStatus)
r of
Just Maybe ProcessStatus
st -> Maybe ProcessStatus -> IO (Maybe ProcessStatus)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessStatus
st
Maybe (Maybe ProcessStatus)
Nothing -> ProcessStatus -> Maybe ProcessStatus
forall a. a -> Maybe a
Just (ProcessStatus -> Maybe ProcessStatus)
-> IO ProcessStatus -> IO (Maybe ProcessStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Process -> IO ProcessStatus
wait Process
proc
where
fetchStatus :: IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
fetchStatus = do
Maybe ProcessStatus
st <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
Posix.getProcessStatus Bool
False Bool
False ProcessID
pid
(Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
-> IO (Maybe ProcessStatus, Maybe (Maybe ProcessStatus))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ProcessStatus
st, Maybe ProcessStatus -> Maybe (Maybe ProcessStatus)
forall a. a -> Maybe a
Just Maybe ProcessStatus
st)
eChild :: IOError -> IO (Maybe a, Maybe a)
eChild IOError
e = do
if IOError -> Bool
isDoesNotExistError IOError
e
then (Maybe a, Maybe a) -> IO (Maybe a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
else IOError -> IO (Maybe a, Maybe a)
forall e a. Exception e => e -> IO a
throwIO IOError
e