use a transaction's amount precisions when balancing it (#1479)

A surprising development in old behaviour: as a consequence of #931,
print now shows amounts with all of their decimal places, so we had
better balance transactions using all of those visible digits
(so that hledger and a user will agree on whether it's balanced).

So now when transaction balancing compares amounts to see if they look
equal, it uses (for each commodity) the maximum precision seen in just
that transaction's amounts - not the precision from the journal's
commodity display styles.

This makes it more localised - therefore simpler - and more robust,
when print-ing transactions to be re-parsed by hledger (previously,
print-ed transactions could be unparseable because they were dependent
on commodity directives).

However, the new behaviour can break existing journals, so we provide
a `--balancing=exact|styled` option to select the new (default) or old
balancing behaviour. (The old behaviour may not be *perfectly*
replicated, but it's hopefully close enough to be unnoticeable.)
This is intended as a temporary migration aid, hopefully to be removed
eventually.

In journalFinalise, applying commodity display styles to the journal's
amounts is now done as a final step (after transaction balancing, not
before), and only once (rather than twice when auto postings are
enabled), and seems slightly more thorough (affecting some inferred
amounts where it didn't before).

As a consequence of this change, inferred unit transaction
prices (which arise in a two-commodity transaction with 3+ postings,
and can be seen with print -x) may in some cases be generated with a
different (greater) precision than before. Specifically, it will now
be the sum of the number of decimal places in the amounts being
converted to and from. (Whereas before, it was.. something else.)
Hopefully this will always be a suitable number of digits such that
hledger's & users' calculation of balancedness will agree.

Lib changes:

Hledger.Data.Journal
added:
journalInferCommodityStyles
journalInferAndApplyCommodityStyles
removed:
canonicalStyleFrom

Author: simonmichael

hledger-lib/Hledger/Data/Journal.hs

@@ -23,8 +23,9 @@ module Hledger.Data.Journal (
   addTransaction,
   journalBalanceTransactions,
   journalInferMarketPricesFromTransactions,
+  journalInferCommodityStyles,
   journalApplyCommodityStyles,
-  commodityStylesFromAmounts,
+  journalInferAndApplyCommodityStyles,
   journalCommodityStyles,
   journalToCost,
   journalReverse,
@@ -78,7 +79,6 @@ module Hledger.Data.Journal (
   journalEquityAccountQuery,
   journalCashAccountQuery,
   -- * Misc
-  canonicalStyleFrom,
   nulljournal,
   journalCheckBalanceAssertions,
   journalNumberAndTieTransactions,
@@ -87,7 +87,7 @@ module Hledger.Data.Journal (
   journalApplyAliases,
   -- * Tests
   samplejournal,
-  tests_Journal,
+  tests_Journal
 )
 where
 
@@ -101,7 +101,7 @@ import Data.Function ((&))
 import qualified Data.HashTable.Class as H (toList)
 import qualified Data.HashTable.ST.Cuckoo as H
 import Data.List (find, sortOn)
-import Data.List.Extra (groupSort, nubSort)
+import Data.List.Extra (nubSort)
 import qualified Data.Map as M
 import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe)
 #if !(MIN_VERSION_base(4,11,0))
@@ -627,7 +627,8 @@ journalModifyTransactions d j =
 -- | Check any balance assertions in the journal and return an error message
 -- if any of them fail (or if the transaction balancing they require fails).
 journalCheckBalanceAssertions :: Journal -> Maybe String
-journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True
+journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions False True
+  -- TODO: not using global display styles here, do we need to for BC ?
 
 -- "Transaction balancing", including: inferring missing amounts,
 -- applying balance assignments, checking transaction balancedness,
@@ -722,18 +723,20 @@ updateTransactionB t = withRunningBalance $ \BalancingState{bsTransactions}  ->
 -- and (optional) all balance assertions pass. Or return an error message
 -- (just the first error encountered).
 --
--- Assumes journalInferCommodityStyles has been called, since those
--- affect transaction balancing.
+-- Assumes the journal amounts' display styles still have the original number
+-- of decimal places that was parsed (ie, display styles have not yet been normalised),
+-- since this affects transaction balancing.
 --
 -- This does multiple things at once because amount inferring, balance
 -- assignments, balance assertions and posting dates are interdependent.
-journalBalanceTransactions :: Bool -> Journal -> Either String Journal
-journalBalanceTransactions assrt j' =
+--
+journalBalanceTransactions :: Bool -> Bool -> Journal -> Either String Journal
+journalBalanceTransactions usedisplaystyles assrt j' =
   let
     -- ensure transactions are numbered, so we can store them by number
     j@Journal{jtxns=ts} = journalNumberTransactions j'
     -- display precisions used in balanced checking
-    styles = Just $ journalCommodityStyles j
+    styles = if usedisplaystyles then Just $ journalCommodityStyles j else Nothing
     -- balance assignments will not be allowed on these
     txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j
   in
@@ -965,25 +968,66 @@ checkBalanceAssignmentUnassignableAccountB p = do
 
 --
 
+-- | Get an ordered list of amounts in this journal which can
+-- influence canonical amount display styles. Those are, in
+-- the following order:
+--
+-- * amounts in market price (P) directives (in parse order)
+-- * posting amounts in transactions (in parse order)
+-- * the amount in the final default commodity (D) directive
+--
+-- Transaction price amounts (posting amounts' aprice field) are not included.
+--
+journalStyleInfluencingAmounts :: Journal -> [Amount]
+journalStyleInfluencingAmounts j = 
+  dbg7 "journalStyleInfluencingAmounts" $
+  catMaybes $ concat [
+   [mdefaultcommodityamt]
+  ,map (Just . pdamount) $ jpricedirectives j
+  ,map Just $ concatMap amounts $ map pamount $ journalPostings j
+  ]
+  where
+    -- D's amount style isn't actually stored as an amount, make it into one
+    mdefaultcommodityamt =
+      case jparsedefaultcommodity j of
+        Just (symbol,style) -> Just nullamt{acommodity=symbol,astyle=style}
+        Nothing -> Nothing
+
+-- | Infer commodity display styles for each commodity (see commodityStylesFromAmounts) 
+-- based on the amounts in this journal (see journalStyleInfluencingAmounts), 
+-- and save those inferred styles in the journal.
+-- Can return an error message eg if inconsistent number formats are found.
+journalInferCommodityStyles :: Journal -> Either String Journal
+journalInferCommodityStyles j = 
+  case commodityStylesFromAmounts $ journalStyleInfluencingAmounts j of
+    Left e   -> Left e
+    Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs}
+
+-- | Apply the given commodity display styles to the posting amounts in this journal.
+journalApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Journal -> Journal
+journalApplyCommodityStyles styles j@Journal{jtxns=ts, jpricedirectives=pds} =
+  j {jtxns=map fixtransaction ts
+    ,jpricedirectives=map fixpricedirective pds
+    }
+  where
+    fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
+    fixposting p = p{pamount=styleMixedAmount styles $ pamount p
+                    ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
+    -- balance assertion/assignment amounts, and price amounts, are always displayed
+    -- (eg by print) at full precision
+    fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba}
+    fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a}
+
 -- | Choose and apply a consistent display style to the posting
 -- amounts in each commodity (see journalCommodityStyles).
 -- Can return an error message eg if inconsistent number formats are found.
-journalApplyCommodityStyles :: Journal -> Either String Journal
-journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} =
+journalInferAndApplyCommodityStyles :: Journal -> Either String Journal
+journalInferAndApplyCommodityStyles j =
   case journalInferCommodityStyles j of
     Left e   -> Left e
-    Right j' -> Right j''
+    Right j' -> Right $ journalApplyCommodityStyles allstyles j'
       where
-        styles = journalCommodityStyles j'
-        j'' = j'{jtxns=map fixtransaction ts
-                ,jpricedirectives=map fixpricedirective pds
-                }
-        fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}
-        fixposting p = p{pamount=styleMixedAmount styles $ pamount p
-                        ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
-        -- balance assertion amounts are always displayed (by print) at full precision, per docs
-        fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba}
-        fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a}
+        allstyles = journalCommodityStyles j'
 
 -- | Get the canonical amount styles for this journal, whether (in order of precedence):
 -- set globally in InputOpts,
@@ -1002,18 +1046,6 @@ journalCommodityStyles j =
     defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j]
     inferredstyles        = jinferredcommodities j
 
--- | Collect and save inferred amount styles for each commodity based on
--- the posting amounts in that commodity (excluding price amounts), ie:
--- "the format of the first amount, adjusted to the highest precision of all amounts".
--- Can return an error message eg if inconsistent number formats are found.
-journalInferCommodityStyles :: Journal -> Either String Journal
-journalInferCommodityStyles j = 
-  case
-    commodityStylesFromAmounts $ journalStyleInfluencingAmounts j
-  of
-    Left e   -> Left e
-    Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs}
-
 -- -- | Apply this journal's historical price records to unpriced amounts where possible.
 -- journalApplyPriceDirectives :: Journal -> Journal
 -- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
@@ -1242,7 +1274,7 @@ journalApplyAliases aliases j =
 --     liabilities:debts  $1
 --     assets:bank:checking
 --
-Right samplejournal = journalBalanceTransactions False $
+Right samplejournal = journalBalanceTransactions False False $
          nulljournal
          {jtxns = [
            txnTieKnot $ Transaction {
@@ -1385,7 +1417,7 @@ tests_Journal = tests "Journal" [
   ,tests "journalBalanceTransactions" [
 
      test "balance-assignment" $ do
-      let ej = journalBalanceTransactions True $
+      let ej = journalBalanceTransactions False True $
             --2019/01/01
             --  (a)            = 1
             nulljournal{ jtxns = [
@@ -1396,7 +1428,7 @@ tests_Journal = tests "Journal" [
       (jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1]
 
     ,test "same-day-1" $ do
-      assertRight $ journalBalanceTransactions True $
+      assertRight $ journalBalanceTransactions False True $
             --2019/01/01
             --  (a)            = 1
             --2019/01/01
@@ -1407,7 +1439,7 @@ tests_Journal = tests "Journal" [
             ]}
 
     ,test "same-day-2" $ do
-      assertRight $ journalBalanceTransactions True $
+      assertRight $ journalBalanceTransactions False True $
             --2019/01/01
             --    (a)                  2 = 2
             --2019/01/01
@@ -1425,7 +1457,7 @@ tests_Journal = tests "Journal" [
             ]}
 
     ,test "out-of-order" $ do
-      assertRight $ journalBalanceTransactions True $
+      assertRight $ journalBalanceTransactions False True $
             --2019/1/2
             --  (a)    1 = 2
             --2019/1/1

hledger-lib/Hledger/Data/Transaction.hs

@@ -82,6 +82,7 @@ import Hledger.Data.Amount
 import Hledger.Data.Valuation
 import Text.Tabular
 import Text.Tabular.AsciiWide
+import Control.Applicative ((<|>))
 
 sourceFilePath :: GenericSourcePos -> FilePath
 sourceFilePath = \case
@@ -358,15 +359,31 @@ transactionsPostings = concatMap tpostings
 --    (Best effort; could be confused by postings with multicommodity amounts.)
 --
 -- 3. Does the amounts' sum appear non-zero when displayed ?
---    (using the given display styles if provided)
+--    We have two ways of checking this: 
+--
+--    Old way, supported for compatibility: if global display styles are provided,
+--    in each commodity, render the sum using the precision from the 
+--    global display styles, and see if it looks like exactly zero.
+--
+--    New way, preferred: in each commodity, render the sum using the max precision
+--    that was used in this transaction's journal entry, and see if it looks
+--    like exactly zero.
 --
 transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> [String]
-transactionCheckBalanced mstyles t = errs
+transactionCheckBalanced mglobalstyles t = errs
   where
     (rps, bvps) = (realPostings t, balancedVirtualPostings t)
 
+    -- For testing each commodity's zero sum, we'll render it with the number
+    -- of decimal places specified by its display style, from either the 
+    -- provided global display styles, or local styles inferred from just 
+    -- this transaction.
+    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
+
     -- check for mixed signs, detecting nonzeros at display precision
-    canonicalise = maybe id canonicaliseMixedAmount mstyles
     signsOk ps = 
       case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of
         nonzeros | length nonzeros >= 2
@@ -385,11 +402,11 @@ transactionCheckBalanced mstyles t = errs
       where
         rmsg
           | not rsignsok  = "real postings all have the same sign"
-          | not rsumok    = "real postings' sum should be 0 but is: " ++ showMixedAmount rsumcost
+          | not rsumok    = "real postings' sum should be 0 but is: " ++ showMixedAmount (mixedAmountSetFullPrecision rsumcost)
           | otherwise     = ""
         bvmsg
           | not bvsignsok = "balanced virtual postings all have the same sign"
-          | not bvsumok   = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount bvsumcost
+          | not bvsumok   = "balanced virtual postings' sum should be 0 but is: " ++ showMixedAmount (mixedAmountSetFullPrecision bvsumcost)
           | otherwise     = ""
 
 -- | Legacy form of transactionCheckBalanced.
@@ -454,7 +471,7 @@ inferBalancingAmount ::
      M.Map CommoditySymbol AmountStyle -- ^ commodity display styles
   -> Transaction
   -> Either String (Transaction, [(AccountName, MixedAmount)])
-inferBalancingAmount styles t@Transaction{tpostings=ps}
+inferBalancingAmount _globalstyles t@Transaction{tpostings=ps}
   | length amountlessrealps > 1
       = Left $ transactionBalanceError t
         ["can't have more than one real posting with no amount"
@@ -486,9 +503,7 @@ inferBalancingAmount styles t@Transaction{tpostings=ps}
           Just a  -> (p{pamount=a', poriginal=Just $ originalPosting p}, Just a')
             where
               -- Inferred amounts are converted to cost.
-              -- Also ensure the new amount has the standard style for its commodity
-              -- (since the main amount styling pass happened before this balancing pass);
-              a' = styleMixedAmount styles $ normaliseMixedAmount $ mixedAmountCost (-a)
+              a' = normaliseMixedAmount $ mixedAmountCost (-a)
 
 -- | Infer prices for this transaction's posting amounts, if needed to make
 -- the postings balance, and if possible. This is done once for the real
@@ -554,7 +569,11 @@ priceInferrerFor t pt = inferprice
       where
         fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe
         conversionprice
+          -- Use a total price when we can, as it's more exact.
           | fromcount==1 = TotalPrice $ abs toamount `withPrecision` NaturalPrecision
+          -- When there are multiple posting amounts to be converted, 
+          -- it's easiest to have them all use the same unit price.
+          -- Floating-point error and rounding becomes an issue though.
           | otherwise    = UnitPrice $ abs unitprice `withPrecision` unitprecision
           where
             fromcount     = length $ filter ((==fromcommodity).acommodity) pamounts
@@ -564,9 +583,20 @@ priceInferrerFor t pt = inferprice
             toamount      = head $ filter ((==tocommodity).acommodity) sumamounts
             toprecision   = asprecision $ astyle toamount
             unitprice     = (aquantity fromamount) `divideAmount` toamount
-            -- Sum two display precisions, capping the result at the maximum bound
+            -- The number of decimal places that will be shown for an
+            -- inferred unit price. Often, the underlying Decimal will
+            -- have the maximum number of decimal places (255). We
+            -- don't want to show that many to the user; we'd prefer
+            -- to show the minimum number of digits that makes the
+            -- print-ed transaction appear balanced if you did the
+            -- arithmetic by hand, and also makes the print-ed transaction
+            -- parseable by hledger. How many decimal places is that ? I'm not sure. 
+            -- Currently we heuristically use 2 * the total number of decimal places 
+            -- from the amounts to be converted to and from (and at least 2, at most 255), 
+            -- which experimentally seems to be sufficient so far.
             unitprecision = case (fromprecision, toprecision) of
-                (Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b)
+                (Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else 
+                  max 2 (2 * (a+b))
                 _                          -> NaturalPrecision
     inferprice p = p