dev: ignore SIGPIPE errors from truncated output in a more robust way [#2405]

hledger-lib/Hledger/Utils/IO.hs

@@ -149,7 +149,7 @@ import           System.Console.ANSI (Color(..),ColorIntensity(..), ConsoleLayer
 import           System.Console.Terminal.Size (Window (Window), size)
 import           System.Directory (getHomeDirectory, getModificationTime, findExecutable)
 import           System.Environment (getArgs, lookupEnv, setEnv, getProgName)
-import           System.Exit (exitFailure, exitSuccess)
+import           System.Exit (exitFailure)
 import           System.FilePath (isRelative, (</>))
 import "Glob"    System.FilePath.Glob (glob)
 import           System.Info (os)
@@ -287,31 +287,32 @@ exitWithErrorMessage msg = printError msg >> exitFailure
 --   it adds (english) text explaining the problem and what to do.
 --
 -- Some exceptions this does not handle:
--- ExitCode (exitSuccess / exitFailure / exitWith calls)
--- and UserInterrupt (control-C).
+-- ExitCode (exitSuccess/exitFailure/exitWith),
+-- UserInterrupt (control-C).
+--
+-- Also, this ignores SIGPIPE errors, which are usually harmless,
+-- caused when our output is truncated in a piped command.
 --
 exitOnError :: IO () -> IO ()
-exitOnError = flip catches
-  [
+exitOnError = flip catches [
    -- Handler (\(e::SomeException) -> error' $ pshow e),  -- debug
    Handler (\(e::UnicodeException) -> exitUnicode e)
   ,Handler (\(e::IOException) -> if
     | isUnicodeError e    -> exitUnicode e
-    | isBrokenPipeError e -> exitSuccess
     | otherwise           -> exitOther e)
   ,Handler (\(e::ErrorCall) -> exitOther e)
-  ]
+  ] . ignoreSigPipe
 
   where
-    -- After adding the above handler, truncating program output eg by piping into head
-    -- showed "hledger: Error: <stdout>: commitBuffer: resource vanished ( Broken pipe )".
-    -- As far as I know, this is an IOException and the best we can do is check for that wording
-    -- and treat those as non-errors. (Will this mask any real errors ? XXX)
-    isBrokenPipeError :: Exception e => e -> Bool
-    isBrokenPipeError ex =
-      let msg = map toLower (show ex) in any (`isInfixOf` msg) [
-          "broken pipe"
-        ]
+    -- | Ignore SIGPIPE errors.
+    -- This is copied from System.Process.Internals in process 1.6.20.0+,
+    -- since that version of process comes only with ghc 9.10.2+.
+    ignoreSigPipe :: IO () -> IO ()
+    ignoreSigPipe = handle $ \e -> case e of
+      IOError { ioe_type  = ResourceVanished
+              , ioe_errno = Just ioe }
+        | Errno ioe == ePIPE -> return ()
+      _ -> throwIO e
 
     -- Many decoding failures do not produce a UnicodeException, unfortunately.
     -- So this fragile hack detects them from the error message.