From c966a0f4132e81829cd8081d852c04b87d5c1cd7 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Sat, 20 Aug 2022 21:16:38 +1000 Subject: [PATCH] fix!: cbr: Remove old account type query code. (#1921) This replaces the old journal*AccountQuery with the new Type query. This enables uniform treatment of account type, and fixes a subtle bug (#1921). Note that cbcsubreportquery no longer takes Journal as an argument. --- hledger-lib/Hledger/Data/Journal.hs | 134 ------------------ .../Hledger/Reports/MultiBalanceReport.hs | 9 +- hledger-lib/Hledger/Reports/ReportTypes.hs | 2 +- hledger/Hledger/Cli/Commands/Balancesheet.hs | 4 +- .../Cli/Commands/Balancesheetequity.hs | 6 +- hledger/Hledger/Cli/Commands/Cashflow.hs | 2 +- .../Hledger/Cli/Commands/Incomestatement.hs | 6 +- hledger/test/journal/account-types.test | 36 +++-- 8 files changed, 37 insertions(+), 162 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index a77a071bf..bc37aee3c 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -86,15 +86,6 @@ module Hledger.Data.Journal ( journalAddAccountTypes, journalPostingsAddAccountTags, -- journalPrices, - -- * Standard account types - journalBalanceSheetAccountQuery, - journalProfitAndLossAccountQuery, - journalRevenueAccountQuery, - journalExpenseAccountQuery, - journalAssetAccountQuery, - journalLiabilityAccountQuery, - journalEquityAccountQuery, - journalCashAccountQuery, journalConversionAccount, -- * Misc canonicalStyleFrom, @@ -474,111 +465,6 @@ letterPairs :: String -> [String] letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) letterPairs _ = [] --- Older account type code - --- queries for standard account types - --- | Get a query for accounts of the specified types in this journal. --- Account types include: --- Asset, Liability, Equity, Revenue, Expense, Cash, Conversion. --- For each type, if no accounts were declared with this type, the query --- will instead match accounts with names matched by the case-insensitive --- regular expression provided as a fallback. --- The query will match all accounts which were declared as one of --- these types (by account directives with the type: tag), plus all their --- subaccounts which have not been declared as some other type. --- --- This is older code pre-dating 2022's expansion of account types. -journalAccountTypeQuery :: [AccountType] -> Regexp -> Journal -> Query -journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} = - let - declaredacctsoftype :: [AccountName] = - concat $ mapMaybe (`M.lookup` jdeclaredaccounttypes) atypes - in case declaredacctsoftype of - [] -> Acct fallbackregex - as -> And $ Or acctnameRegexes : if null differentlyTypedRegexes then [] else [ Not $ Or differentlyTypedRegexes ] - where - -- XXX Query isn't able to match account type since that requires extra info from the journal. - -- So we do a hacky search by name instead. - acctnameRegexes = map (Acct . accountNameToAccountRegex) as - differentlyTypedRegexes = map (Acct . accountNameToAccountRegex) differentlytypedsubs - - differentlytypedsubs = concat - [subs | (t,bs) <- M.toList jdeclaredaccounttypes - , t `notElem` atypes - , let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as] - ] - --- | A query for accounts in this journal which have been --- declared as Asset (or Cash, a subtype of Asset) by account directives, --- or otherwise for accounts with names matched by the case-insensitive --- regular expression @^assets?(:|$)@. -journalAssetAccountQuery :: Journal -> Query -journalAssetAccountQuery j = - Or [ - journalAccountTypeQuery [Asset] assetAccountRegex j - ,journalCashAccountOnlyQuery j - ] - --- | A query for Cash (liquid asset) accounts in this journal, ie accounts --- declared as Cash by account directives, or otherwise accounts whose --- names match the case-insensitive regular expression --- @(^assets:(.+:)?(cash|bank)(:|$)@. -journalCashAccountQuery :: Journal -> Query -journalCashAccountQuery = journalAccountTypeQuery [Cash] cashAccountRegex - --- | A query for accounts in this journal specifically declared as Cash by --- account directives, or otherwise the None query. -journalCashAccountOnlyQuery :: Journal -> Query -journalCashAccountOnlyQuery j - -- Cash accounts are declared; get a query for them (the fallback regex won't be used) - | Cash `M.member` jdeclaredaccounttypes j = journalAccountTypeQuery [Cash] notused j - | otherwise = None - where notused = error' "journalCashAccountOnlyQuery: this should not have happened!" -- PARTIAL: - --- | A query for accounts in this journal which have been --- declared as Liability by account directives, or otherwise for --- accounts with names matched by the case-insensitive regular expression --- @^(debts?|liabilit(y|ies))(:|$)@. -journalLiabilityAccountQuery :: Journal -> Query -journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] liabilityAccountRegex - --- | A query for accounts in this journal which have been --- declared as Equity by account directives, or otherwise for --- accounts with names matched by the case-insensitive regular expression --- @^equity(:|$)@. -journalEquityAccountQuery :: Journal -> Query -journalEquityAccountQuery = journalAccountTypeQuery [Equity] equityAccountRegex - --- | A query for accounts in this journal which have been --- declared as Revenue by account directives, or otherwise for --- accounts with names matched by the case-insensitive regular expression --- @^(income|revenue)s?(:|$)@. -journalRevenueAccountQuery :: Journal -> Query -journalRevenueAccountQuery = journalAccountTypeQuery [Revenue] revenueAccountRegex - --- | A query for accounts in this journal which have been --- declared as Expense by account directives, or otherwise for --- accounts with names matched by the case-insensitive regular expression --- @^expenses?(:|$)@. -journalExpenseAccountQuery :: Journal -> Query -journalExpenseAccountQuery = journalAccountTypeQuery [Expense] expenseAccountRegex - --- | A query for Asset, Liability & Equity accounts in this journal. --- Cf . -journalBalanceSheetAccountQuery :: Journal -> Query -journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j - ,journalLiabilityAccountQuery j - ,journalEquityAccountQuery j - ] - --- | A query for Profit & Loss accounts in this journal. --- Cf . -journalProfitAndLossAccountQuery :: Journal -> Query -journalProfitAndLossAccountQuery j = Or [journalRevenueAccountQuery j - ,journalExpenseAccountQuery j - ] - -- | The 'AccountName' to use for automatically generated conversion postings. journalConversionAccount :: Journal -> AccountName journalConversionAccount = @@ -1339,24 +1225,4 @@ tests_Journal = testGroup "Journal" [ ] } @?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11)) - - ,testGroup "standard account type queries" $ - let - j = samplejournal - journalAccountNamesMatching :: Query -> Journal -> [AccountName] - journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames - namesfrom qfunc = journalAccountNamesMatching (qfunc j) j - in [testCase "assets" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] - (namesfrom journalAssetAccountQuery) - ,testCase "cash" $ assertEqual "" ["assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] - (namesfrom journalCashAccountQuery) - ,testCase "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"] - (namesfrom journalLiabilityAccountQuery) - ,testCase "equity" $ assertEqual "" [] - (namesfrom journalEquityAccountQuery) - ,testCase "income" $ assertEqual "" ["income","income:gifts","income:salary"] - (namesfrom journalRevenueAccountQuery) - ,testCase "expenses" $ assertEqual "" ["expenses","expenses:food","expenses:supplies"] - (namesfrom journalExpenseAccountQuery) - ] ] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 3b61a368c..0a3a3795d 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -165,15 +165,14 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr , cbcsubreportincreasestotal ) where + ropts = cbcsubreportoptions $ _rsReportOpts rspec -- Add a restriction to this subreport to the report query. -- XXX in non-thorough way, consider updateReportSpec ? - q = cbcsubreportquery j - ropts = cbcsubreportoptions $ _rsReportOpts rspec - rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [q, _rsQuery rspec]} + rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [cbcsubreportquery, _rsQuery rspec]} -- Starting balances and column postings specific to this subreport. startbals' = startingBalances rspecsub j priceoracle $ - filter (matchesPostingExtra (journalAccountType j) q) startps - colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) q)) colps + filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery) startps + colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery)) colps -- Sum the subreport totals by column. Handle these cases: -- - no subreports diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 6304ea154..f967ac13f 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -166,7 +166,7 @@ data CompoundPeriodicReport a b = CompoundPeriodicReport -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib. data CBCSubreportSpec a = CBCSubreportSpec { cbcsubreporttitle :: Text -- ^ The title to use for the subreport - , cbcsubreportquery :: Journal -> Query -- ^ The Query to use for the subreport + , cbcsubreportquery :: Query -- ^ The Query to use for the subreport , cbcsubreportoptions :: ReportOpts -> ReportOpts -- ^ A function to transform the ReportOpts used to produce the subreport , cbcsubreporttransform :: PeriodicReport DisplayName MixedAmount -> PeriodicReport a MixedAmount -- ^ A function to transform the result of the subreport , cbcsubreportincreasestotal :: Bool -- ^ Whether the subreport and overall report total are of the same sign (e.g. Assets are normally diff --git a/hledger/Hledger/Cli/Commands/Balancesheet.hs b/hledger/Hledger/Cli/Commands/Balancesheet.hs index bdac263a8..c2bca0068 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheet.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheet.hs @@ -24,14 +24,14 @@ balancesheetSpec = CompoundBalanceCommandSpec { cbcqueries = [ CBCSubreportSpec{ cbcsubreporttitle="Assets" - ,cbcsubreportquery=journalAssetAccountQuery + ,cbcsubreportquery=Type [Asset] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=True } ,CBCSubreportSpec{ cbcsubreporttitle="Liabilities" - ,cbcsubreportquery=journalLiabilityAccountQuery + ,cbcsubreportquery=Type [Liability] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) ,cbcsubreporttransform=fmap maNegate ,cbcsubreportincreasestotal=False diff --git a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs index c115f2b89..00a664307 100644 --- a/hledger/Hledger/Cli/Commands/Balancesheetequity.hs +++ b/hledger/Hledger/Cli/Commands/Balancesheetequity.hs @@ -25,21 +25,21 @@ balancesheetequitySpec = CompoundBalanceCommandSpec { cbcqueries = [ CBCSubreportSpec{ cbcsubreporttitle="Assets" - ,cbcsubreportquery=journalAssetAccountQuery + ,cbcsubreportquery=Type [Asset] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=True } ,CBCSubreportSpec{ cbcsubreporttitle="Liabilities" - ,cbcsubreportquery=journalLiabilityAccountQuery + ,cbcsubreportquery=Type [Liability] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) ,cbcsubreporttransform=fmap maNegate ,cbcsubreportincreasestotal=False } ,CBCSubreportSpec{ cbcsubreporttitle="Equity" - ,cbcsubreportquery=journalEquityAccountQuery + ,cbcsubreportquery=Type [Equity] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) ,cbcsubreporttransform=fmap maNegate ,cbcsubreportincreasestotal=False diff --git a/hledger/Hledger/Cli/Commands/Cashflow.hs b/hledger/Hledger/Cli/Commands/Cashflow.hs index 68e205dd0..7f9630f1e 100644 --- a/hledger/Hledger/Cli/Commands/Cashflow.hs +++ b/hledger/Hledger/Cli/Commands/Cashflow.hs @@ -28,7 +28,7 @@ cashflowSpec = CompoundBalanceCommandSpec { cbcqueries = [ CBCSubreportSpec{ cbcsubreporttitle="Cash flows" - ,cbcsubreportquery=journalCashAccountQuery + ,cbcsubreportquery=Type [Cash] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_= Just NormallyPositive}) ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=True diff --git a/hledger/Hledger/Cli/Commands/Incomestatement.hs b/hledger/Hledger/Cli/Commands/Incomestatement.hs index 5aec7feed..2ead7db4b 100644 --- a/hledger/Hledger/Cli/Commands/Incomestatement.hs +++ b/hledger/Hledger/Cli/Commands/Incomestatement.hs @@ -22,14 +22,14 @@ incomestatementSpec = CompoundBalanceCommandSpec { cbcqueries = [ CBCSubreportSpec{ cbcsubreporttitle="Revenues" - ,cbcsubreportquery=journalRevenueAccountQuery + ,cbcsubreportquery=Type [Revenue] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) ,cbcsubreporttransform=fmap maNegate ,cbcsubreportincreasestotal=True } ,CBCSubreportSpec{ cbcsubreporttitle="Expenses" - ,cbcsubreportquery=journalExpenseAccountQuery + ,cbcsubreportquery=Type [Expense] ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) ,cbcsubreporttransform=id ,cbcsubreportincreasestotal=False @@ -59,4 +59,4 @@ incomestatement displaynames = displayedAccounts buildReportRows displaynames matrix -} - \ No newline at end of file + diff --git a/hledger/test/journal/account-types.test b/hledger/test/journal/account-types.test index 773be1d18..9b60b76c0 100644 --- a/hledger/test/journal/account-types.test +++ b/hledger/test/journal/account-types.test @@ -111,16 +111,26 @@ $ hledger -f- bal -N type:A 1 other 1 assets -# # 6. bs detects both (#1858) -# $ hledger -f- bs -N -# Balance Sheet 2022-01-02 -# -# || 2022-01-02 -# =============++============ -# Assets || -# -------------++------------ -# other || 1 -# assets || 1 -# =============++============ -# Liabilities || -# -------------++------------ +< +account a ; type:L +account a:aa ; type:X +account a:aa:aaa ; type:L + +2021-01-01 + (a) 1 + (a:aa) 1 + (a:aa:aaa) 1 + +# 6. bs will detect proper accounts even with an intervening parent account (#1921) +$ hledger -f- bs -N +Balance Sheet 2021-01-01 + + || 2021-01-01 +=============++============ + Assets || +-------------++------------ +=============++============ + Liabilities || +-------------++------------ + a || -1 + a:aa:aaa || -1