lib: exitOnExceptions -> exitOnError

This commit is contained in:
Simon Michael 2025-04-25 08:29:40 -10:00
parent d1e4d00b8d
commit 06cd0f9472
4 changed files with 9 additions and 9 deletions

View File

@ -24,9 +24,9 @@ module Hledger.Utils.IO (
warn, warn,
ansiFormatError, ansiFormatError,
ansiFormatWarning, ansiFormatWarning,
exitOnExceptions,
exitWithError,
printError, printError,
exitWithErrorMessage,
exitOnError,
-- * Time -- * Time
getCurrentLocalTime, getCurrentLocalTime,
@ -247,8 +247,6 @@ modifyFirstLine f s = intercalate "\n" $ map f l <> ls where (l,ls) = splitAt 1
-- ExitCode (triggered by a call to exitSuccess, exitFailure, or exitWith) -- ExitCode (triggered by a call to exitSuccess, exitFailure, or exitWith)
-- and UserInterrupt (triggered by control-C). -- and UserInterrupt (triggered by control-C).
-- --
exitOnExceptions :: IO () -> IO ()
exitOnExceptions = flip catches
[Handler (\(e::ErrorCall) -> exitWithError $ rstrip $ show e) [Handler (\(e::ErrorCall) -> exitWithError $ rstrip $ show e)
,Handler (\(e::IOError) -> exitWithError $ rstrip $ show e) ,Handler (\(e::IOError) -> exitWithError $ rstrip $ show e)
-- ,Handler (\(x::ExitCode) -> exitWith x) -- falls through -- ,Handler (\(x::ExitCode) -> exitWith x) -- falls through
@ -259,8 +257,6 @@ exitOnExceptions = flip catches
-- | Print an error message with printError, -- | Print an error message with printError,
-- then exit the program with a non-zero exit code. -- then exit the program with a non-zero exit code.
exitWithError :: String -> IO ()
exitWithError msg = printError msg >> exitFailure
-- | Print an error message to stderr, -- | Print an error message to stderr,
-- with a standard program name prefix, -- with a standard program name prefix,
@ -278,6 +274,10 @@ printError msg = do
<> (if "Error:" `isPrefixOf` msg then "" else "Error: ") <> (if "Error:" `isPrefixOf` msg then "" else "Error: ")
hPutStrLn stderr $ style $ prefix <> msg hPutStrLn stderr $ style $ prefix <> msg
exitWithErrorMessage :: String -> IO ()
exitWithErrorMessage msg = printError msg >> exitFailure
exitOnError :: IO () -> IO ()
exitOnError = flip catches
-- Time -- Time
getCurrentLocalTime :: IO LocalTime getCurrentLocalTime :: IO LocalTime

View File

@ -76,7 +76,7 @@ writeChan = BC.writeBChan
hledgerUiMain :: IO () hledgerUiMain :: IO ()
hledgerUiMain = exitOnExceptions $ withGhcDebug' $ withProgName "hledger-ui.log" $ do -- force Hledger.Utils.Debug.* to log to hledger-ui.log hledgerUiMain = exitOnError $ withGhcDebug' $ withProgName "hledger-ui.log" $ do -- force Hledger.Utils.Debug.* to log to hledger-ui.log
when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause' when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause'
#if MIN_VERSION_base(4,20,0) #if MIN_VERSION_base(4,20,0)

View File

@ -61,7 +61,7 @@ hledgerWebDev =
-- Run normally. -- Run normally.
hledgerWebMain :: IO () hledgerWebMain :: IO ()
hledgerWebMain = exitOnExceptions $ withGhcDebug' $ do hledgerWebMain = exitOnError $ withGhcDebug' $ do
when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause' when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause'
#if MIN_VERSION_base(4,20,0) #if MIN_VERSION_base(4,20,0)

View File

@ -200,7 +200,7 @@ confflagsmode = defMode{
-- implementing that would simplify hledger's CLI processing a lot. -- implementing that would simplify hledger's CLI processing a lot.
-- --
main :: IO () main :: IO ()
main = exitOnExceptions $ withGhcDebug' $ do main = exitOnError $ withGhcDebug' $ do
#if MIN_VERSION_base(4,20,0) #if MIN_VERSION_base(4,20,0)
-- Control ghc 9.10+'s stack traces. -- Control ghc 9.10+'s stack traces.