{-# LANGUAGE RecordWildCards #-}
-- |
-- Module      : System.Process.Extra
-- Copyright   : [2017..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module System.Process.Extra
  where

-- standard library
import Control.Concurrent
import Control.Exception
import Foreign.C                                                    ( Errno(..), ePIPE )
import GHC.IO.Exception                                             ( IOErrorType(..), IOException(..) )


-- | Fork a thread while doing something else, but kill it if there's an
-- exception.
--
-- This is important because we want to kill the thread that is holding the
-- Handle lock, because when we clean up the process we try to close that
-- handle, which could otherwise deadlock.
--
-- Stolen from the 'process' package.
--
withForkWait :: IO () -> (IO () -> IO a) -> IO a
withForkWait :: IO () -> (IO () -> IO a) -> IO a
withForkWait IO ()
async IO () -> IO a
body = do
  MVar (Either SomeException ())
waitVar <- IO (MVar (Either SomeException ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either SomeException ()))
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO ()
forall a. IO a -> IO a
restore IO ()
async) IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Either SomeException ()) -> Either SomeException () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException ())
waitVar
    let wait :: IO ()
wait = MVar (Either SomeException ()) -> IO (Either SomeException ())
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException ())
waitVar IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return
    IO a -> IO a
forall a. IO a -> IO a
restore (IO () -> IO a
body IO ()
wait) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` ThreadId -> IO ()
killThread ThreadId
tid

ignoreSIGPIPE :: IO () -> IO ()
ignoreSIGPIPE :: IO () -> IO ()
ignoreSIGPIPE =
  (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((IOException -> IO ()) -> IO () -> IO ())
-> (IOException -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
e ->
    case IOException
e of
      IOError{String
Maybe String
Maybe CInt
Maybe Handle
IOErrorType
ioe_handle :: IOException -> Maybe Handle
ioe_type :: IOException -> IOErrorType
ioe_location :: IOException -> String
ioe_description :: IOException -> String
ioe_errno :: IOException -> Maybe CInt
ioe_filename :: IOException -> Maybe String
ioe_filename :: Maybe String
ioe_errno :: Maybe CInt
ioe_description :: String
ioe_location :: String
ioe_type :: IOErrorType
ioe_handle :: Maybe Handle
..} | IOErrorType
ResourceVanished <- IOErrorType
ioe_type
                  , Just CInt
ioe         <- Maybe CInt
ioe_errno
                  , CInt -> Errno
Errno CInt
ioe Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
ePIPE
                  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      IOException
_ -> IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e