lib: exitOnExceptions -> exitOnError
This commit is contained in:
parent
d1e4d00b8d
commit
06cd0f9472
@ -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
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
@ -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.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user