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

This commit is contained in:
Simon Michael 2025-06-09 23:34:44 -10:00
parent 442bd24bc5
commit bf90b20f2c
6 changed files with 66 additions and 9 deletions

View File

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

View File

@ -65,6 +65,7 @@ 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
@ -72,6 +73,7 @@ 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

View File

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

View File

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

View File

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

View File

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