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

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

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

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, 
 #