lib: more ergonomic balance assertion errors

This commit is contained in:
Simon Michael 2016-02-10 07:39:03 -08:00
parent 64c77e776e
commit 5da355c06f
2 changed files with 32 additions and 10 deletions

View File

@ -465,24 +465,36 @@ checkBalanceAssertion (errs,startbal) ps
| null ps = (errs,startbal)
| isNothing assertion = (errs,startbal)
| -- bal' /= assertedbal -- MixedAmount's Eq instance currently gets confused by different precisions
not $ isReallyZeroMixedAmount (bal - assertedbal) = (errs++[err], fullbal)
| otherwise = (errs,fullbal)
not $ isReallyZeroMixedAmount (actualbal - assertedbal) = (errs++[err], finalfullbal)
| otherwise = (errs,finalfullbal)
where
p = last ps
assertion = pbalanceassertion p
Just assertedbal = dbg2 "assertedbal" assertion
assertedcomm = dbg2 "assertedcomm" $ maybe "" acommodity $ headMay $ amounts assertedbal
fullbal = dbg2 "fullbal" $ sum $ [dbg2 "startbal" startbal] ++ map pamount ps
singlebal = dbg2 "singlebal" $ filterMixedAmount (\a -> acommodity a == assertedcomm) fullbal
bal = singlebal -- check single-commodity balance like Ledger; maybe add == FULLBAL later
err = printf "Balance assertion failed for account %s on %s\n%sAfter posting:\n %s\nexpected balance in commodity \"%s\" is %s, calculated balance was %s."
finalfullbal = dbg2 "finalfullbal" $ sum $ [dbg2 "startbal" startbal] ++ map pamount ps
finalsinglebal = dbg2 "finalsinglebal" $ filterMixedAmount (\a -> acommodity a == assertedcomm) finalfullbal
actualbal = finalsinglebal -- just check the single-commodity balance, like Ledger; maybe add ==FULLBAL later
diff = actualbal - assertedbal
diffplus | isNegativeMixedAmount diff == Just False = "+"
| otherwise = ""
err = printf (unlines [
"a balance assertion failed on %s",
"in account %s",
"in commodity %s",
"asserted balance was %s, actual balance was %s (%s)",
"after posting:",
"%s",
"%s"
])
(showDate $ postingDate p)
(paccount p)
(show $ postingDate p)
(maybe "" (("In transaction:\n"++).show) $ ptransaction p)
(show p)
assertedcomm
(showMixedAmount assertedbal)
(showMixedAmount singlebal)
(showMixedAmount finalsinglebal)
(diffplus ++ showMixedAmount diff)
(showPostingLine p)
(maybe "" (("in transaction:\n"++).show) $ ptransaction p)
-- Given a sequence of postings to a single account, split it into
-- sub-sequences consisting of ordinary postings followed by a single

View File

@ -31,6 +31,7 @@ module Hledger.Data.Transaction (
showTransaction,
showTransactionUnelided,
showTransactionUnelidedOneLineAmounts,
showPostingLine,
-- * misc.
tests_Hledger_Data_Transaction
)
@ -201,6 +202,15 @@ postingAsLines elideamount onelineamounts ps p =
case renderCommentLines (pcomment p) of [] -> ("",[])
c:cs -> (c,cs)
-- used in balance assertion error
showPostingLine p =
indent $
if pstatus p == Cleared then "* " else "" ++
showAccountName Nothing (ptype p) (paccount p) ++
" " ++
showMixedAmountOneLine (pamount p)
tests_postingAsLines = [
"postingAsLines" ~: do
let p `gives` ls = assertEqual "" ls (postingAsLines False False [p] p)