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

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
+  unless exists $ error' $ unlines
-    hPutStr stderr $ "The hledger data file \"" <> f <> "\" was not found.\n"
+    [ "data file \"" <> f <> "\" was not found."
-    hPutStr stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
+    ,"Please create it first, eg with \"hledger add\" or a text editor."
-    hPutStr stderr "Or, specify an existing data file with -f or $LEDGER_FILE.\n"
+    ,"Or, specify an existing data file with -f or $LEDGER_FILE."
-    exitFailure
+    ]
 
 -- | 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
+  when (os=="mingw32" && isWindowsUnsafeDotPath f) $
-    hPutStr stderr $ "Part of file path \"" <> show f <> "\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"
+    error' $ "Part of file path \"" <> show f <> "\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"
-    exitFailure
   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

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

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,
+-- | Print an error message with printError, 
--- and styling the first line with ansiFormatError if that's allowed;
 -- 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
 

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
+            else error $ unlines
-              putStrLn "Unix domain sockets are not available on your operating system"
+              ["Unix domain sockets are not available on your operating system."
-              putStrLn "Please try again without --socket"
+              ,"Please try again without --socket."
-              exitFailure
+              ]
 
         Nothing -> Network.Wai.Handler.Warp.runSettings warpsettings app
 

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 $

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

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
+        Nothing -> error' $ unlines
-          putStrLn $ "No demo \"" <> a <> "\" was found."
+          ["No demo \"" <> a <> "\" was found."
-          putStrLn usagestr
+          ,usagestr
-          printDemos
+          ,listDemos
-          exitFailure
+          ]
         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 ()
+listDemos :: String
-printDemos = putStrLn $ unlines $
+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
+    `catchIOError` \err -> do
-        putStrLn $ "\n" <> show err
+      printError $ unlines
-        putStrLn "Error: running asciinema failed. Trying 'asciinema --version':"
+        [""
-        callProcess "asciinema" ["--version"] `catchIOError` \_ ->
+        ,show err
-          putStrLn "This also failed. Check that asciinema is installed in your PATH."
+        ,"Running asciinema failed. Trying 'asciinema --version':"
-        exitFailure
+        ]
+      callProcess "asciinema" ["--version"]
+      `catchIOError` \_ ->
+        error' "This also failed. Check that asciinema is installed in your PATH."
   where
     showwithouttrailingzero = dropWhileEnd (=='.') . dropWhileEnd (=='0') . show
 

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
+diff _ _ = error' "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"
-  putStrLn "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"
-  exitFailure

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 =

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

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
+  when (null trans) $
-    putStrLn "No relevant transactions found. Check your investments query"
+    error' "No relevant transactions found. Check your investments query"
-    exitFailure
 
   let (fullPeriod, spans) = reportSpan filteredj rspec
 

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

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

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

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

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

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