WIP

hledger-lib/Hledger/Data/Amount.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-|
 A simple 'Amount' is some quantity of money, shares, or anything else.
 It has a (possibly null) 'CommoditySymbol' and a numeric quantity:
@@ -106,6 +107,7 @@ module Hledger.Data.Amount (
   mixedAmountStripPrices,
   -- ** arithmetic
   mixedAmountCost,
+  mixedAmountCostPreservingPrecision,
   divideMixedAmount,
   multiplyMixedAmount,
   divideMixedAmountAndPrice,
@@ -319,6 +321,13 @@ amountCost a@Amount{aquantity=q, aprice=mp} =
       Just (UnitPrice  p@Amount{aquantity=pq}) -> p{aquantity=pq * q}
       Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * signum q}
 
+-- | Like amountCost, but then re-apply the display precision of the
+-- original commodity.
+amountCostPreservingPrecision :: Amount -> Amount
+amountCostPreservingPrecision a@Amount{astyle=AmountStyle{asprecision}} =
+  a'{astyle=astyle'{asprecision=asprecision}}
+  where a'@Amount{astyle=astyle'} = amountCost a
+
 -- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.
 -- Has no effect on amounts without one.
 -- Also increases the unit price's display precision to show one extra decimal place,
@@ -668,6 +677,11 @@ mapMixedAmount f (Mixed as) = Mixed $ map f as
 mixedAmountCost :: MixedAmount -> MixedAmount
 mixedAmountCost = mapMixedAmount amountCost
 
+-- | Like mixedAmountCost, but then re-apply the display precision of the
+-- original commodity.
+mixedAmountCostPreservingPrecision :: MixedAmount -> MixedAmount
+mixedAmountCostPreservingPrecision = mapMixedAmount amountCostPreservingPrecision
+
 -- | Divide a mixed amount's quantities by a constant.
 divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount
 divideMixedAmount n = mapMixedAmount (divideAmount n)

hledger-lib/Hledger/Data/Transaction.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-|
 
 A 'Transaction' represents a movement of some commodity(ies) between two
@@ -83,6 +84,7 @@ import Hledger.Data.Valuation
 import Text.Tabular
 import Text.Tabular.AsciiWide
 import Control.Applicative ((<|>))
+import Text.Printf (printf)
 
 sourceFilePath :: GenericSourcePos -> FilePath
 sourceFilePath = \case
@@ -378,10 +380,41 @@ transactionCheckBalanced mglobalstyles t = errs
     -- of decimal places specified by its display style, from either the 
     -- provided global display styles, or local styles inferred from just 
     -- this transaction.
+
+    -- Which local styles (& thence, precisions) exactly should we
+    -- infer from this transaction ? Since amounts are going to be
+    -- converted to cost, we may end up with the commodity of
+    -- transaction prices, so we'll need to pick a style for those too.
+    --
+    -- Option 1: also infer styles from the price amounts, which normally isn't done.
+    -- canonicalise = maybe id canonicaliseMixedAmount (mglobalstyles <|> mtxnstyles)
+    --   where
+    --     mtxnstyles = dbg0 "transactionCheckBalanced mtxnstyles" $
+    --       either (const Nothing) Just $ -- shouldn't get any error here, but if so just.. carry on, comparing uncanonicalised amounts XXX
+    --         commodityStylesFromAmounts $ concatMap postingAllAmounts $ rps ++ bvps
+    --           where
+    --             -- | Get all the individual Amounts from a posting's MixedAmount,
+    --             -- and all their price Amounts as well.
+    --             postingAllAmounts :: Posting -> [Amount]
+    --             postingAllAmounts p = catMaybes $ concat [[Just a, priceamount a] | a <- amounts $ pamount p]
+    --               where 
+    --                 priceamount Amount{aprice} = 
+    --                   case aprice of
+    --                     Just (UnitPrice a) -> Just a
+    --                     Just (TotalPrice a) -> Just a
+    --                     Nothing -> Nothing
+    --
+    -- Option 2, for amounts converted to cost, where the new commodity appears only in prices,
+    -- use the precision of their original commodity (by using mixedAmountCostPreservingPrecision).
+    (tocost,costlabel) = case mglobalstyles of
+      Just _  -> (mixedAmountCost,"")  -- --balancing=styled
+      Nothing -> (mixedAmountCostPreservingPrecision,"withorigprecision")  -- --balancing=exact
     canonicalise = maybe id canonicaliseMixedAmount (mglobalstyles <|> mtxnstyles)
       where
-        mtxnstyles = either (const Nothing) Just $ -- shouldn't get any error here, but if so just.. carry on, comparing uncanonicalised amounts XXX
-          commodityStylesFromAmounts $ concatMap (amounts.pamount) $ rps ++ bvps
+        mtxnstyles = dbg9 "transactionCheckBalanced mtxnstyles" $
+          either (const Nothing) Just $ -- shouldn't get an error here, but if so just don't canonicalise
+            commodityStylesFromAmounts $ concatMap (amounts.pamount) $ rps ++ bvps
+
 
     -- check for mixed signs, detecting nonzeros at display precision
     signsOk ps = 
@@ -392,22 +425,28 @@ transactionCheckBalanced mglobalstyles t = errs
     (rsignsok, bvsignsok)       = (signsOk rps, signsOk bvps)
 
     -- check for zero sum, at display precision
-    (rsum, bvsum)               = (sumPostings rps, sumPostings bvps)
-    (rsumcost, bvsumcost)       = (mixedAmountCost rsum, mixedAmountCost bvsum)
-    (rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
-    (rsumok, bvsumok)           = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay)
+    (rsum, bvsum)             = (dbg9 "transactionCheckBalanced rsum" $ sumPostings rps, sumPostings bvps)
+    (rsumcost, bvsumcost)     = (dbg9 ("transactionCheckBalanced rsumcost"++costlabel) $ tocost rsum, tocost bvsum)
+    (rsumstyled, bvsumstyled) = (dbg9 "transactionCheckBalanced rsumstyled" $ canonicalise rsumcost, canonicalise bvsumcost)
+    (rsumok, bvsumok)         = (mixedAmountLooksZero rsumstyled, mixedAmountLooksZero bvsumstyled)
 
-    -- generate error messages, showing amounts with their original precision
+    -- generate error messages
     errs = filter (not.null) [rmsg, bvmsg]
       where
         rmsg
           | not rsignsok  = "real postings all have the same sign"
-          | not rsumok    = "real postings' sum should be 0 but is: " ++ showMixedAmount (mixedAmountSetFullPrecision rsumcost)
+          | not rsumok    = printf "real postings' sum should be %s but is %s (rounded from %s)" rsumexpected rsumactual rsumfull
           | otherwise     = ""
         bvmsg
           | not bvsignsok = "balanced virtual postings all have the same sign"
-          | not bvsumok   = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount (mixedAmountSetFullPrecision bvsumcost)
+          | not bvsumok   = printf "balanced virtual postings' sum should be %s but is %s (rounded from %s)" bvsumexpected bvsumactual bvsumfull
           | otherwise     = ""
+        rsumexpected = showMixedAmountWithZeroCommodity $ mapMixedAmount (\a -> a{aquantity=0}) rsumstyled
+        rsumactual = showMixedAmount rsumstyled
+        rsumfull = showMixedAmount (mixedAmountSetFullPrecision rsumcost)
+        bvsumexpected = showMixedAmountWithZeroCommodity $ mapMixedAmount (\a -> a{aquantity=0}) rsumstyled
+        bvsumactual = showMixedAmount bvsumstyled
+        bvsumfull = showMixedAmount (mixedAmountSetFullPrecision bvsumcost)
 
 -- | Legacy form of transactionCheckBalanced.
 isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool

hledger/test/journal/transaction-balancing.test

@@ -1,19 +1,43 @@
-# test some specific transaction balanced checking issues
+# Test cases for balanced-transaction checking, cf #1479
 
-# Old journal entries dependent on commodity directives for balancing (#1479)
 <
 commodity $0.00
 
 2021-01-01 move a lot elsewhere, adjusting cost basis due to fees
-    assets:investments1            AAAA -11.0 @ $0.093735
-    expenses:fees                  AAAA   0.6
-    equity:basis adjustment        AAAA  -0.6
-    assets:investments2            AAAA  10.4 @ $0.099143
+    assets:investments1            A -11.0 @ B 0.093735
+    expenses:fees                  A   0.6
+    equity:basis adjustment        A  -0.6
+    assets:investments2            A  10.4 @ B 0.099143
 
-# 1. fail with default "exact" balanced checking
+# 1, 2. succeeds with old "styled" and new "exact" balanced checking
+$ hledger -f- check --balancing=styled
 $ hledger -f- check
->2 /real postings' sum should be 0 but is: \$0.0000022/
->=1
 
-# 2. succeed with "styled" balanced checking
+<
+commodity $0.00
+
+2021-01-01
+    a    A -11.0 @ B 0.093735
+    b     A 10.4 @ B 0.099143
+
+# 3, 4. succeeds with old and new balanced checking
 $ hledger -f- check --balancing=styled
+$ hledger -f- check
+
+<
+commodity B0.00
+
+2021-01-01
+    a      A -9514.405544 @ B 0.104314
+    b       A 9513.805544 @ B 0.1043206
+
+# 5, 6. succeeds and fails with old and new balanced checking
+$ hledger -f- check --balancing=styled
+$ hledger -f- check
+>2 //
+>= 1
+
+# <
+# 2021-01-01
+#    a  1C @ $1.0049
+#    b  $-1.000