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

This commit is contained in:
Simon Michael 2022-07-10 11:33:21 +01:00
parent 3303ac11b8
commit b7e6583a72
4 changed files with 59 additions and 38 deletions

View File

@ -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",
"\nassertion details:",
"date: %s",
"account: %s%s",
"commodity: %s",
-- "display precision: %d",
"calculated: %s", -- (at display precision: %s)",
"asserted: %s", -- (at display precision: %s)",
"difference: %s"
])
(case ptransaction p of
Nothing -> "?" -- shouldn't happen
Just t -> printf "%s\ntransaction:\n%s"
(sourcePosPretty pos)
(textChomp $ showTransaction t)
:: String
where
pos = baposition $ fromJust $ pbalanceassertion p
)
(showDate $ postingDate p)
[ "balance assertion: %s:",
"%s\n",
-- "date: %s",
"account: %-30s%s",
"commodity: %-30s%s",
-- "display precision: %d",
"asserted: %s", -- (at display precision: %s)",
"actual: %s", -- (at display precision: %s)",
"difference: %s"
])
(sourcePosPretty pos)
(textChomp ex)
-- (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

View File

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

View File

@ -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) | ✓✓ | | |

View File

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