imp: improve/format errors for various failures [#2367]

These now call error' and show errors in the standard style: - reading a nonexistent data file - reading an unsafe dotted file name on windows - web: using --socket on windows - demo: demo not found - demo: error while running asciinema - diff: bad arguments - print --match: no match found - register --match: no match found - roi: no investment transactions found
2025-04-10 00:57:29 -10:00 · 2025-04-10 00:57:29 -10:00 · 9340b73aae
commit 9340b73aae
parent 454c669fe4
17 changed files with 60 additions and 63 deletions
--- a/hledger-lib/Hledger/Read.hs
+++ b/hledger-lib/Hledger/Read.hs
@ -143,10 +143,9 @@ import Data.Time (Day)
 import Safe (headDef, headMay)
 import System.Directory (doesFileExist, getHomeDirectory)
 import System.Environment (getEnv)
-import System.Exit (exitFailure)
 import System.FilePath ((<.>), (</>), splitDirectories, splitFileName, takeFileName)
 import System.Info (os)
-import System.IO (Handle, hPutStr, stderr)
+import System.IO (Handle, hPutStrLn, stderr)

 import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate)
 import Hledger.Data.Types
@ -348,23 +347,22 @@ requireJournalFileExists :: FilePath -> IO ()
 requireJournalFileExists "-" = return ()
 requireJournalFileExists f = do
  exists <- doesFileExist f
-  unless exists $ do
-    hPutStr stderr $ "The hledger data file \"" <> f <> "\" was not found.\n"
-    hPutStr stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
-    hPutStr stderr "Or, specify an existing data file with -f or $LEDGER_FILE.\n"
-    exitFailure
+  unless exists $ error' $ unlines
+    [ "data file \"" <> f <> "\" was not found."
+    ,"Please create it first, eg with \"hledger add\" or a text editor."
+    ,"Or, specify an existing data file with -f or $LEDGER_FILE."
+    ]

 -- | Ensure there is a journal file at the given path, creating an empty one if needed.
 -- On Windows, also ensure that the path contains no trailing dots
 -- which could cause data loss (see 'isWindowsUnsafeDotPath').
 ensureJournalFileExists :: FilePath -> IO ()
 ensureJournalFileExists f = do
-  when (os=="mingw32" && isWindowsUnsafeDotPath f) $ do
-    hPutStr stderr $ "Part of file path \"" <> show f <> "\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"
-    exitFailure
+  when (os=="mingw32" && isWindowsUnsafeDotPath f) $
+    error' $ "Part of file path \"" <> show f <> "\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"
  exists <- doesFileExist f
  unless exists $ do
-    hPutStr stderr $ "Creating hledger journal file " <> show f <> ".\n"
+    hPutStrLn stderr $ "Creating hledger journal file " <> show f
    -- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
    -- we currently require unix line endings on all platforms.
    newJournalContent >>= T.writeFile f
--- a/hledger-lib/Hledger/Read/RulesReader.hs
+++ b/hledger-lib/Hledger/Read/RulesReader.hs
@ -942,7 +942,7 @@ readJournalFromCsv merulesfile csvfile csvhandle sep = do
    skiplines <- case getDirective "skip" rules of
                      Nothing -> return 0
                      Just "" -> return 1
-                      Just s  -> maybe (throwError $ "could not parse skip value: " ++ show s) return . readMay $ T.unpack s
+                      Just s  -> maybe (throwError $ "could not parse skip value: " ++ T.unpack s) return . readMay $ T.unpack s
    let csvlines2 = dbg9 "csvlines2" $ drop skiplines csvlines1

    -- convert back to text and parse as csv records
@ -1117,7 +1117,7 @@ transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t
    mdateformat = rule "date-format"
    parsedate = parseDateWithCustomOrDefaultFormats timesarezoned mtzin tzout mdateformat
    mkdateerror datefield datevalue mdateformat' = T.unpack $ T.unlines
-      ["error: could not parse \""<>datevalue<>"\" as a date using date format "
+      ["could not parse \""<>datevalue<>"\" as a date using date format "
        <>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat'
      ,showRecord record
      ,"the "<>datefield<>" rule is:   "<>(fromMaybe "required, but missing" $ field datefield)
@ -1147,7 +1147,7 @@ transactionFromCsvRecord timesarezoned mtzin tzout sourcepos rules record = t
        Just s  -> either statuserror id $ runParser (statusp <* eof) "" s
          where
            statuserror err = error' . T.unpack $ T.unlines
-              ["error: could not parse \""<>s<>"\" as a cleared status (should be *, ! or empty)"
+              ["could not parse status value \""<>s<>"\" (should be *, ! or empty)"
              ,"the parse error is:      "<>T.pack (customErrorBundlePretty err)
              ]
    code        = maybe "" singleline' $ fieldval "code"
@ -1362,7 +1362,7 @@ parseAmount rules record currency s =
  where
    journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
    mkerror e = error' . T.unpack $ T.unlines
-      ["error: could not parse \"" <> s <> "\" as an amount"
+      ["could not parse \"" <> s <> "\" as an amount"
      ,showRecord record
      ,showRules rules record
      -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules)
@ -1395,7 +1395,7 @@ parseBalanceAmount rules record currency n s =
  where
    journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules}
    mkerror n' s' e = error' . T.unpack $ T.unlines
-      ["error: could not parse \"" <> s' <> "\" as balance"<> T.pack (show n') <> " amount"
+      ["could not parse \"" <> s' <> "\" as balance"<> T.pack (show n') <> " amount"
      ,showRecord record
      ,showRules rules record
      -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency
--- a/hledger-lib/Hledger/Utils/IO.hs
+++ b/hledger-lib/Hledger/Utils/IO.hs
@ -26,6 +26,7 @@ module Hledger.Utils.IO (
  ansiFormatWarning,
  exitOnExceptions,
  exitWithError,
+  printError,

  -- * Time
  getCurrentLocalTime,
@ -254,11 +255,16 @@ exitOnExceptions = flip catches
  where
    rstrip = reverse . dropWhile isSpace . reverse

-- | Print an error message on stderr, with a standard program name prefix,
-- and styling the first line with ansiFormatError if that's allowed;
+-- | Print an error message with printError, 
 -- then exit the program with a non-zero exit code.
 exitWithError :: String -> IO ()
-exitWithError msg = do
+exitWithError msg = printError msg >> exitFailure
+
+-- | Print an error message to stderr,
+-- with a standard program name prefix,
+-- and styling the first line with ansiFormatError if that's allowed.
+printError :: String -> IO ()
+printError msg = do
  progname <- getProgName
  usecolor <- useColorOnStderr
  let
@ -269,8 +275,6 @@ exitWithError msg = do
      -- Use a stupid heuristic for now: add it again unless already there.
      <> (if "Error:" `isPrefixOf` msg then "" else "Error: ")
  hPutStrLn stderr $ style $ prefix <> msg
-  exitFailure
-

 -- Time

--- a/hledger-web/Hledger/Web/Main.hs
+++ b/hledger-web/Hledger/Web/Main.hs
@ -37,7 +37,6 @@ import Network.Wai.Handler.Warp (runSettings, runSettingsSocket, defaultSettings
 import Network.Wai.Handler.Launch (runHostPortFullUrl)
 import System.Directory (removeFile)
 import System.Environment ( getArgs, withArgs )
-import System.Exit (exitFailure)
 import System.IO (hFlush, stdout)
 import System.PosixCompat.Files (getFileStatus, isSocket)
 import Text.Printf (printf)
@ -162,10 +161,10 @@ web opts j = do
                  when (isSocket sockstat) $ removeFile s
              )
              (\sock -> Network.Wai.Handler.Warp.runSettingsSocket warpsettings sock app)
-            else do
-              putStrLn "Unix domain sockets are not available on your operating system"
-              putStrLn "Please try again without --socket"
-              exitFailure
+            else error $ unlines
+              ["Unix domain sockets are not available on your operating system."
+              ,"Please try again without --socket."
+              ]

        Nothing -> Network.Wai.Handler.Warp.runSettings warpsettings app

--- a/hledger/Hledger/Cli.hs
+++ b/hledger/Hledger/Cli.hs
@ -457,7 +457,7 @@ main = exitOnExceptions $ withGhcDebug' $ do
        system shellcmd >>= exitWith

    -- deprecated command found
-    -- cmdname == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
+    -- cmdname == "convert" = error' (modeHelp oldconvertmode)

    -- 6.7. something else (shouldn't happen) - show an error
    | otherwise -> usageError $
--- a/hledger/Hledger/Cli/CliOptions.hs
+++ b/hledger/Hledger/Cli/CliOptions.hs
@ -435,7 +435,7 @@ hledgerCommandMode :: CommandHelpStr -> [Flag RawOpts] -> [(String, [Flag RawOpt
  -> [Flag RawOpts] -> ([Arg RawOpts], Maybe (Arg RawOpts)) -> Mode RawOpts
 hledgerCommandMode helpstr unnamedflaggroup namedflaggroups hiddenflaggroup argsdescr =
  case parseCommandHelp helpstr of
-    Nothing -> error' $ "Could not parse command doc:\n"++helpstr++"\n"  -- PARTIAL:
+    Nothing -> error' $ "could not parse command doc:\n"++helpstr++"\n"  -- PARTIAL:
    Just CommandHelp{cmdName, mcmdShortName, cmdHelpPreamble, cmdHelpPostamble} ->
      (defCommandMode $ cmdName : maybeToList mcmdShortName) {
         modeHelp        = cmdHelpPreamble
--- a/hledger/Hledger/Cli/Commands/Demo.hs
+++ b/hledger/Hledger/Cli/Commands/Demo.hs
@ -38,9 +38,6 @@ module Hledger.Cli.Commands.Demo (
 ,demo
 ) where

-import Hledger
-import Hledger.Cli.CliOptions
-import System.Exit (exitFailure)
 import Text.Printf
 import Control.Concurrent (threadDelay)
 import System.Process (callProcess)
@ -56,6 +53,9 @@ import System.IO.Temp (withSystemTempFile)
 import System.IO (hClose)
 import System.Console.CmdArgs.Explicit (flagReq)

+import Hledger
+import Hledger.Cli.CliOptions
+
 demos :: [Demo]
 demos = map readDemo [
  -- XXX these are confusing, redo
@ -93,14 +93,14 @@ demo :: CliOpts -> Journal -> IO ()
 demo CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=_query}} _j = do
  -- demos <- getCurrentDirectory >>= readDemos
  case listofstringopt "args" rawopts of
-    [] -> putStrLn usagestr >> printDemos
+    [] -> putStrLn usagestr >> putStr listDemos
    (a:as) ->
      case findDemo demos a of
-        Nothing -> do
-          putStrLn $ "No demo \"" <> a <> "\" was found."
-          putStrLn usagestr
-          printDemos
-          exitFailure
+        Nothing -> error' $ unlines
+          ["No demo \"" <> a <> "\" was found."
+          ,usagestr
+          ,listDemos
+          ]
        Just (Demo t c) -> do
          let
            -- try to preserve the original pauses a bit while also moving things along
@ -139,8 +139,8 @@ findDemo ds s =
  where
    sl = lowercase s

-printDemos :: IO ()
-printDemos = putStrLn $ unlines $
+listDemos :: String
+listDemos = unlines $
  "Demos:" :
  -- "" :
  [show i <> ") " <> bold' t | (i, Demo t _) <- zip [(1::Int)..] demos]
@ -160,12 +160,15 @@ runAsciinemaPlay speed idlelimit content args =
      ,[f]
      ,args
      ])
-      `catchIOError` \err -> do
-        putStrLn $ "\n" <> show err
-        putStrLn "Error: running asciinema failed. Trying 'asciinema --version':"
-        callProcess "asciinema" ["--version"] `catchIOError` \_ ->
-          putStrLn "This also failed. Check that asciinema is installed in your PATH."
-        exitFailure
+    `catchIOError` \err -> do
+      printError $ unlines
+        [""
+        ,show err
+        ,"Running asciinema failed. Trying 'asciinema --version':"
+        ]
+      callProcess "asciinema" ["--version"]
+      `catchIOError` \_ ->
+        error' "This also failed. Check that asciinema is installed in your PATH."
  where
    showwithouttrailingzero = dropWhileEnd (=='.') . dropWhileEnd (=='0') . show

--- a/hledger/Hledger/Cli/Commands/Diff.hs
+++ b/hledger/Hledger/Cli/Commands/Diff.hs
@ -21,7 +21,6 @@ import Data.Either (partitionEithers)
 import qualified Data.Text.IO as T
 import Lens.Micro (set)
 import Safe (headDef)
-import System.Exit (exitFailure)

 import Hledger
 import Hledger.Cli.CliOptions
@ -114,6 +113,4 @@ diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{_rsQuery=Acct acctRe}} _ = d
  putStrLn "These transactions are in the second file only:\n"
  mapM_ (T.putStr . showTransaction) unmatchedtxn2

-diff _ _ = do
-  putStrLn "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"
-  exitFailure
+diff _ _ = error' "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"
--- a/hledger/Hledger/Cli/Commands/Print.hs
+++ b/hledger/Hledger/Cli/Commands/Print.hs
@ -31,7 +31,6 @@ import qualified Data.Text.Lazy.Builder as TB
 import Lens.Micro ((^.), _Just, has)
 import Safe (lastMay, minimumDef)
 import System.Console.CmdArgs.Explicit
-import System.Exit (exitFailure)

 import Hledger
 import Hledger.Write.Beancount (accountNameToBeancount, showTransactionBeancount, showBeancountMetadata)
@ -124,7 +123,7 @@ print' opts j = do
      -- XXX should match similarly to register --match
      case journalSimilarTransaction opts j' (dbg1 "finding best match for description" $ T.pack desc) of
        Just t  -> printEntries opts j'{jtxns=[t]}
-        Nothing -> putStrLn "no matches found." >> exitFailure
+        Nothing -> error' $ "no transactions found with descriptions like " <> show desc

 printEntries :: CliOpts -> Journal -> IO ()
 printEntries opts@CliOpts{rawopts_=rawopts, reportspec_=rspec} j =
--- a/hledger/Hledger/Cli/Commands/Register.hs
+++ b/hledger/Hledger/Cli/Commands/Register.hs
@ -41,7 +41,6 @@ import qualified Lucid
 import Data.List (sortBy)
 import Data.Char (toUpper)
 import Data.List.Extra (intersect)
-import System.Exit (exitFailure)
 import qualified System.IO as IO

 registermode = hledgerCommandMode
@ -88,7 +87,7 @@ register opts@CliOpts{rawopts_=rawopts, reportspec_=rspec} j
  | Just desc <- maybestringopt "match" rawopts = do
      let ps = [p | (_,_,_,p,_) <- rpt]
      case similarPosting ps desc of
-        Nothing -> putStrLn "no matches found." >> exitFailure
+        Nothing -> error' $ "no postings found with description like " <> show desc
        Just p  -> TL.putStr $ postingsReportAsText opts [pri]
                  where pri = (Just (postingDate p)
                              ,Nothing
--- a/hledger/Hledger/Cli/Commands/Roi.hs
+++ b/hledger/Hledger/Cli/Commands/Roi.hs
@ -16,7 +16,6 @@ module Hledger.Cli.Commands.Roi (
 ) where

 import Control.Monad
-import System.Exit
 import Data.Time.Calendar
 import Text.Printf
 import Data.Bifunctor (second)
@ -92,9 +91,8 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
    filteredj = filterJournalTransactions investmentsQuery j
    trans = dbg3 "investments" $ jtxns filteredj

-  when (null trans) $ do
-    putStrLn "No relevant transactions found. Check your investments query"
-    exitFailure
+  when (null trans) $
+    error' "No relevant transactions found. Check your investments query"

  let (fullPeriod, spans) = reportSpan filteredj rspec

--- a/hledger/test/errors/csvamountparse.test
+++ b/hledger/test/errors/csvamountparse.test
@ -1,5 +1,5 @@
 $$$ hledger check -f  csvamountparse.csv
->>>2 /hledger: Error: error: could not parse "badamount" as an amount
+>>>2 /hledger: Error: could not parse "badamount" as an amount
 CSV record: "2022-01-03","badamount"
 the amount rule is: %2
 the date rule is: %1
--- a/hledger/test/errors/csvbalanceparse.test
+++ b/hledger/test/errors/csvbalanceparse.test
@ -1,5 +1,5 @@
 $$$ hledger check -f  csvbalanceparse.csv
->>>2 /hledger: Error: error: could not parse "badbalance" as balance1 amount
+>>>2 /hledger: Error: could not parse "badbalance" as balance1 amount
 CSV record: "2022-01-03","badbalance"
 the balance rule is: %2
 the date rule is: %1
--- a/hledger/test/errors/csvdateformat.test
+++ b/hledger/test/errors/csvdateformat.test
@ -1,5 +1,5 @@
 $$$ hledger print -f  csvdateformat.csv
->>>2 /hledger: Error: error: could not parse "a" as a date using date format "YYYY\/M\/D", "YYYY-M-D" or "YYYY.M.D"
+>>>2 /hledger: Error: could not parse "a" as a date using date format "YYYY\/M\/D", "YYYY-M-D" or "YYYY.M.D"
 CSV record: "a","b"
 the date rule is:   %1
 the date-format is: unspecified
--- a/hledger/test/errors/csvdateparse.test
+++ b/hledger/test/errors/csvdateparse.test
@ -1,5 +1,5 @@
 $$$ hledger check -f  csvdateparse.csv
->>>2 /hledger: Error: error: could not parse "baddate" as a date using date format "%Y-%m-%d"
+>>>2 /hledger: Error: could not parse "baddate" as a date using date format "%Y-%m-%d"
 CSV record: "baddate","b"
 the date rule is:   %1
 the date-format is: %Y-%m-%d
--- a/hledger/test/errors/csvskipvalue.test
+++ b/hledger/test/errors/csvskipvalue.test
@ -1,4 +1,4 @@
 $$$ hledger check -f  csvskipvalue.csv
->>>2 /hledger: Error: could not parse skip value: "badval"
+>>>2 /hledger: Error: could not parse skip value: badval
 /
 >>>= 1
--- a/hledger/test/errors/csvstatusparse.test
+++ b/hledger/test/errors/csvstatusparse.test
@ -1,5 +1,5 @@
 $$$ hledger print -f  csvstatusparse.csv
->>>2 /hledger: Error: error: could not parse "badstatus" as a cleared status \(should be \*, ! or empty\)
+>>>2 /hledger: Error: could not parse status value "badstatus" \(should be \*, ! or empty\)
 the parse error is:      1:1:
  \|
 1 \| badstatus