content: {-# 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 async body = do
    waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
    mask $ \restore -> do
      tid <- forkIO $ try (restore async) >>= putMVar waitVar
      let wait = takeMVar waitVar >>= either throwIO return
      restore (body wait) `onException` killThread tid
  
  ignoreSIGPIPE :: IO () -> IO ()
  ignoreSIGPIPE =
    handle $ \e ->
      case e of
        IOError{..} | ResourceVanished <- ioe_type
                    , Just ioe         <- ioe_errno
                    , Errno ioe == ePIPE
                    -> return ()
        _ -> throwIO e
  
  