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.
This commit is contained in:
		
							parent
							
								
									b32b130045
								
							
						
					
					
						commit
						c966a0f413
					
				| @ -86,15 +86,6 @@ module Hledger.Data.Journal ( | |||||||
|   journalAddAccountTypes, |   journalAddAccountTypes, | ||||||
|   journalPostingsAddAccountTags, |   journalPostingsAddAccountTags, | ||||||
|   -- journalPrices, |   -- journalPrices, | ||||||
|   -- * Standard account types |  | ||||||
|   journalBalanceSheetAccountQuery, |  | ||||||
|   journalProfitAndLossAccountQuery, |  | ||||||
|   journalRevenueAccountQuery, |  | ||||||
|   journalExpenseAccountQuery, |  | ||||||
|   journalAssetAccountQuery, |  | ||||||
|   journalLiabilityAccountQuery, |  | ||||||
|   journalEquityAccountQuery, |  | ||||||
|   journalCashAccountQuery, |  | ||||||
|   journalConversionAccount, |   journalConversionAccount, | ||||||
|   -- * Misc |   -- * Misc | ||||||
|   canonicalStyleFrom, |   canonicalStyleFrom, | ||||||
| @ -474,111 +465,6 @@ letterPairs :: String -> [String] | |||||||
| letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) | letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) | ||||||
| letterPairs _ = [] | 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 <http://en.wikipedia.org/wiki/Chart_of_accounts#Balance_Sheet_Accounts>. |  | ||||||
| journalBalanceSheetAccountQuery :: Journal -> Query |  | ||||||
| journalBalanceSheetAccountQuery j = Or [journalAssetAccountQuery j |  | ||||||
|                                        ,journalLiabilityAccountQuery j |  | ||||||
|                                        ,journalEquityAccountQuery j |  | ||||||
|                                        ] |  | ||||||
| 
 |  | ||||||
| -- | A query for Profit & Loss accounts in this journal. |  | ||||||
| -- Cf <http://en.wikipedia.org/wiki/Chart_of_accounts#Profit_.26_Loss_accounts>. |  | ||||||
| journalProfitAndLossAccountQuery  :: Journal -> Query |  | ||||||
| journalProfitAndLossAccountQuery j = Or [journalRevenueAccountQuery j |  | ||||||
|                                         ,journalExpenseAccountQuery j |  | ||||||
|                                         ] |  | ||||||
| 
 |  | ||||||
| -- | The 'AccountName' to use for automatically generated conversion postings. | -- | The 'AccountName' to use for automatically generated conversion postings. | ||||||
| journalConversionAccount :: Journal -> AccountName | journalConversionAccount :: Journal -> AccountName | ||||||
| journalConversionAccount = | journalConversionAccount = | ||||||
| @ -1339,24 +1225,4 @@ tests_Journal = testGroup "Journal" [ | |||||||
|               ] |               ] | ||||||
|       } |       } | ||||||
|     @?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11)) |     @?= (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) |  | ||||||
|        ] |  | ||||||
|   ] |   ] | ||||||
|  | |||||||
| @ -165,15 +165,14 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr | |||||||
|             , cbcsubreportincreasestotal |             , cbcsubreportincreasestotal | ||||||
|             ) |             ) | ||||||
|           where |           where | ||||||
|  |             ropts = cbcsubreportoptions $ _rsReportOpts rspec | ||||||
|             -- Add a restriction to this subreport to the report query. |             -- Add a restriction to this subreport to the report query. | ||||||
|             -- XXX in non-thorough way, consider updateReportSpec ? |             -- XXX in non-thorough way, consider updateReportSpec ? | ||||||
|             q = cbcsubreportquery j |             rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [cbcsubreportquery, _rsQuery rspec]} | ||||||
|             ropts = cbcsubreportoptions $ _rsReportOpts rspec |  | ||||||
|             rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [q, _rsQuery rspec]} |  | ||||||
|             -- Starting balances and column postings specific to this subreport. |             -- Starting balances and column postings specific to this subreport. | ||||||
|             startbals' = startingBalances rspecsub j priceoracle $ |             startbals' = startingBalances rspecsub j priceoracle $ | ||||||
|               filter (matchesPostingExtra (journalAccountType j) q) startps |               filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery) startps | ||||||
|             colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) q)) colps |             colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery)) colps | ||||||
| 
 | 
 | ||||||
|     -- Sum the subreport totals by column. Handle these cases: |     -- Sum the subreport totals by column. Handle these cases: | ||||||
|     -- - no subreports |     -- - no subreports | ||||||
|  | |||||||
| @ -166,7 +166,7 @@ data CompoundPeriodicReport a b = CompoundPeriodicReport | |||||||
| -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib. | -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib. | ||||||
| data CBCSubreportSpec a = CBCSubreportSpec | data CBCSubreportSpec a = CBCSubreportSpec | ||||||
|   { cbcsubreporttitle          :: Text                      -- ^ The title to use for the subreport |   { 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 |   , 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 |   , 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 |   , cbcsubreportincreasestotal :: Bool                      -- ^ Whether the subreport and overall report total are of the same sign (e.g. Assets are normally | ||||||
|  | |||||||
| @ -24,14 +24,14 @@ balancesheetSpec = CompoundBalanceCommandSpec { | |||||||
|   cbcqueries  = [ |   cbcqueries  = [ | ||||||
|      CBCSubreportSpec{ |      CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Assets" |       cbcsubreporttitle="Assets" | ||||||
|      ,cbcsubreportquery=journalAssetAccountQuery |      ,cbcsubreportquery=Type [Asset] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) | ||||||
|      ,cbcsubreporttransform=id |      ,cbcsubreporttransform=id | ||||||
|      ,cbcsubreportincreasestotal=True |      ,cbcsubreportincreasestotal=True | ||||||
|      } |      } | ||||||
|     ,CBCSubreportSpec{ |     ,CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Liabilities" |       cbcsubreporttitle="Liabilities" | ||||||
|      ,cbcsubreportquery=journalLiabilityAccountQuery |      ,cbcsubreportquery=Type [Liability] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) | ||||||
|      ,cbcsubreporttransform=fmap maNegate |      ,cbcsubreporttransform=fmap maNegate | ||||||
|      ,cbcsubreportincreasestotal=False |      ,cbcsubreportincreasestotal=False | ||||||
|  | |||||||
| @ -25,21 +25,21 @@ balancesheetequitySpec = CompoundBalanceCommandSpec { | |||||||
|   cbcqueries  = [ |   cbcqueries  = [ | ||||||
|      CBCSubreportSpec{ |      CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Assets" |       cbcsubreporttitle="Assets" | ||||||
|      ,cbcsubreportquery=journalAssetAccountQuery |      ,cbcsubreportquery=Type [Asset] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) | ||||||
|      ,cbcsubreporttransform=id |      ,cbcsubreporttransform=id | ||||||
|      ,cbcsubreportincreasestotal=True |      ,cbcsubreportincreasestotal=True | ||||||
|      } |      } | ||||||
|     ,CBCSubreportSpec{ |     ,CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Liabilities" |       cbcsubreporttitle="Liabilities" | ||||||
|      ,cbcsubreportquery=journalLiabilityAccountQuery |      ,cbcsubreportquery=Type [Liability] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) | ||||||
|      ,cbcsubreporttransform=fmap maNegate |      ,cbcsubreporttransform=fmap maNegate | ||||||
|      ,cbcsubreportincreasestotal=False |      ,cbcsubreportincreasestotal=False | ||||||
|      } |      } | ||||||
|     ,CBCSubreportSpec{ |     ,CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Equity" |       cbcsubreporttitle="Equity" | ||||||
|      ,cbcsubreportquery=journalEquityAccountQuery |      ,cbcsubreportquery=Type [Equity] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) | ||||||
|      ,cbcsubreporttransform=fmap maNegate |      ,cbcsubreporttransform=fmap maNegate | ||||||
|      ,cbcsubreportincreasestotal=False |      ,cbcsubreportincreasestotal=False | ||||||
|  | |||||||
| @ -28,7 +28,7 @@ cashflowSpec = CompoundBalanceCommandSpec { | |||||||
|   cbcqueries  = [ |   cbcqueries  = [ | ||||||
|      CBCSubreportSpec{ |      CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Cash flows" |       cbcsubreporttitle="Cash flows" | ||||||
|      ,cbcsubreportquery=journalCashAccountQuery |      ,cbcsubreportquery=Type [Cash] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_= Just NormallyPositive}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_= Just NormallyPositive}) | ||||||
|      ,cbcsubreporttransform=id |      ,cbcsubreporttransform=id | ||||||
|      ,cbcsubreportincreasestotal=True |      ,cbcsubreportincreasestotal=True | ||||||
|  | |||||||
| @ -22,14 +22,14 @@ incomestatementSpec = CompoundBalanceCommandSpec { | |||||||
|   cbcqueries  = [ |   cbcqueries  = [ | ||||||
|      CBCSubreportSpec{ |      CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Revenues" |       cbcsubreporttitle="Revenues" | ||||||
|      ,cbcsubreportquery=journalRevenueAccountQuery |      ,cbcsubreportquery=Type [Revenue] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyNegative}) | ||||||
|      ,cbcsubreporttransform=fmap maNegate |      ,cbcsubreporttransform=fmap maNegate | ||||||
|      ,cbcsubreportincreasestotal=True |      ,cbcsubreportincreasestotal=True | ||||||
|      } |      } | ||||||
|     ,CBCSubreportSpec{ |     ,CBCSubreportSpec{ | ||||||
|       cbcsubreporttitle="Expenses" |       cbcsubreporttitle="Expenses" | ||||||
|      ,cbcsubreportquery=journalExpenseAccountQuery |      ,cbcsubreportquery=Type [Expense] | ||||||
|      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) |      ,cbcsubreportoptions=(\ropts -> ropts{normalbalance_=Just NormallyPositive}) | ||||||
|      ,cbcsubreporttransform=id |      ,cbcsubreporttransform=id | ||||||
|      ,cbcsubreportincreasestotal=False |      ,cbcsubreportincreasestotal=False | ||||||
| @ -59,4 +59,4 @@ incomestatement | |||||||
|       displaynames = displayedAccounts |       displaynames = displayedAccounts | ||||||
|       buildReportRows displaynames matrix |       buildReportRows displaynames matrix | ||||||
|  -} |  -} | ||||||
|   |   | ||||||
|  | |||||||
| @ -111,16 +111,26 @@ $ hledger -f- bal -N type:A | |||||||
|                    1  other |                    1  other | ||||||
|                    1  assets |                    1  assets | ||||||
| 
 | 
 | ||||||
| # # 6. bs detects both (#1858) | < | ||||||
| # $ hledger -f- bs -N | account a         ; type:L | ||||||
| # Balance Sheet 2022-01-02 | account a:aa      ; type:X | ||||||
| #  | account a:aa:aaa  ; type:L | ||||||
| #              || 2022-01-02  | 
 | ||||||
| # =============++============ | 2021-01-01 | ||||||
| #  Assets      ||             |     (a)                                            1 | ||||||
| # -------------++------------ |     (a:aa)                                         1 | ||||||
| #  other       ||          1  |     (a:aa:aaa)                                     1 | ||||||
| #  assets       ||         1  | 
 | ||||||
| # =============++============ | # 6. bs will detect proper accounts even with an intervening parent account (#1921) | ||||||
| #  Liabilities ||             | $ hledger -f- bs -N | ||||||
| # -------------++------------ | Balance Sheet 2021-01-01 | ||||||
|  | 
 | ||||||
|  |              || 2021-01-01  | ||||||
|  | =============++============ | ||||||
|  |  Assets      ||             | ||||||
|  | -------------++------------ | ||||||
|  | =============++============ | ||||||
|  |  Liabilities ||             | ||||||
|  | -------------++------------ | ||||||
|  |  a           ||         -1  | ||||||
|  |  a:aa:aaa    ||         -1  | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user