From 2256d25ee3ca5ccd50dd7a95e96fee77c55b9e05 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 9 Feb 2021 17:54:29 -0800 Subject: [PATCH] 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 --- hledger-lib/Hledger/Data/Journal.hs | 112 +++++++++++------- hledger-lib/Hledger/Data/Transaction.hs | 52 ++++++-- hledger-lib/Hledger/Read/Common.hs | 93 ++++++++++----- hledger-lib/Hledger/Reports/BalanceReport.hs | 2 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 3 +- hledger/Hledger/Cli/CliOptions.hs | 1 + hledger/Hledger/Cli/Utils.hs | 8 +- hledger/hledger.m4.md | 54 +++++++++ hledger/test/balance/budget.test | 57 +++++---- hledger/test/close.test | 24 ++-- hledger/test/journal/precision.test | 12 +- .../test/journal/transaction-balancing.test | 19 +++ hledger/test/journal/transaction-prices.test | 12 +- 13 files changed, 309 insertions(+), 140 deletions(-) create mode 100644 hledger/test/journal/transaction-balancing.test diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 6de4faf36888..fba9715f76c7 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/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 diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 222f4e6c7488..fb3d14f250b3 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index cfe34a7015bb..d579c89375c9 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -30,6 +30,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. module Hledger.Read.Common ( Reader (..), InputOpts (..), + BalancingType (..), definputopts, rawOptsToInputOpts, @@ -151,7 +152,7 @@ import Text.Megaparsec.Custom import Hledger.Data import Hledger.Utils -import Safe (headMay) +import Safe (headMay, lastMay) import Text.Printf (printf) --- ** doctest setup @@ -204,6 +205,7 @@ data InputOpts = InputOpts { ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed ,commoditystyles_ :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ optional commodity display styles affecting all files ,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared) + ,balancingtype_ :: BalancingType -- ^ which transaction balancing strategy to use } deriving (Show) instance Default InputOpts where def = definputopts @@ -221,6 +223,7 @@ definputopts = InputOpts , auto_ = False , commoditystyles_ = Nothing , strict_ = False + , balancingtype_ = StyledBalancing } rawOptsToInputOpts :: RawOpts -> InputOpts @@ -237,8 +240,28 @@ rawOptsToInputOpts rawopts = InputOpts{ ,auto_ = boolopt "auto" rawopts ,commoditystyles_ = Nothing ,strict_ = boolopt "strict" rawopts + ,balancingtype_ = fromMaybe ExactBalancing $ balancingTypeFromRawOpts rawopts } +-- | How should transactions be checked for balancedness ? +-- Ie, to how many decimal places should we check each commodity's zero balance ? +data BalancingType = + ExactBalancing -- ^ render the sum with the max precision used in the transaction + | StyledBalancing -- ^ render the sum with the precision from the journal's display styles, eg from commodity directives + deriving (Eq,Show) + +-- | Parse the transaction balancing strategy, specified by --balancing. +balancingTypeFromRawOpts :: RawOpts -> Maybe BalancingType +balancingTypeFromRawOpts rawopts = lastMay $ collectopts balancingfromrawopt rawopts + where + balancingfromrawopt (name,value) + | name == "balancing" = Just $ balancing value + | otherwise = Nothing + balancing value + | not (null value) && value `isPrefixOf` "exact" = ExactBalancing + | not (null value) && value `isPrefixOf` "styled" = StyledBalancing + | otherwise = usageError $ "could not parse \""++value++"\" as balancing type, should be: exact|styled" + --- ** parsing utilities -- | Run a text parser in the identity monad. See also: parseWithState. @@ -325,7 +348,7 @@ parseAndFinaliseJournal' parser iopts f txt = do -- - infer transaction-implied market prices from transaction prices -- journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal -journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f txt pj = do +journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_,balancingtype_} f txt pj = do t <- liftIO getClockTime d <- liftIO getCurrentDay let pj' = @@ -342,35 +365,43 @@ journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f t -- and using declared commodities case if strict_ then journalCheckCommoditiesDeclared pj' else Right () of Left e -> throwError e - Right () -> - - -- Infer and apply canonical styles for each commodity (or throw an error). - -- This affects transaction balancing/assertions/assignments, so needs to be done early. - case journalApplyCommodityStyles pj' of - Left e -> throwError e - Right pj'' -> either throwError return $ - pj'' - & (if not auto_ || null (jtxnmodifiers pj'') - then - -- Auto postings are not active. - -- Balance all transactions and maybe check balance assertions. - journalBalanceTransactions (not ignore_assertions_) - else \j -> do -- Either monad - -- Auto postings are active. - -- Balance all transactions without checking balance assertions, - j' <- journalBalanceTransactions False j - -- then add the auto postings - -- (Note adding auto postings after balancing means #893b fails; - -- adding them before balancing probably means #893a, #928, #938 fail.) - case journalModifyTransactions d j' of - Left e -> throwError e - Right j'' -> do - -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?) - j''' <- journalApplyCommodityStyles j'' - -- then check balance assertions. - journalBalanceTransactions (not ignore_assertions_) j''' - ) - & fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions + Right () -> do + -- Infer and save canonical commodity display styles here, before transaction balancing. + case journalInferCommodityStyles pj' of + Left e -> throwError e + Right pj'' -> do + let + allstyles = journalCommodityStyles pj'' + useglobalstyles = balancingtype_ == StyledBalancing + -- Balance transactions, and possibly add auto postings and check balance assertions. + case (pj'' + & (if not auto_ || null (jtxnmodifiers pj'') + then + -- Auto postings are not active. + -- Balance all transactions and maybe check balance assertions. + journalBalanceTransactions useglobalstyles (not ignore_assertions_) + else \j -> do -- Either monad + -- Auto postings are active. + -- Balance all transactions without checking balance assertions, + j' <- journalBalanceTransactions useglobalstyles False j + -- then add the auto postings + -- (Note adding auto postings after balancing means #893b fails; + -- adding them before balancing probably means #893a, #928, #938 fail.) + case journalModifyTransactions d j' of + Left e -> throwError e + Right j'' -> do + -- then check balance assertions. + journalBalanceTransactions useglobalstyles (not ignore_assertions_) j'' + )) of + Left e -> throwError e + Right pj''' -> do + let + pj'''' = pj''' + -- Apply the (pre-transaction-balancing) commodity styles to all amounts. + & journalApplyCommodityStyles allstyles + -- Infer market prices from commodity-exchanging transactions. + & journalInferMarketPricesFromTransactions + return pj'''' -- | Check that all the journal's transactions have payees declared with -- payee directives, returning an error message otherwise. diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 78f67881ab15..2a0a1f336f79 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -76,7 +76,7 @@ balanceReport rspec j = (rows, total) -- tests Right samplejournal2 = - journalBalanceTransactions False + journalBalanceTransactions False False nulljournal{ jtxns = [ txnTieKnot Transaction{ diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 1081ab4ee2cb..3827c9913301 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -110,7 +110,8 @@ budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport -- for BudgetReport. journalAddBudgetGoalTransactions :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal journalAddBudgetGoalTransactions assrt _ropts reportspan j = - either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts } -- PARTIAL: + -- TODO: always using exact balancing, do we need to support styled balancing for BC ? + either error' id $ journalBalanceTransactions False assrt j{ jtxns = budgetts } -- PARTIAL: where budgetspan = dbg3 "budget span" $ reportspan budgetts = diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index e4dabca848ee..c932b603607e 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -127,6 +127,7 @@ inputflags = [ ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "OLD=NEW" "rename accounts named OLD to NEW" ,flagNone ["anon"] (setboolopt "anon") "anonymize accounts and payees" ,flagReq ["pivot"] (\s opts -> Right $ setopt "pivot" s opts) "TAGNAME" "use some other field/tag for account names" + ,flagReq ["balancing"] (\s opts -> Right $ setopt "balancing" s opts) "exact|styled" "balance transactions using transaction's exact precisions (default, recommended) or commodity display styles' precisions (like hledger <=1.20)" ,flagNone ["ignore-assertions","I"] (setboolopt "ignore-assertions") "ignore any balance assertions" ,flagNone ["strict","s"] (setboolopt "strict") "do extra error checking (check that all posted accounts are declared)" ] diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index b8bbb2e60b1b..3ad8f5db3bbd 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -121,7 +121,7 @@ journalAddForecast :: CliOpts -> Journal -> Journal journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = case forecast_ ropts of Nothing -> j - Just _ -> either (error') id . journalApplyCommodityStyles $ -- PARTIAL: + Just _ -> either (error') id . journalInferAndApplyCommodityStyles $ -- PARTIAL: journalBalanceTransactions' iopts j{ jtxns = concat [jtxns j, forecasttxns'] } where today = rsToday rspec @@ -151,9 +151,11 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = forecasttxns journalBalanceTransactions' iopts j = - let assrt = not . ignore_assertions_ $ iopts + let + assrt = not . ignore_assertions_ $ iopts + styledbalancing = balancingtype_ iopts == StyledBalancing in - either error' id $ journalBalanceTransactions assrt j -- PARTIAL: + either error' id $ journalBalanceTransactions styledbalancing assrt j -- PARTIAL: -- | Write some output to stdout or to a file selected by --output-file. -- If the file exists it will be overwritten. diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index ed5299721f7b..da208094dfe1 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -1464,6 +1464,10 @@ Here's a simple journal file containing one transaction: income:salary $-1 ``` +Note a transaction's postings have an important property: their +amounts are required to add up to zero, showing that money has not +been created or destroyed, only moved. +This is discussed in more detail below. ## Dates @@ -1724,6 +1728,8 @@ without using a balancing equity account: (assets:savings) $2000 ``` +### Balanced virtual postings + A posting with a bracketed account name is called a *balanced virtual posting*. The balanced virtual postings in a transaction must add up to zero (separately from other postings). Eg: @@ -1976,6 +1982,54 @@ hledger will parse these, for compatibility with Ledger journals, but currently A [transaction price](#transaction-prices), lot price and/or lot date may appear in any order, after the posting amount and before the balance assertion if any. +## Balanced transactions + +As mentioned above, the amounts of a transaction's posting are required to add up to zero. +This shows that "money was conserved" during the transaction, ie no +funds were created or destroyed. +We call this a balanced transaction. + +If you want the full detail of how exactly this works in hledger, read on... + +Transactions can contain [ordinary (real) postings](#postings), +[balanced virtual postings](#balanced-virtual-postings), and/or +[unbalanced virtual postings](#virtual-postings). +hledger checks that the real postings sum to zero, +the balanced virtual postings (separately) sum to zero, +and does not check unbalanced virtual postings. + +Because computers generally don't represent decimal (real) numbers +exactly, "sum to zero" is a little more complicated. +hledger aims to always agree with a human who is looking at the +[`print`](#print)-ed transaction and doing the arithmetic by hand. +Specifically, it does this: + +- for each commodity referenced in the transaction, +- sum the amounts of that commodity, +- render that sum with a certain precision (number of decimal places), +- and check that the rendered number is all zeros. + +What is that precision (for each commodity) ? +Since hledger 1.21, by default it is the maximum precision used +in the transaction's journal entry (which is also what the `print` +command shows). + +However in hledger 1.20 and before, it was the precision specified by +the journal's [declared](#declaring-commodities) or inferred +[commodity display styles](#commodity-display-style) +(because that's what the `print` command showed). + +You may have some existing journals which are dependent on this older behaviour. +Ie, hledger <=1.20 accepts them but hledger >=1.21 reports "unbalanced transaction". +So we provide the `--balancing=styled` option, which restores the old balanced transaction checking +(but not the old `print` behaviour, so balanced checking might not always agree with what `print` shows.) +Note this is just a convenience to ease migration, and may be dropped in future, +so we recommend that you update your journal entries to satisfy the new balanced checking +(`--balancing=exact`, which is the default). +(Advantages of the new way: it agrees with `print` output; +it is simpler, depending only on the transaction's journal entry; +and it is more robust when `print`-ing transactions to be re-parsed by hledger.) + ## Balance assertions hledger supports diff --git a/hledger/test/balance/budget.test b/hledger/test/balance/budget.test index 4d6376ac8a81..9f15fa146754 100644 --- a/hledger/test/balance/budget.test +++ b/hledger/test/balance/budget.test @@ -365,49 +365,48 @@ Budget performance in 2018-05-01..2018-06-30, valued at period ends: $ hledger -f- bal --budget Budget performance in 2019-01-01..2019-01-03: - || 2019-01-01..2019-01-03 -===================++=========================== - expenses:personal || $50.00 [5% of $1,000.00] - liabilities || $-50.00 [5% of $-1000.00] --------------------++--------------------------- - || 0 [ 0] + || 2019-01-01..2019-01-03 +===================++============================ + expenses:personal || $50.00 [5% of $1,000.00] + liabilities || $-50.00 [5% of $-1,000.00] +-------------------++---------------------------- + || 0 [ 0] # 17. $ hledger -f- bal --budget -E Budget performance in 2019-01-01..2019-01-03: - || 2019-01-01..2019-01-03 -========================================++=========================== - expenses:personal || $50.00 [5% of $1,000.00] - expenses:personal:electronics || $20.00 - expenses:personal:electronics:upgrades || $10.00 - liabilities || $-50.00 [5% of $-1000.00] -----------------------------------------++--------------------------- - || 0 [ 0] + || 2019-01-01..2019-01-03 +========================================++============================ + expenses:personal || $50.00 [5% of $1,000.00] + expenses:personal:electronics || $20.00 + expenses:personal:electronics:upgrades || $10.00 + liabilities || $-50.00 [5% of $-1,000.00] +----------------------------------------++---------------------------- + || 0 [ 0] # 18. $ hledger -f- bal --budget --tree Budget performance in 2019-01-01..2019-01-03: - || 2019-01-01..2019-01-03 -===================++=========================== - expenses:personal || $50.00 [5% of $1,000.00] - liabilities || $-50.00 [5% of $-1000.00] --------------------++--------------------------- - || 0 [ 0] - + || 2019-01-01..2019-01-03 +===================++============================ + expenses:personal || $50.00 [5% of $1,000.00] + liabilities || $-50.00 [5% of $-1,000.00] +-------------------++---------------------------- + || 0 [ 0] # 19. $ hledger -f- bal --budget --tree -E Budget performance in 2019-01-01..2019-01-03: - || 2019-01-01..2019-01-03 -===================++=========================== - expenses:personal || $50.00 [5% of $1,000.00] - electronics || $20.00 - upgrades || $10.00 - liabilities || $-50.00 [5% of $-1000.00] --------------------++--------------------------- - || 0 [ 0] + || 2019-01-01..2019-01-03 +===================++============================ + expenses:personal || $50.00 [5% of $1,000.00] + electronics || $20.00 + upgrades || $10.00 + liabilities || $-50.00 [5% of $-1,000.00] +-------------------++---------------------------- + || 0 [ 0] # 20. Subaccounts + nested budgets < diff --git a/hledger/test/close.test b/hledger/test/close.test index 9d86d4beeedc..d5dc61c4ec2e 100644 --- a/hledger/test/close.test +++ b/hledger/test/close.test @@ -271,20 +271,20 @@ commodity AAA 0.00000000 $ hledger -f- close -p 2019 assets --show-costs -x 2019-12-31 closing balances - assets:aaa AAA -510.00000000 = AAA 0.00000000 - assets:usd $-49.50 - assets:usd $49.390001 @ AAA 10.3528242505 = $0.00 - equity:opening/closing balances $49.50 - equity:opening/closing balances $-49.390001 @ AAA 10.3528242505 - equity:opening/closing balances AAA 510.00000000 + assets:aaa AAA -510.00000000 = AAA 0.00000000 + assets:usd $-49.50 + assets:usd $49.390001 @ AAA 10.35282425045552 = $0.00 + equity:opening/closing balances $49.50 + equity:opening/closing balances $-49.390001 @ AAA 10.35282425045552 + equity:opening/closing balances AAA 510.00000000 2020-01-01 opening balances - assets:aaa AAA 510.00000000 = AAA 510.00000000 - assets:usd $49.50 - assets:usd $-49.390001 @ AAA 10.3528242505 = $0.109999 - equity:opening/closing balances $-49.50 - equity:opening/closing balances $49.390001 @ AAA 10.3528242505 - equity:opening/closing balances AAA -510.00000000 + assets:aaa AAA 510.00000000 = AAA 510.00000000 + assets:usd $49.50 + assets:usd $-49.390001 @ AAA 10.35282425045552 = $0.109999 + equity:opening/closing balances $-49.50 + equity:opening/closing balances $49.390001 @ AAA 10.35282425045552 + equity:opening/closing balances AAA -510.00000000 >=0 diff --git a/hledger/test/journal/precision.test b/hledger/test/journal/precision.test index 18ced3ac3152..ef70c06c46fc 100644 --- a/hledger/test/journal/precision.test +++ b/hledger/test/journal/precision.test @@ -123,9 +123,9 @@ hledger -f- print --explicit d D -320.00 >>> 2015-01-01 - c C 10.00 @ D 15.2381 - c C 11.00 @ D 15.2381 - d D -320.00 + c C 10.00 @ D 15.23809524 + c C 11.00 @ D 15.23809524 + d D -320.00 >>>=0 @@ -140,8 +140,8 @@ hledger -f- print --explicit f F -320.000 >>> 2015-01-01 - e E 10.0000 @ F 15.2380952 - e E 11.0000 @ F 15.2380952 - f F -320.000 + e E 10.0000 @ F 15.23809523809524 + e E 11.0000 @ F 15.23809523809524 + f F -320.000 >>>=0 diff --git a/hledger/test/journal/transaction-balancing.test b/hledger/test/journal/transaction-balancing.test new file mode 100644 index 000000000000..fa167db774b0 --- /dev/null +++ b/hledger/test/journal/transaction-balancing.test @@ -0,0 +1,19 @@ +# test some specific transaction balanced checking issues + +# 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 + +# 1. fail with default "exact" balanced checking +$ hledger -f- check +>2 /real postings' sum should be 0 but is: \$0.0000022/ +>=1 + +# 2. succeed with "styled" balanced checking +$ hledger -f- check --balancing=styled diff --git a/hledger/test/journal/transaction-prices.test b/hledger/test/journal/transaction-prices.test index eff5c3be4ba8..6b90e5c7e15e 100644 --- a/hledger/test/journal/transaction-prices.test +++ b/hledger/test/journal/transaction-prices.test @@ -51,12 +51,12 @@ hledger -f - print --explicit misc $-2.1 >>> 2011-01-01 - expenses:foreign currency €100 @ $1.35 - misc $2.10 - assets $-135.00 - misc €1 @ $1.35 - misc €-1 @ $1.35 - misc $-2.10 + expenses:foreign currency €100 @ $1.3500 + misc $2.10 + assets $-135.00 + misc €1 @ $1.3500 + misc €-1 @ $1.3500 + misc $-2.10 >>>=0