diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 4f19befe306..ca1ff548df7 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)) @@ -653,7 +653,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, @@ -748,18 +749,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 @@ -991,25 +994,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, @@ -1028,18 +1072,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} @@ -1268,7 +1300,7 @@ journalApplyAliases aliases j = -- liabilities:debts $1 -- assets:bank:checking -- -Right samplejournal = journalBalanceTransactions False $ +Right samplejournal = journalBalanceTransactions False False $ nulljournal {jtxns = [ txnTieKnot $ Transaction { @@ -1411,7 +1443,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 = [ @@ -1422,7 +1454,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 @@ -1433,7 +1465,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 @@ -1451,7 +1483,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 222f4e6c748..fb3d14f250b 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 cfe34a7015b..d579c89375c 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 78f67881ab1..2a0a1f336f7 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 1081ab4ee2c..3827c991330 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 e4dabca848e..c932b603607 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 b8bbb2e60b1..3ad8f5db3bb 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 0c89c413d71..7e95123198a 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -1465,6 +1465,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 @@ -1725,6 +1729,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: @@ -1977,6 +1983,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 4d6376ac8a8..9f15fa14675 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 9d86d4beeed..d5dc61c4ec2 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 18ced3ac315..ef70c06c46f 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 00000000000..fa167db774b --- /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 eff5c3be4ba..6b90e5c7e15 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