lib: use a transaction's amount precisions when balancing it

Surprising developments in old behaviour, as a consequence of #931:
now that print shows amounts with all of their decimal places, 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, which is a
nice simplification.

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).

Inferred unit transaction prices (which arise in a two-commodity
transaction with 3+ postings, and can be seen with print -x) may now
be generated with a different number of decimal places than before.
Specifically, it will be the sum of the the number of decimal places
in the amounts being converted to and from. (Whereas before, it was..
some other, perhaps larger number.) 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))
@@ -662,8 +662,7 @@ type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s))
 -- | The state used while balancing a sequence of transactions.
 data BalancingState s = BalancingState {
    -- read only
-   bsStyles       :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
-  ,bsUnassignable :: S.Set AccountName                          -- ^ accounts in which balance assignments may not be used
+   bsUnassignable :: S.Set AccountName                          -- ^ accounts in which balance assignments may not be used
   ,bsAssrt        :: Bool                                       -- ^ whether to check balance assertions
    -- mutable
   ,bsBalances     :: H.HashTable s AccountName MixedAmount      -- ^ running account balances, initially empty
@@ -722,18 +721,18 @@ 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' =
   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
     -- balance assignments will not be allowed on these
     txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j
   in
@@ -750,7 +749,7 @@ journalBalanceTransactions assrt j' =
         -- and leaving the others for later. The balanced ones are split into their postings.
         -- The postings and not-yet-balanced transactions remain in the same relative order.
         psandts :: [Either Posting Transaction] <- fmap concat $ forM ts $ \case
-          t | null $ assignmentPostings t -> case balanceTransaction styles t of
+          t | null $ assignmentPostings t -> case balanceTransaction t of
               Left  e  -> throwError e
               Right t' -> do
                 lift $ writeArray balancedtxns (tindex t') t'
@@ -760,7 +759,7 @@ journalBalanceTransactions assrt j' =
         -- 2. Sort these items by date, preserving the order of same-day items,
         -- and step through them while keeping running account balances,
         runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j)
-        flip runReaderT (BalancingState styles txnmodifieraccts assrt runningbals balancedtxns) $ do
+        flip runReaderT (BalancingState txnmodifieraccts assrt runningbals balancedtxns) $ do
           -- performing balance assignments in, and balancing, the remaining transactions,
           -- and checking balance assertions as each posting is processed.
           void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts
@@ -788,8 +787,7 @@ balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
   -- update the account's running balance and check the balance assertion if any
   ps' <- forM ps $ \p -> pure (removePrices p) >>= addOrAssignAmountAndCheckAssertionB
   -- infer any remaining missing amounts, and make sure the transaction is now fully balanced
-  styles <- R.reader bsStyles
-  case balanceTransactionHelper styles t{tpostings=ps'} of
+  case balanceTransactionHelper t{tpostings=ps'} of
     Left err -> throwError err
     Right (t', inferredacctsandamts) -> do
       -- for each amount just inferred, update the running balance
@@ -965,25 +963,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 +1041,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}