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.
2022-08-20 21:16:38 +10:00 · 2022-08-20 21:16:38 +10:00 · c966a0f413
commit c966a0f413
parent b32b130045
8 changed files with 37 additions and 162 deletions
--- 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 <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.
 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)
-       ]
  ]
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
 -}
- 
+ 
--- 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