From 8ae303f68585c7e1b910febdc1b5e7f875a21c5c Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 2 Jul 2014 07:35:06 -0700 Subject: [PATCH] assert only a single commodity, like Ledger (fixes #195) This change means you can make assertions on a multi-commodity account balance (asserting one commodity at a time). On the flip side, you can no longer assert the complete balance of an account (new unexpected commodities will not be detected.) We might restore that ability later, using the == syntax. --- hledger-lib/Hledger/Data/Amount.hs | 5 +++++ hledger-lib/Hledger/Data/Journal.hs | 26 ++++++++++++++------------ tests/journal/balance-assertions.test | 14 +++++++++++++- 3 files changed, 32 insertions(+), 13 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 6b50c8d88..0ccac4e7c 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -74,6 +74,7 @@ module Hledger.Data.Amount ( missingmixedamt, mixed, amounts, + filterMixedAmount, normaliseMixedAmountPreservingFirstPrice, normaliseMixedAmountPreservingPrices, -- ** arithmetic @@ -419,6 +420,10 @@ sumAmountsUsingFirstPrice as = (sum as){aprice=aprice $ head as} amounts :: MixedAmount -> [Amount] amounts (Mixed as) = as +-- | Filter a mixed amount's component amounts by a predicate. +filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount +filterMixedAmount p (Mixed as) = Mixed $ filter p as + -- | Convert a mixed amount's component amounts to the commodity of their -- assigned price, if any. costOfMixedAmount :: MixedAmount -> MixedAmount diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index e50f09bf3..1fff15afa 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -59,6 +59,7 @@ import Data.List -- import Data.Map (findWithDefault) import Data.Maybe import Data.Ord +import Safe (headMay) import Data.Time.Calendar import Data.Time.LocalTime import Data.Tree @@ -427,28 +428,29 @@ checkBalanceAssertionsForAccount ps -- If it does, return the new balance, otherwise add an error to the -- error list. Intended to be called from a fold. checkBalanceAssertion :: ([String],MixedAmount) -> [Posting] -> ([String],MixedAmount) -checkBalanceAssertion (errs,bal) ps - | null ps = (errs,bal) - | isNothing assertion = (errs,bal) +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) - -- or, compare only the balance of that commodity, like Ledger - -- not $ isReallyZeroMixedAmount (filterCommodity () bal' - assertedbal) - = (errs++[err], bal') - | otherwise = (errs,bal') + not $ isReallyZeroMixedAmount (bal - assertedbal) = (errs++[err], bal) + | otherwise = (errs,bal) where p = last ps assertion = pbalanceassertion p - Just assertedbal = assertion - bal' = sum $ [bal] ++ map pamount ps - err = printf "Balance assertion failed for account %s on %s\n%sAfter posting:\n %s\nexpected balance is %s, actual balance was %s." + Just assertedbal = dbg2 "assertedbal" assertion + fullbal = dbg2 "fullbal" $ sum $ [dbg2 "startbal" startbal] ++ map pamount ps + singlebal = dbg2 "singlebal" $ + let c = maybe "" acommodity $ headMay $ amounts assertedbal + in filterMixedAmount (\a -> acommodity a == c) 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 commodity balance is %s, actual balance was %s." (paccount p) (show $ postingDate p) (maybe "" (("In transaction:\n"++).show) $ ptransaction p) (show p) (showMixedAmount assertedbal) - (showMixedAmount bal') + (showMixedAmount singlebal) -- Given a sequence of postings to a single account, split it into -- sub-sequences consisting of ordinary postings followed by a single diff --git a/tests/journal/balance-assertions.test b/tests/journal/balance-assertions.test index d98cd82ea..03aba61ae 100755 --- a/tests/journal/balance-assertions.test +++ b/tests/journal/balance-assertions.test @@ -89,7 +89,19 @@ hledgerdev -f - stats >>>2 >>>=0 -# 6. what should happen here ? Currently, +# 6. assertions currently check only a single commodity's balance, like Ledger +hledgerdev -f - stats +<<< +1/2 + (a) A1 + (a) B1 = A1 + (a) 0 = A1 + (a) C0 = D0 +>>> /Transactions/ +>>>2 +>>>=0 + +# 7. what should happen here ? Currently, # in a, 3.4 EUR @@ $5.6 and -3.4 EUR cancel out (wrong ?) # in b, #