From e17ef86388a84a5ee345947d4dd648bd1687aeaf Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 5 Feb 2021 16:01:27 -0800 Subject: [PATCH] lib: use a transaction's amount precisions when balancing it Surprising developments in old behaviour, as a consequence of #931: now that print shows amounts with all of their decimal places, we had better balance transactions using all of those visible digits (so that hledger and a user will agree on whether it's balanced). So now when transaction balancing compares amounts to see if they look equal, it uses (for each commodity) the maximum precision seen in just that transaction's amounts - not the precision from the journal's commodity display styles. This makes it more localised, which is a nice simplification. In journalFinalise, applying commodity display styles to the journal's amounts is now done as a final step (after transaction balancing, not before), and only once (rather than twice when auto postings are enabled), and seems slightly more thorough (affecting some inferred amounts where it didn't before). Inferred unit transaction prices (which arise in a two-commodity transaction with 3+ postings, and can be seen with print -x) may now be generated with a different number of decimal places than before. Specifically, it will be the sum of the the number of decimal places in the amounts being converted to and from. (Whereas before, it was.. some other, perhaps larger number.) Hopefully this will always be a suitable number of digits such that hledger's & users' calculation of balancedness will agree. Lib changes: Hledger.Data.Journal added: journalInferCommodityStyles journalInferAndApplyCommodityStyles removed: canonicalStyleFrom --- hledger-lib/Hledger/Data/Journal.hs | 105 +++++++++++++++--------- hledger-lib/Hledger/Data/Transaction.hs | 93 +++++++++++---------- hledger-lib/Hledger/Read/Common.hs | 64 ++++++++------- hledger/Hledger/Cli/Commands/Add.hs | 4 +- hledger/Hledger/Cli/Utils.hs | 2 +- hledger/test/balance/budget.test | 57 +++++++------ hledger/test/close.test | 24 +++--- 7 files changed, 192 insertions(+), 157 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 6de4faf36888..dae3338585bb 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)) @@ -662,8 +662,7 @@ type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s)) -- | The state used while balancing a sequence of transactions. data BalancingState s = BalancingState { -- read only - bsStyles :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles - ,bsUnassignable :: S.Set AccountName -- ^ accounts in which balance assignments may not be used + bsUnassignable :: S.Set AccountName -- ^ accounts in which balance assignments may not be used ,bsAssrt :: Bool -- ^ whether to check balance assertions -- mutable ,bsBalances :: H.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty @@ -722,18 +721,18 @@ updateTransactionB t = withRunningBalance $ \BalancingState{bsTransactions} -> -- and (optional) all balance assertions pass. Or return an error message -- (just the first error encountered). -- --- Assumes journalInferCommodityStyles has been called, since those --- affect transaction balancing. +-- Assumes the journal amounts' display styles still have the original number +-- of decimal places that was parsed (ie, display styles have not yet been normalised), +-- since this affects transaction balancing. -- -- This does multiple things at once because amount inferring, balance -- assignments, balance assertions and posting dates are interdependent. +-- journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions assrt j' = let -- ensure transactions are numbered, so we can store them by number j@Journal{jtxns=ts} = journalNumberTransactions j' - -- display precisions used in balanced checking - styles = Just $ journalCommodityStyles j -- balance assignments will not be allowed on these txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j in @@ -750,7 +749,7 @@ journalBalanceTransactions assrt j' = -- and leaving the others for later. The balanced ones are split into their postings. -- The postings and not-yet-balanced transactions remain in the same relative order. psandts :: [Either Posting Transaction] <- fmap concat $ forM ts $ \case - t | null $ assignmentPostings t -> case balanceTransaction styles t of + t | null $ assignmentPostings t -> case balanceTransaction t of Left e -> throwError e Right t' -> do lift $ writeArray balancedtxns (tindex t') t' @@ -760,7 +759,7 @@ journalBalanceTransactions assrt j' = -- 2. Sort these items by date, preserving the order of same-day items, -- and step through them while keeping running account balances, runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j) - flip runReaderT (BalancingState styles txnmodifieraccts assrt runningbals balancedtxns) $ do + flip runReaderT (BalancingState txnmodifieraccts assrt runningbals balancedtxns) $ do -- performing balance assignments in, and balancing, the remaining transactions, -- and checking balance assertions as each posting is processed. void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts @@ -788,8 +787,7 @@ balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do -- update the account's running balance and check the balance assertion if any ps' <- forM ps $ \p -> pure (removePrices p) >>= addOrAssignAmountAndCheckAssertionB -- infer any remaining missing amounts, and make sure the transaction is now fully balanced - styles <- R.reader bsStyles - case balanceTransactionHelper styles t{tpostings=ps'} of + case balanceTransactionHelper t{tpostings=ps'} of Left err -> throwError err Right (t', inferredacctsandamts) -> do -- for each amount just inferred, update the running balance @@ -965,25 +963,66 @@ checkBalanceAssignmentUnassignableAccountB p = do -- +-- | Get an ordered list of amounts in this journal which can +-- influence canonical amount display styles. Those are, in +-- the following order: +-- +-- * amounts in market price (P) directives (in parse order) +-- * posting amounts in transactions (in parse order) +-- * the amount in the final default commodity (D) directive +-- +-- Transaction price amounts (posting amounts' aprice field) are not included. +-- +journalStyleInfluencingAmounts :: Journal -> [Amount] +journalStyleInfluencingAmounts j = + dbg7 "journalStyleInfluencingAmounts" $ + catMaybes $ concat [ + [mdefaultcommodityamt] + ,map (Just . pdamount) $ jpricedirectives j + ,map Just $ concatMap amounts $ map pamount $ journalPostings j + ] + where + -- D's amount style isn't actually stored as an amount, make it into one + mdefaultcommodityamt = + case jparsedefaultcommodity j of + Just (symbol,style) -> Just nullamt{acommodity=symbol,astyle=style} + Nothing -> Nothing + +-- | Infer commodity display styles for each commodity (see commodityStylesFromAmounts) +-- based on the amounts in this journal (see journalStyleInfluencingAmounts), +-- and save those inferred styles in the journal. +-- Can return an error message eg if inconsistent number formats are found. +journalInferCommodityStyles :: Journal -> Either String Journal +journalInferCommodityStyles j = + case commodityStylesFromAmounts $ journalStyleInfluencingAmounts j of + Left e -> Left e + Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs} + +-- | Apply the given commodity display styles to the posting amounts in this journal. +journalApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Journal -> Journal +journalApplyCommodityStyles styles j@Journal{jtxns=ts, jpricedirectives=pds} = + j {jtxns=map fixtransaction ts + ,jpricedirectives=map fixpricedirective pds + } + where + fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} + fixposting p = p{pamount=styleMixedAmount styles $ pamount p + ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p} + -- balance assertion/assignment amounts, and price amounts, are always displayed + -- (eg by print) at full precision + fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba} + fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a} + -- | Choose and apply a consistent display style to the posting -- amounts in each commodity (see journalCommodityStyles). -- Can return an error message eg if inconsistent number formats are found. -journalApplyCommodityStyles :: Journal -> Either String Journal -journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = +journalInferAndApplyCommodityStyles :: Journal -> Either String Journal +journalInferAndApplyCommodityStyles j = case journalInferCommodityStyles j of Left e -> Left e - Right j' -> Right j'' + Right j' -> Right $ journalApplyCommodityStyles allstyles j' where - styles = journalCommodityStyles j' - j'' = j'{jtxns=map fixtransaction ts - ,jpricedirectives=map fixpricedirective pds - } - fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps} - fixposting p = p{pamount=styleMixedAmount styles $ pamount p - ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p} - -- balance assertion amounts are always displayed (by print) at full precision, per docs - fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba} - fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a} + allstyles = journalCommodityStyles j' -- | Get the canonical amount styles for this journal, whether (in order of precedence): -- set globally in InputOpts, @@ -1002,18 +1041,6 @@ journalCommodityStyles j = defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j] inferredstyles = jinferredcommodities j --- | Collect and save inferred amount styles for each commodity based on --- the posting amounts in that commodity (excluding price amounts), ie: --- "the format of the first amount, adjusted to the highest precision of all amounts". --- Can return an error message eg if inconsistent number formats are found. -journalInferCommodityStyles :: Journal -> Either String Journal -journalInferCommodityStyles j = - case - commodityStylesFromAmounts $ journalStyleInfluencingAmounts j - of - Left e -> Left e - Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs} - -- -- | Apply this journal's historical price records to unpriced amounts where possible. -- journalApplyPriceDirectives :: Journal -> Journal -- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 222f4e6c7488..da9010e1ca97 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -360,13 +360,20 @@ transactionsPostings = concatMap tpostings -- 3. Does the amounts' sum appear non-zero when displayed ? -- (using the given display styles if provided) -- -transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> [String] -transactionCheckBalanced mstyles t = errs +transactionCheckBalanced :: Transaction -> [String] +transactionCheckBalanced t = errs where (rps, bvps) = (realPostings t, balancedVirtualPostings t) + -- Infer per-commodity display styles from just this transaction's amounts. + -- This will include their maximum number of decimal places used. + -- We'll test each commodity's balance to this number of decimal places. + mbalancingstyles = + 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 + canonicalise = maybe id canonicaliseMixedAmount mbalancingstyles + -- 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,16 +392,16 @@ 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. -isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool -isTransactionBalanced mstyles = null . transactionCheckBalanced mstyles +isTransactionBalanced :: Transaction -> Bool +isTransactionBalanced = null . transactionCheckBalanced -- | Balance this transaction, ensuring that its postings -- (and its balanced virtual postings) sum to 0, @@ -409,23 +416,16 @@ isTransactionBalanced mstyles = null . transactionCheckBalanced mstyles -- The "sum to 0" test is done using commodity display precisions, -- if provided, so that the result agrees with the numbers users can see. -- -balanceTransaction :: - Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles - -> Transaction - -> Either String Transaction -balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles +balanceTransaction :: Transaction -> Either String Transaction +balanceTransaction = fmap fst . balanceTransactionHelper -- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; -- use one of those instead. It also returns a list of accounts -- and amounts that were inferred. -balanceTransactionHelper :: - Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles - -> Transaction - -> Either String (Transaction, [(AccountName, MixedAmount)]) -balanceTransactionHelper mstyles t = do - (t', inferredamtsandaccts) <- - inferBalancingAmount (fromMaybe M.empty mstyles) $ inferBalancingPrices t - case transactionCheckBalanced mstyles t' of +balanceTransactionHelper :: Transaction -> Either String (Transaction, [(AccountName, MixedAmount)]) +balanceTransactionHelper t = do + (t', inferredamtsandaccts) <- inferBalancingAmount $ inferBalancingPrices t + case transactionCheckBalanced t' of [] -> Right (txnTieKnot t', inferredamtsandaccts) errs -> Left $ transactionBalanceError t' errs @@ -450,11 +450,8 @@ annotateErrorWithTransaction t s = -- We can infer a missing amount when there are multiple postings and exactly -- one of them is amountless. If the amounts had price(s) the inferred amount -- have the same price(s), and will be converted to the price commodity. -inferBalancingAmount :: - M.Map CommoditySymbol AmountStyle -- ^ commodity display styles - -> Transaction - -> Either String (Transaction, [(AccountName, MixedAmount)]) -inferBalancingAmount styles t@Transaction{tpostings=ps} +inferBalancingAmount :: Transaction -> Either String (Transaction, [(AccountName, MixedAmount)]) +inferBalancingAmount t@Transaction{tpostings=ps} | length amountlessrealps > 1 = Left $ transactionBalanceError t ["can't have more than one real posting with no amount" @@ -486,9 +483,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 +549,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,7 +563,17 @@ 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. + -- Currently, we use the sum of the display precisions of + -- the amounts being converted from and to (capped at the + -- maximum precision). This is a holdover from before + -- #931, but hopefully still gives reasonable results. unitprecision = case (fromprecision, toprecision) of (Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b) _ -> NaturalPrecision @@ -700,10 +709,10 @@ tests_Transaction = ] , test "inferBalancingAmount" $ do - (fst <$> inferBalancingAmount M.empty nulltransaction) @?= Right nulltransaction - (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?= + (fst <$> inferBalancingAmount nulltransaction) @?= Right nulltransaction + (fst <$> inferBalancingAmount nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]} - (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?= + (fst <$> inferBalancingAmount nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]} , tests "showTransaction" [ @@ -822,7 +831,6 @@ tests_Transaction = test "detect unbalanced entry, sign error" $ assertLeft (balanceTransaction - Nothing (Transaction 0 "" @@ -838,7 +846,6 @@ tests_Transaction = ,test "detect unbalanced entry, multiple missing amounts" $ assertLeft $ balanceTransaction - Nothing (Transaction 0 "" @@ -856,7 +863,6 @@ tests_Transaction = ,test "one missing amount is inferred" $ (pamount . last . tpostings <$> balanceTransaction - Nothing (Transaction 0 "" @@ -873,7 +879,6 @@ tests_Transaction = ,test "conversion price is inferred" $ (pamount . head . tpostings <$> balanceTransaction - Nothing (Transaction 0 "" @@ -892,7 +897,6 @@ tests_Transaction = ,test "balanceTransaction balances based on cost if there are unit prices" $ assertRight $ balanceTransaction - Nothing (Transaction 0 "" @@ -910,7 +914,6 @@ tests_Transaction = ,test "balanceTransaction balances based on cost if there are total prices" $ assertRight $ balanceTransaction - Nothing (Transaction 0 "" @@ -929,7 +932,7 @@ tests_Transaction = , tests "isTransactionBalanced" [ test "detect balanced" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced $ Transaction 0 "" @@ -947,7 +950,7 @@ tests_Transaction = ,test "detect unbalanced" $ assertBool "" $ not $ - isTransactionBalanced Nothing $ + isTransactionBalanced $ Transaction 0 "" @@ -965,7 +968,7 @@ tests_Transaction = ,test "detect unbalanced, one posting" $ assertBool "" $ not $ - isTransactionBalanced Nothing $ + isTransactionBalanced $ Transaction 0 "" @@ -980,7 +983,7 @@ tests_Transaction = [posting {paccount = "b", pamount = Mixed [usd 1.00]}] ,test "one zero posting is considered balanced for now" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced $ Transaction 0 "" @@ -995,7 +998,7 @@ tests_Transaction = [posting {paccount = "b", pamount = Mixed [usd 0]}] ,test "virtual postings don't need to balance" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced $ Transaction 0 "" @@ -1014,7 +1017,7 @@ tests_Transaction = ,test "balanced virtual postings need to balance among themselves" $ assertBool "" $ not $ - isTransactionBalanced Nothing $ + isTransactionBalanced $ Transaction 0 "" @@ -1032,7 +1035,7 @@ tests_Transaction = ] ,test "balanced virtual postings need to balance among themselves (2)" $ assertBool "" $ - isTransactionBalanced Nothing $ + isTransactionBalanced $ Transaction 0 "" diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index cfe34a7015bb..b2f84776f8b2 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -342,35 +342,41 @@ 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'' + -- 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 (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 check balance assertions. + journalBalanceTransactions (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/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index df6f65dc321d..5930bd96d083 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -204,7 +204,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) ,tcomment=txnCmnt ,tpostings=esPostings } - case balanceTransaction Nothing t of -- imprecise balancing (?) + case balanceTransaction t of Right t' -> confirmedTransactionWizard prevInput es (EndStage t' : stack) Left err -> do @@ -302,7 +302,7 @@ descriptionAndCommentWizard PrevInput{..} EntryState{..} = do return $ Just (desc, comment) postingsBalanced :: [Posting] -> Bool -postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpostings=ps} +postingsBalanced ps = isRight $ balanceTransaction nulltransaction{tpostings=ps} accountWizard PrevInput{..} EntryState{..} = do let pnum = length esPostings + 1 diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index b8bbb2e60b1b..0e76684735d7 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 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..e88aef811f3d 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.3528243 = $0.00 + equity:opening/closing balances $49.50 + equity:opening/closing balances $-49.390001 @ AAA 10.3528243 + 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.3528243 = $0.109999 + equity:opening/closing balances $-49.50 + equity:opening/closing balances $49.390001 @ AAA 10.3528243 + equity:opening/closing balances AAA -510.00000000 >=0