imp: --txn-balancing flag to select transaction balancing precision [#2402]

Author: simonmichael

doc/common.m4

@@ -87,6 +87,9 @@ General input/data transformation flags:
                             hledger-ui, also make future-dated transactions
                             visible at startup.
   -I --ignore-assertions    don't check balance assertions by default
+     --txn-balancing=...    how to check that transactions are balanced:
+                            'old':   use global display precision
+                            'exact': use transaction precision (default)
      --infer-costs          infer conversion equity postings from costs
      --infer-equity         infer costs from conversion equity postings
      --infer-market-prices  infer market prices from costs

hledger-lib/Hledger/Data/Balancing.hs

@@ -65,13 +65,15 @@ data BalancingOpts = BalancingOpts
   , infer_balancing_costs_ :: Bool  -- ^ Are we permitted to infer missing costs to balance transactions ?
                                     --   Distinct from InputOpts{infer_costs_}.
   , commodity_styles_      :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles
+  , txn_balancing_         :: TransactionBalancingPrecision
   } deriving (Eq, Ord, Show)
 
 defbalancingopts :: BalancingOpts
 defbalancingopts = BalancingOpts
   { ignore_assertions_     = False
   , infer_balancing_costs_ = True
   , commodity_styles_      = Nothing
+  , txn_balancing_         = TBPExact
   }
 
 -- | Check that this transaction would appear balanced to a human when displayed.
@@ -92,8 +94,7 @@ defbalancingopts = BalancingOpts
 --    (using the given display styles if provided)
 --
 transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]
--- transactionCheckBalanced BalancingOpts{commodity_styles_=_mstyles} t = errs
-transactionCheckBalanced _ t = errs
+transactionCheckBalanced BalancingOpts{commodity_styles_=_mglobalstyles, txn_balancing_} t = errs
   where
     -- get real and balanced virtual postings, to be checked separately
     (rps, bvps) = foldr partitionPosting ([], []) $ tpostings t
@@ -110,9 +111,16 @@ transactionCheckBalanced _ t = errs
       | costPostingTagName `elem` map fst (ptags p) = mixedAmountStripCosts $ pamount p
       | otherwise                                   = mixedAmountCost $ pamount p
 
-    lookszero = mixedAmountLooksZero .
-      -- maybe id styleAmounts _mstyles                                -- when rounded with global/journal precisions
-      styleAmounts (transactionCommodityStylesWith HardRounding t)  -- when rounded with transaction's precisions
+    lookszero = mixedAmountLooksZero . roundforbalancecheck
+      where
+        roundforbalancecheck = case txn_balancing_ of
+          TBPOld    -> maybe id styleAmounts _mglobalstyles
+          -- TBPCompat -> styleAmounts (transactionstyles `limitprecisionsto` commoditydirectivestyles)
+          TBPExact  -> styleAmounts transactionstyles
+          where
+            transactionstyles = transactionCommodityStylesWith HardRounding t
+            -- limitprecisionsto = undefined
+            -- commoditydirectivestyles = undefined
 
     -- when there's multiple non-zeros, check they do not all have the same sign
     (rsignsok, bvsignsok) = (signsOk rps, signsOk bvps)
@@ -289,7 +297,7 @@ transactionInferBalancingAmount styles t@Transaction{tpostings=ps}
                 & mixedAmountCost
                 -- & dbg9With (lbl "balancing amount converted to cost".showMixedAmountOneLine)
                 & styleAmounts (styles
-                                -- Needed until we switch to locally-inferred balancing precisions:
+                                -- Needed until we switch to locally-inferred balancing precisions: XXX #2402
                                 -- these had hard rounding set to help with balanced-checking;
                                 -- set no rounding now to avoid excessive display precision in output
                                 & amountStylesSetRounding NoRounding

hledger-lib/Hledger/Data/Transaction.hs

@@ -40,6 +40,7 @@ module Hledger.Data.Transaction
 , transactionAddTags
 , transactionAddHiddenAndMaybeVisibleTag
   -- * helpers
+, TransactionBalancingPrecision(..)
 , payeeAndNoteFromDescription
 , payeeAndNoteFromDescription'
   -- nonzerobalanceerror
@@ -85,6 +86,27 @@ import Data.Function ((&))
 import Data.List (union)
 
 
+-- | How to determine the precision used for checking that transactions are balanced. See #2402.
+data TransactionBalancingPrecision
+  = -- | Legacy behaviour, as in hledger <=1.43:
+    -- use precision inferred from the whole journal, overridable by commodity directive or -c.
+    -- Display precision is also transaction balancing precision; increasing it can break journal reading.
+    -- Some journals from ledger or beancount are rejected until commodity directives are added.
+    TBPOld
+  -- | -- | Use precision inferred from the transaction, reducible by commodity directive (or -c ?)
+  --   -- This is more robust when there is no commodity directive, because it's not affected by other transactions or P directives.
+  --   -- Increasing display precision does not increase balancing precision, so it does not break journal reading.
+  --   -- But reducing it does reduce balancing precision, so existing hledger journals which rely on this can still be read.
+  --   -- Journals from ledger or beancount are accepted without needing commodity directives.
+  --   TBPCompat
+  | -- | Use precision inferred from the transaction.
+    -- This is the most strict; transactions that worked with hledger <=1.43 may need to be adjusted.
+    -- It's also the simplest, and most robust overall ?
+    -- Display precision and transaction balancing precision are independent; display precision never affects journal reading.
+    -- Journals from ledger or beancount are accepted without needing commodity directives.
+    TBPExact
+  deriving (Bounded, Enum, Eq, Ord, Read, Show)
+
 instance HasAmounts Transaction where
   styleAmounts styles t = t{tpostings=styleAmounts styles $ tpostings t}
 

hledger-lib/Hledger/Read/Common.hs

@@ -160,6 +160,7 @@ import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToR
 import Hledger.Utils
 import Hledger.Read.InputOptions
 
+
 --- ** doctest setup
 -- $setup
 -- >>> :set -XOverloadedStrings
@@ -214,8 +215,11 @@ rawOptsToInputOpts day usecoloronstdout postingaccttags rawopts =
         argsquery = map fst . rights . map (parseQueryTerm day) $ querystring_ ropts
         datequery = simplifyQuery . filterQuery queryIsDate . And $ queryFromFlags ropts : argsquery
 
+        txnbalancingprecision = either err id $ transactionBalancingPrecisionFromOpts rawopts
+          where err e = error' $ "could not parse --txn-balancing: '" ++ e ++ "'"  -- PARTIAL:
+
         styles = either err id $ commodityStyleFromRawOpts rawopts
-          where err e = error' $ "could not parse commodity-style: '" ++ e ++ "'"  -- PARTIAL:
+          where err e = error' $ "could not parse --commodity-style: '" ++ e ++ "'"  -- PARTIAL:
 
     in definputopts{
        -- files_             = listofstringopt "file" rawopts
@@ -236,6 +240,7 @@ rawOptsToInputOpts day usecoloronstdout postingaccttags rawopts =
       ,balancingopts_     = defbalancingopts{
                                  ignore_assertions_     = boolopt "ignore-assertions" rawopts
                                , infer_balancing_costs_ = not noinferbalancingcosts
+                               , txn_balancing_         = txnbalancingprecision
                                , commodity_styles_      = Just styles
                                }
       ,strict_            = boolopt "strict" rawopts
@@ -274,6 +279,15 @@ commodityStyleFromRawOpts rawOpts =
       Left _ -> Left optStr
       Right (Amount acommodity _ astyle _) -> Right (acommodity, astyle)
 
+transactionBalancingPrecisionFromOpts :: RawOpts -> Either String TransactionBalancingPrecision
+transactionBalancingPrecisionFromOpts rawopts =
+  case maybestringopt "txn-balancing" rawopts of
+    Nothing      -> Right TBPExact
+    Just "old"   -> Right TBPOld
+    -- Just "compat" -> Right TBPCompat
+    Just "exact" -> Right TBPExact
+    Just s       -> Left $ s<>", should be one of: old, exact" -- compat
+
 -- | Given a parser to ParsedJournal, input options, file path and
 -- content: run the parser on the content, and finalise the result to
 -- get a Journal; or throw an error.
@@ -285,7 +299,7 @@ parseAndFinaliseJournal parser iopts f txt =
 -- | Given a parser to ParsedJournal, input options, file path and
 -- content: run the parser on the content. This is all steps of
 -- 'parseAndFinaliseJournal' without the finalisation step, and is used when
--- you need to perform other actions before finalisation, as in parsing
+-- you need to perform other actions before finalisatison, as in parsing
 -- Timeclock and Timedot files.
 initialiseAndParseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
                           -> FilePath -> Text -> ExceptT String IO Journal

hledger/Hledger/Cli/CliOptions.hs

@@ -164,6 +164,12 @@ inputflags = [
     , "In hledger-ui, also make future-dated transactions visible at startup."
     ])
   ,flagNone ["ignore-assertions","I"] (setboolopt "ignore-assertions") "don't check balance assertions by default"
+  ,flagReq  ["txn-balancing"] (\s opts -> Right $ setopt "txn-balancing" s opts) "..." (unlines [
+     "how to check that transactions are balanced:"
+    ,"'old':   - use global display precision"
+    -- ,"'compat': - use transaction precision, reducible"
+    ,"'exact': - use transaction precision (default)"
+    ])
   ,flagNone ["infer-costs"] (setboolopt "infer-costs") "infer conversion equity postings from costs"
   ,flagNone ["infer-equity"] (setboolopt "infer-equity") "infer costs from conversion equity postings"
   -- history of this flag so far, lest we be confused:

hledger/test/journal/precision.test

@@ -221,7 +221,7 @@ $ hledger -f - bal -N
 
 # ** 16. Before hledger 1.44, an inexactly balanced entry like this could be accepted
 # because of a commodity directive reducing the display/balance-checking precision.
-# From 1.44, transaction balancing uses the transaction's local precisions only,
+# From 1.44, transaction balancing uses the transaction's local precisions by default,
 # making the balance checking more strict in this case.
 <
 commodity $1.00
@@ -233,3 +233,7 @@ commodity $1.00
 $ hledger -f - check
 >2 /unbalanced/
 >= 1
+
+# ** 17. --txn-balancing=old can be used to restore the pre-1.44 behaviour.
+$ hledger -f - check --txn-balancing=old
+