imp: balance assertions now use new error format (#1436)

hledger-lib/Hledger/Data/Balancing.hs

@@ -43,17 +43,17 @@ import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Time.Calendar (fromGregorian)
 import qualified Data.Map as M
-import Safe (headDef)
+import Safe (headDef, headMay)
 import Text.Printf (printf)
 
 import Hledger.Utils
 import Hledger.Data.Types
 import Hledger.Data.AccountName (isAccountNamePrefixOf)
 import Hledger.Data.Amount
-import Hledger.Data.Dates (showDate)
 import Hledger.Data.Journal
 import Hledger.Data.Posting
 import Hledger.Data.Transaction
+import Hledger.Data.Errors
 
 
 data BalancingOpts = BalancingOpts
@@ -550,6 +550,7 @@ checkBalanceAssertionB _ _ = return ()
 checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s ()
 checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt actualbal = do
   let isinclusive = maybe False bainclusive $ pbalanceassertion p
+  let istotal     = maybe False batotal     $ pbalanceassertion p
   actualbal' <-
     if isinclusive
     then
@@ -571,37 +572,58 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
       aquantity
         -- traceWith (("actual:"++).showAmountDebug)
         actualbalincomm
-
     errmsg = printf (unlines
-                  [ "balance assertion: %s",
+      [ "balance assertion: %s:",
-                    "\nassertion details:",
+        "%s\n",
-                    "date:       %s",
+        -- "date:       %s",
-                    "account:    %s%s",
+        "account:    %-30s%s",
-                    "commodity:  %s",
+        "commodity:  %-30s%s",
-                    -- "display precision:  %d",
+        -- "display precision:  %d",
-                    "calculated: %s", -- (at display precision: %s)",
+        "asserted:   %s", -- (at display precision: %s)",
-                    "asserted:   %s", -- (at display precision: %s)",
+        "actual:     %s", -- (at display precision: %s)",
-                    "difference: %s"
+        "difference: %s"
-                  ])
+      ])
-      (case ptransaction p of
+      (sourcePosPretty pos)
-         Nothing -> "?" -- shouldn't happen
+      (textChomp ex)
-         Just t ->  printf "%s\ntransaction:\n%s"
+      -- (showDate $ postingDate p)
-                      (sourcePosPretty pos)
-                      (textChomp $ showTransaction t)
-                      :: String
-                      where
-                        pos = baposition $ fromJust $ pbalanceassertion p
-      )
-      (showDate $ postingDate p)
       (T.unpack $ paccount p) -- XXX pack
-      (if isinclusive then " (and subs)" else "" :: String)
+      (if isinclusive then " (including subaccounts)" else "" :: String)
       assertedcomm
+      (if istotal then " (no other commodity balance allowed)" else "" :: String)
       -- (asprecision $ astyle actualbalincommodity)  -- should be the standard display precision I think
       (show $ aquantity actualbalincomm)
       -- (showAmount actualbalincommodity)
       (show $ aquantity assertedamt)
       -- (showAmount assertedamt)
       (show $ aquantity assertedamt - aquantity actualbalincomm)
+      where
+        ass = fromJust $ pbalanceassertion p  -- PARTIAL: fromJust won't fail, there is a balance assertion
+        pos = baposition ass
+        (_,_,_,ex) = makePostingErrorExcerpt p finderrcols
+          where
+            finderrcols p t trendered = Just (col, Just col2)
+              where
+                -- col  = unPos $ sourceColumn pos
+                -- col2 = col + (length $ wbUnpack $ showBalanceAssertion ass)
+                -- The saved parse position may not correspond to the rendering in the error message.
+                -- Instead, we analyse the rendering to find the columns:
+                tlines = length $ T.lines $ tcomment t  -- transaction comment can generate extra lines
+                (col, col2) =
+                  let def = (5, maximum (map T.length $ T.lines trendered))  -- fallback: underline whole posting. Shouldn't happen.
+                  in
+                    case transactionFindPostingIndex (==p) t of
+                      Nothing  -> def
+                      Just idx -> fromMaybe def $ do
+                        let
+                          beforeps = take (idx-1) $ tpostings t
+                          beforepslines = sum $ map (length . T.lines . pcomment) beforeps   -- posting comment can generate extra lines (assume only one commodity shown)
+                        assertionline <- headMay $ drop (tlines + beforepslines) $ T.lines trendered
+                        let
+                          col2 = T.length assertionline
+                          l = dropWhile (/= '=') $ reverse $ T.unpack assertionline
+                          l' = dropWhile (`elem` ['=','*']) l
+                          col = length l' + 1
+                        return (col, col2)
 
   unless pass $ throwError errmsg
 

hledger-lib/Hledger/Data/Posting.hs

@@ -61,6 +61,7 @@ module Hledger.Data.Posting (
   postingsAsLines,
   showAccountName,
   renderCommentLines,
+  showBalanceAssertion,
   -- * misc.
   postingTransformAmount,
   postingApplyValuation,

hledger/test/errors/README.md

@@ -8,7 +8,7 @@ progress brings immediate practical benefits.
 
 Here are journals/scripts for reproducing hledger's journal error messages.
 They are named similarly to [hledger check][]'s checks.
-In the CLI, execute them to see the error messages (`./showall`).
+In the CLI, execute them to see the error messages.
 
 In Emacs with [flycheck-hledger][],
 customize flycheck-hledger-* to enable all appropriate checks,
@@ -45,7 +45,7 @@ Here is the current status
 |                          | std format | line | column    | excerpt | flycheck | flycheck region |
 |--------------------------|------------|------|-----------|---------|----------|-----------------|
 | accounts                 | ✓          | ✓    | ✓         | ✓✓      |          |                 |
-| assertions               |            | ✓    |           | ✓       |          |                 |
+| assertions               | ✓          | ✓    | ✓         | ✓✓      |          |                 |
 | balanced                 |            | ✓    | -         | ✓       |          |                 |
 | balancednoautoconversion |            | ✓    | -         | ✓       |          |                 |
 | commodities              | ✓          | ✓    | ✓(approx) | ✓✓      |          |                 |

hledger/test/errors/assertions.test

@@ -1,16 +1,14 @@
-$$$ hledger check -f assertions.j
+$ hledger check -f assertions.j
->>>2 /hledger: Error: .*assertions.j:4:8
+>2 /hledger: Error: balance assertion: .*assertions.j:4:8:
-transaction:
+  | 2022-01-01
-2022-01-01
+4 |     a               0 = 1
-    a               0 = 1
+  | ^^^^^^^^^^
 
-assertion details:
+account:    a                             
-date:       2022-01-01
+commodity:                                
-account:    a
+asserted:   0
-commodity:  
+actual:     1
-calculated: 0
-asserted:   1
 difference: 1
 
 /
->>>= 1
+>=1