[commit: packages/process] master: Improve the code for ignoring EPIPE (#2233) (79ae975)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/process

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/79ae975aab5866de38e1a01aca7ac5bd9cde2285/process

>---------------------------------------------------------------

commit 79ae975aab5866de38e1a01aca7ac5bd9cde2285
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Mon Nov 25 23:09:13 2013 +0000

    Improve the code for ignoring EPIPE (#2233)
    
    Factor it out into an ignoreSigPipe util, and use it in both
    readProcess and readProcessWithExitCode.
    
    Authored-by: Duncan Coutts <duncan at well-typed.com>
    Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>


>---------------------------------------------------------------

79ae975aab5866de38e1a01aca7ac5bd9cde2285
 System/Process.hs |   33 +++++++++++++++++----------------
 1 file changed, 17 insertions(+), 16 deletions(-)

diff --git a/System/Process.hs b/System/Process.hs
index 6ffa8e9..5f4e7d1 100644
--- a/System/Process.hs
+++ b/System/Process.hs
@@ -426,7 +426,9 @@ readProcess cmd args input = do
         waitOut <- forkWait $ C.evaluate $ rnf output
 
         -- now write and flush any input
-        when (not (null input)) $ do hPutStr inh input; hFlush inh
+        unless (null input) $ do
+          ignoreSigPipe $ hPutStr inh input
+          hFlush inh
         hClose inh -- done with stdin
 
         -- wait on the output
@@ -484,21 +486,10 @@ readProcessWithExitCode cmd args input = do
         waitErr <- forkWait $ C.evaluate $ rnf err
 
         -- now write and flush any input
-        let writeInput = do
-              unless (null input) $ do
-                hPutStr inh input
-                hFlush inh
-              hClose inh
-
-#if defined(__GLASGOW_HASKELL__)
-        C.catch writeInput $ \e -> case e of
-          IOError { ioe_type = ResourceVanished
-                  , ioe_errno = Just ioe }
-            | Errno ioe == ePIPE -> return ()
-          _ -> throwIO e
-#else
-        writeInput
-#endif
+        unless (null input) $ do
+          ignoreSigPipe $ hPutStr inh input
+          hFlush inh
+        hClose inh
 
         -- wait on the output
         waitOut
@@ -518,6 +509,16 @@ forkWait a = do
   _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res
   return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)
 
+ignoreSigPipe :: IO () -> IO ()
+#if defined(__GLASGOW_HASKELL__)
+ignoreSigPipe = C.handle $ \e -> case e of
+                                   IOError { ioe_type  = ResourceVanished
+                                           , ioe_errno = Just ioe }
+                                     | Errno ioe == ePIPE -> return ()
+                                   _ -> throwIO e
+#else
+ignoreSigPipe = id
+#endif
 
 -- ----------------------------------------------------------------------------
 -- showCommandForUser