;check: accounts, commodities, payees, ordereddates: improve errors

Error messages for these four are now a bit fancier and more
consistent. But not yet optimised for machine readability.
Cf #1436.

Added to hledger-lib: chomp1, linesPrepend[2].

examples/sample.journal

@@ -14,8 +14,17 @@
 ;   salary
 ; liabilities
 ;   debts
+account assets:bank:checking
+account income:salary
+account income:gifts
+account assets:bank:saving
+account assets:cash
+account expenses:food
+account expenses:supplies
+account liabilities:debts
+commodity $
 
-2008/01/01 income
+2018/01/01 income
     assets:bank:checking  $1
     income:salary
 

hledger-lib/Hledger/Read/Common.hs

@@ -150,6 +150,7 @@ import Text.Megaparsec.Custom
 import Hledger.Data
 import Hledger.Utils
 import Safe (headMay)
+import Text.Printf (printf)
 
 --- ** doctest setup
 -- $setup
@@ -376,9 +377,11 @@ journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j
   where
     checkpayee t
       | p `elem` ps = Right ()
-      | otherwise          =
+      | otherwise = Left $ 
-          Left $ "undeclared payee \""++T.unpack p++"\""
+          printf "undeclared payee \"%s\"\nat: %s\n\n%s"
-            ++ "\nin transaction at: "++showGenericSourcePos (tsourcepos t)
+            (T.unpack p) 
+            (showGenericSourcePos $ tsourcepos t)
+            (linesPrepend2 "> " "  " $ chomp1 $ showTransaction t)
       where
         p  = transactionPayee t
         ps = journalPayeesDeclared j
@@ -390,11 +393,13 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j
   where
     checkacct Posting{paccount,ptransaction}
       | paccount `elem` as = Right ()
-      | otherwise          = 
+      | otherwise = Left $
-          Left $ "undeclared account \""++T.unpack paccount++"\""
+          (printf "undeclared account \"%s\"\n" (T.unpack paccount))
-            ++ case ptransaction of
+          ++ case ptransaction of 
-                Just Transaction{tsourcepos} -> "\nin transaction at: "++showGenericSourcePos tsourcepos
+              Nothing -> ""
-                Nothing -> ""
+              Just t  -> printf "in transaction at: %s\n\n%s"
+                          (showGenericSourcePos $ tsourcepos t)
+                          (linesPrepend "  " $ chomp1 $ showTransaction t)
       where
         as = journalAccountNamesDeclared j
 
@@ -407,10 +412,13 @@ journalCheckCommoditiesDeclared j =
     checkcommodities Posting{..} =
       case mfirstundeclaredcomm of
         Nothing -> Right ()
-        Just c  -> Left $ "undeclared commodity \""++T.unpack c++"\""
+        Just c  -> Left $
+          (printf "undeclared commodity \"%s\"\n" (T.unpack c))
           ++ case ptransaction of 
-                Just Transaction{tsourcepos} -> "\nin transaction at: "++showGenericSourcePos tsourcepos
+              Nothing -> ""
-                Nothing -> ""      
+              Just t  -> printf "in transaction at: %s\n\n%s"
+                          (showGenericSourcePos $ tsourcepos t)
+                          (linesPrepend "  " $ chomp1 $ showTransaction t)
       where
         mfirstundeclaredcomm = 
           headMay $ filter (not . (`elem` cs)) $ catMaybes $
@@ -418,6 +426,7 @@ journalCheckCommoditiesDeclared j =
           (map (Just . acommodity) $ amounts pamount)
         cs = journalCommoditiesDeclared j
 
+
 setYear :: Year -> JournalParser m ()
 setYear y = modify' (\j -> j{jparsedefaultyear=Just y})
 

hledger-lib/Hledger/Utils/String.hs

@@ -21,6 +21,7 @@ module Hledger.Utils.String (
  lstrip,
  rstrip,
  chomp,
+ chomp1,
  singleline,
  elideLeft,
  elideRight,
@@ -37,6 +38,8 @@ module Hledger.Utils.String (
  padright,
  cliptopleft,
  fitto,
+ linesPrepend,
+ linesPrepend2,
  -- * wide-character-aware layout
  charWidth,
  strWidth,
@@ -86,10 +89,14 @@ lstrip = dropWhile isSpace
 rstrip :: String -> String
 rstrip = reverse . lstrip . reverse
 
--- | Remove trailing newlines/carriage returns.
+-- | Remove all trailing newlines/carriage returns.
 chomp :: String -> String
 chomp = reverse . dropWhile (`elem` "\r\n") . reverse
 
+-- | Remove all trailing newline/carriage returns, leaving just one trailing newline.
+chomp1 :: String -> String
+chomp1 = (++"\n") . chomp
+
 -- | Remove consecutive line breaks, replacing them with single space
 singleline :: String -> String
 singleline = unwords . filter (/="") . (map strip) . lines
@@ -343,3 +350,14 @@ stripAnsi s = either err id $ regexReplace ansire "" s
  where
    err    = error "stripAnsi: invalid replacement pattern"      -- PARTIAL, shouldn't happen
    ansire = toRegex' "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"  -- PARTIAL, should succeed
+
+-- | Add a prefix to each line of a string.
+linesPrepend :: String -> String -> String
+linesPrepend prefix = unlines . map (prefix++) . lines
+
+-- | Add a prefix to the first line of a string, 
+-- and a different prefix to the remaining lines.
+linesPrepend2 :: String -> String -> String -> String
+linesPrepend2 prefix1 prefix2 s =
+  unlines $ (prefix1++l) : map (prefix2++) ls
+  where l:ls = lines s

hledger/Hledger/Cli/Commands/Check.hs

@@ -79,7 +79,7 @@ runCheck copts@CliOpts{rawopts_} j (check,args) =
     Payees          ->
       case journalCheckPayeesDeclared j of
         Right () -> return ()
-        Left err -> hPutStrLn stderr err >> exitFailure
+        Left err -> hPutStrLn stderr ("Error: "++err) >> exitFailure
   where
     -- Hack: append the provided args to the raw opts,
     -- in case the check can use them (like checkdates --unique). 

hledger/Hledger/Cli/Commands/Checkdates.hs

@@ -37,13 +37,15 @@ checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
     FoldAcc{fa_previous=Nothing} -> return ()
     FoldAcc{fa_error=Nothing}    -> return ()
     FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
-      putStrLn $ printf 
+      let 
-          ("Error: transaction's date is not in date order%s,\n"
+        uniquestr = if unique then " and/or not unique" else ""
-        ++ "at %s:\n\n%sPrevious transaction's date was: %s")
+        positionstr = showGenericSourcePos $ tsourcepos error
-        (if unique then " and/or not unique" else "")
+        txn1str = linesPrepend  "  "      $ showTransaction previous
-        (showGenericSourcePos $ tsourcepos error)
+        txn2str = linesPrepend2 "> " "  " $ showTransaction error
-        (showTransaction error)
+      printf "Error: transaction date is out of order%s\nat %s:\n\n%s"
-        (show $ date previous)
+        uniquestr
+        positionstr
+        (txn1str ++ txn2str)
       exitFailure
 
 data FoldAcc a b = FoldAcc

hledger/Hledger/Cli/Commands/Checkdupes.hs

@@ -28,6 +28,7 @@ checkdupesmode = hledgerCommandMode
 checkdupes _opts j = do
   let dupes = checkdupes' $ accountsNames j
   when (not $ null dupes) $ do
+    -- XXX make output more like Checkdates.hs, Check.hs etc.
     mapM_ render dupes
     exitFailure