An API for inter-process communication via Handles

This commit adds the System.Process.CommunicationHandle module, which
provides the cross-platform CommunicationHandle abstraction which allows
Handles to be passed to child processes for inter-process communication.

A high-level API is provided by the function
`readCreateProcessWithExitCodeCommunicationHandle`, which can be
consulted for further details about how the functionality is meant to be
used.

To test this functionality, we created a new "cli-child" executable
component to the library. To work around Cabal bug #9854, it was
necessary to change the build-type of the library to `Custom`, in order
to make the "cli-child" executable visible when running the test-suite.
The custom Setup.hs script contains more details about the problem.

Author: sheaf

Setup.hs

@@ -1,6 +1,82 @@
+{-# OPTIONS_GHC -Wall #-}
+
 module Main (main) where
 
+-- Cabal
 import Distribution.Simple
+  ( defaultMainWithHooks
+  , autoconfUserHooks
+  , UserHooks(buildHook)
+  )
+import Distribution.Simple.BuildPaths
+  ( autogenComponentModulesDir
+  , exeExtension
+  )
+import Distribution.Simple.LocalBuildInfo
+  ( hostPlatform
+  , buildDir
+  , withTestLBI
+  )
+import Distribution.Types.LocalBuildInfo
+  ( LocalBuildInfo
+  , allTargetsInBuildOrder'
+  )
+import Distribution.Types.Component
+  ( Component(CExe) )
+import Distribution.Types.Executable
+  ( Executable(exeName) )
+import Distribution.Types.PackageDescription
+  ( PackageDescription )
+import Distribution.Types.TargetInfo
+  ( targetComponent )
+import Distribution.Types.UnqualComponentName
+  ( unUnqualComponentName )
+
+-- directory
+import System.Directory
+  ( createDirectoryIfMissing )
+
+-- filepath
+import System.FilePath
+  ( (</>), (<.>), takeDirectory )
+
+--------------------------------------------------------------------------------
 
 main :: IO ()
-main = defaultMainWithHooks autoconfUserHooks
+main = defaultMainWithHooks processHooks
+
+-- The following code works around Cabal bug #9854.
+--
+-- The process package has an executable component named "cli-child",
+-- used for testing. We want to invoke this executable when running tests;
+-- however, due to the Cabal bug this executable does not get added to PATH.
+-- To fix this, we create a "Test.Paths" module in a Custom setup script,
+-- which contains paths to executables used for testing.
+processHooks :: UserHooks
+processHooks =
+  defaultConfigureHooks
+    { buildHook = \ pd lbi userHooks buildFlags ->
+        withTestLBI pd lbi $ \ _testSuite clbi -> do
+          let pathsFile = autogenComponentModulesDir lbi clbi </> "Test" </> "Paths" <.> "hs"
+          createDirectoryIfMissing True (takeDirectory pathsFile)
+          writeFile pathsFile $ unlines
+            [ "module Test.Paths where"
+            , "processInternalExes :: [(String, FilePath)]"
+            , "processInternalExes = " ++ show (processInternalExes pd lbi)
+            ]
+          buildHook defaultConfigureHooks pd lbi userHooks buildFlags
+    }
+
+defaultConfigureHooks :: UserHooks
+defaultConfigureHooks = autoconfUserHooks
+
+processInternalExes :: PackageDescription -> LocalBuildInfo -> [(String, FilePath)]
+processInternalExes pd lbi =
+  [ (toolName, toolLocation)
+  | tgt <- allTargetsInBuildOrder' pd lbi
+  , CExe exe <- [targetComponent tgt]
+  , let toolName = unUnqualComponentName $ exeName exe
+        toolLocation =
+          buildDir lbi
+            </> (toolName </> toolName <.> exeExtension (hostPlatform lbi))
+  ]

System/Process.hs

@@ -89,11 +89,11 @@ import System.Process.Internals
 
 import Control.Concurrent
 import Control.DeepSeq (rnf)
-import Control.Exception (SomeException, mask
+import Control.Exception (
 #if !defined(javascript_HOST_ARCH)
-                         , allowInterrupt
+                           allowInterrupt,
 #endif
-                         , bracket, try, throwIO)
+                           bracket)
 import qualified Control.Exception as C
 import Control.Monad
 import Data.Maybe
@@ -112,7 +112,7 @@ import System.Posix.Process (getProcessID)
 import System.Posix.Types (CPid (..))
 #endif
 
-import GHC.IO.Exception ( ioException, IOErrorType(..), IOException(..) )
+import GHC.IO.Exception ( ioException, IOErrorType(..) )
 
 #if defined(wasm32_HOST_ARCH)
 import GHC.IO.Exception ( unsupportedOperation )
@@ -616,28 +616,6 @@ readCreateProcessWithExitCode cp input = do
           (_,Nothing,_) -> error "readCreateProcessWithExitCode: Failed to get a stdout handle."
           (_,_,Nothing) -> error "readCreateProcessWithExitCode: Failed to get a stderr handle."
 
--- | Fork a thread while doing something else, but kill it if there's an
--- exception.
---
--- This is important in the cases above 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.
---
-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) `C.onException` killThread tid
-
-ignoreSigPipe :: IO () -> IO ()
-ignoreSigPipe = C.handle $ \e -> case e of
-                                   IOError { ioe_type  = ResourceVanished
-                                           , ioe_errno = Just ioe }
-                                     | Errno ioe == ePIPE -> return ()
-                                   _ -> throwIO e
-
 -- ----------------------------------------------------------------------------
 -- showCommandForUser