From 45127dc5f508bf3b6f59da6dd63ba68c2430720f Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 30 Jan 2022 02:45:19 -1000 Subject: [PATCH] feat: new type: query for easy matching by account type type:TYPES, where TYPES is any of the (case insensitive) letters ALERXCV, matches accounts by their declared or inferred type. (See https://hledger.org/hledger.html#account-types.) This should work with most commands, eg: hledger bal type:al hledger reg type:x API changes: Journal has a new jaccounttypes map. The journalAccountType lookup function makes it easy to check an account's type. The journalTags and journalInheritedTags functions look up an account's tags. Functions like journalFilterPostings and journalFilterTransactions, and new matching functions matchesAccountExtra, matchesPostingExtra and matchesTransactionExtra, use these to allow more powerful matching that is aware of account types and tags. --- hledger-lib/Hledger/Data/AccountName.hs | 28 +++ hledger-lib/Hledger/Data/Journal.hs | 46 +++-- hledger-lib/Hledger/Data/Types.hs | 3 +- hledger-lib/Hledger/Query.hs | 161 ++++++++++++------ hledger-lib/Hledger/Read/Common.hs | 33 +++- .../Hledger/Reports/MultiBalanceReport.hs | 12 +- hledger/Hledger/Cli/Commands/Accounts.hs | 3 +- hledger/hledger.m4.md | 12 +- 8 files changed, 226 insertions(+), 72 deletions(-) diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index 1ccfbf6aa..0cdc5115b 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -20,6 +20,13 @@ module Hledger.Data.AccountName ( ,accountNameToAccountRegexCI ,accountNameTreeFrom ,accountSummarisedName + ,accountNameInferType + ,assetAccountRegex + ,cashAccountRegex + ,liabilityAccountRegex + ,equityAccountRegex + ,revenueAccountRegex + ,expenseAccountRegex ,acctsep ,acctsepchar ,clipAccountName @@ -82,6 +89,27 @@ accountSummarisedName a cs = accountNameComponents a a' = accountLeafName a +-- | Regular expressions matching common english top-level account names, +-- used as a fallback when account types are not declared. +assetAccountRegex = toRegexCI' "^assets?(:|$)" +cashAccountRegex = toRegexCI' "(investment|receivable|:A/R|:fixed)" +liabilityAccountRegex = toRegexCI' "^(debts?|liabilit(y|ies))(:|$)" +equityAccountRegex = toRegexCI' "^equity(:|$)" +revenueAccountRegex = toRegexCI' "^(income|revenue)s?(:|$)" +expenseAccountRegex = toRegexCI' "^expenses?(:|$)" + +-- | Try to guess an account's type from its name, +-- matching common english top-level account names. +accountNameInferType :: AccountName -> Maybe AccountType +accountNameInferType a + | regexMatchText cashAccountRegex a = Just Cash + | regexMatchText assetAccountRegex a = Just Asset + | regexMatchText liabilityAccountRegex a = Just Liability + | regexMatchText equityAccountRegex a = Just Equity + | regexMatchText revenueAccountRegex a = Just Revenue + | regexMatchText expenseAccountRegex a = Just Expense + | otherwise = Nothing + accountNameLevel :: AccountName -> Int accountNameLevel "" = 0 accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1 diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 76bb7ff4f..0e6938214 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -47,7 +47,10 @@ module Hledger.Data.Journal ( journalAccountNamesDeclared, journalAccountNamesDeclaredOrUsed, journalAccountNamesDeclaredOrImplied, + journalLeafAccountNamesDeclared, journalAccountNames, + journalLeafAccountNames, + journalAccountNameTree, journalAccountTags, journalInheritedAccountTags, -- journalAmountAndPriceCommodities, @@ -73,6 +76,7 @@ module Hledger.Data.Journal ( journalPrevTransaction, journalPostings, journalTransactionsSimilarTo, + journalAccountType, -- journalPrices, -- * Standard account types journalBalanceSheetAccountQuery, @@ -96,7 +100,8 @@ module Hledger.Data.Journal ( samplejournal, samplejournalMaybeExplicit, tests_Journal -,journalLeafAccountNamesDeclared) + -- +) where import Control.Applicative ((<|>)) @@ -200,6 +205,7 @@ instance Semigroup Journal where ,jdeclaredaccounts = jdeclaredaccounts j1 <> jdeclaredaccounts j2 ,jdeclaredaccounttags = jdeclaredaccounttags j1 <> jdeclaredaccounttags j2 ,jdeclaredaccounttypes = jdeclaredaccounttypes j1 <> jdeclaredaccounttypes j2 + ,jaccounttypes = jaccounttypes j1 <> jaccounttypes j2 ,jglobalcommoditystyles = jglobalcommoditystyles j1 <> jglobalcommoditystyles j2 ,jcommodities = jcommodities j1 <> jcommodities j2 ,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2 @@ -230,6 +236,7 @@ nulljournal = Journal { ,jdeclaredaccounts = [] ,jdeclaredaccounttags = M.empty ,jdeclaredaccounttypes = M.empty + ,jaccounttypes = M.empty ,jglobalcommoditystyles = M.empty ,jcommodities = M.empty ,jinferredcommodities = M.empty @@ -341,10 +348,15 @@ journalAccountNamesDeclaredOrImplied j = toList $ foldMap S.fromList journalAccountNames :: Journal -> [AccountName] journalAccountNames = journalAccountNamesDeclaredOrImplied +-- | Sorted unique account names declared or implied in this journal +-- which have no children. +journalLeafAccountNames :: Journal -> [AccountName] +journalLeafAccountNames = treeLeaves . journalAccountNameTree + journalAccountNameTree :: Journal -> Tree AccountName journalAccountNameTree = accountNameTreeFrom . journalAccountNamesDeclaredOrImplied --- | Which tags have been declared for this account, if any ? +-- | Which tags have been declared explicitly for this account, if any ? journalAccountTags :: Journal -> AccountName -> [Tag] journalAccountTags Journal{jdeclaredaccounttags} a = M.findWithDefault [] a jdeclaredaccounttags @@ -422,6 +434,8 @@ letterPairs _ = [] -- 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 @@ -449,7 +463,7 @@ journalAccountTypeQuery atypes fallbackregex Journal{jdeclaredaccounttypes} = journalAssetAccountQuery :: Journal -> Query journalAssetAccountQuery j = Or [ - journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)") j + journalAccountTypeQuery [Asset] assetAccountRegex j ,journalCashAccountOnlyQuery j ] @@ -458,7 +472,7 @@ journalAssetAccountQuery j = -- or otherwise for accounts with names matched by the case-insensitive -- regular expression @^assets?(:|$)@. journalAssetNonCashAccountQuery :: Journal -> Query -journalAssetNonCashAccountQuery = journalAccountTypeQuery [Asset] (toRegexCI' "^assets?(:|$)") +journalAssetNonCashAccountQuery = journalAccountTypeQuery [Asset] assetAccountRegex -- | A query for Cash (liquid asset) accounts in this journal, ie accounts -- declared as Cash by account directives, or otherwise Asset accounts whose @@ -470,7 +484,7 @@ journalCashAccountQuery j = Just _ -> journalCashAccountOnlyQuery j Nothing -> -- no Cash accounts are declared; query for Asset accounts and exclude some of them - And [ journalAssetNonCashAccountQuery j, Not . Acct $ toRegexCI' "(investment|receivable|:A/R|:fixed)" ] + And [ journalAssetNonCashAccountQuery j, Not $ Acct cashAccountRegex ] -- | A query for accounts in this journal specifically declared as Cash by -- account directives, or otherwise the None query. @@ -488,28 +502,28 @@ journalCashAccountOnlyQuery j = -- accounts with names matched by the case-insensitive regular expression -- @^(debts?|liabilit(y|ies))(:|$)@. journalLiabilityAccountQuery :: Journal -> Query -journalLiabilityAccountQuery = journalAccountTypeQuery [Liability] (toRegexCI' "^(debts?|liabilit(y|ies))(:|$)") +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] (toRegexCI' "^equity(:|$)") +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] (toRegexCI' "^(income|revenue)s?(:|$)") +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] (toRegexCI' "^expenses?(:|$)") +journalExpenseAccountQuery = journalAccountTypeQuery [Expense] expenseAccountRegex -- | A query for Asset, Liability & Equity accounts in this journal. -- Cf . @@ -533,6 +547,11 @@ journalConversionAccount = . M.findWithDefault [] Conversion . jdeclaredaccounttypes +-- Newer account type functionality. + +journalAccountType :: Journal -> AccountName -> Maybe AccountType +journalAccountType Journal{jaccounttypes} a = M.lookup a jaccounttypes + -- Various kinds of filtering on journals. We do it differently depending -- on the command. @@ -541,12 +560,12 @@ journalConversionAccount = -- | Keep only transactions matching the query expression. filterJournalTransactions :: Query -> Journal -> Journal -filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts} +filterJournalTransactions q j@Journal{jaccounttypes, jtxns} = j{jtxns=filter (matchesTransactionExtra q (Just jaccounttypes)) jtxns} -- | Keep only postings matching the query expression. -- This can leave unbalanced transactions. filterJournalPostings :: Query -> Journal -> Journal -filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts} +filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostingsExtra (jaccounttypes j) q) ts} -- | Keep only postings which do not match the query expression, but for which a related posting does. -- This can leave unbalanced transactions. @@ -577,6 +596,11 @@ filterPostingAmount q p@Posting{pamount=as} filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} +-- Like filterTransactionPostings, but is given the map of account types so can also filter by account type. +filterTransactionPostingsExtra :: M.Map AccountName AccountType -> Query -> Transaction -> Transaction +filterTransactionPostingsExtra atypes q t@Transaction{tpostings=ps} = + t{tpostings=filter (\p -> matchesPostingExtra q (M.lookup (paccount p) atypes) p) ps} + filterTransactionRelatedPostings :: Query -> Transaction -> Transaction filterTransactionRelatedPostings q t@Transaction{tpostings=ps} = t{tpostings=if null matches then [] else ps \\ matches} diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index c709d00b3..fa0594c23 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -514,7 +514,8 @@ data Journal = Journal { ,jdeclaredpayees :: [(Payee,PayeeDeclarationInfo)] -- ^ Payees declared by payee directives, in parse order (after journal finalisation) ,jdeclaredaccounts :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation) ,jdeclaredaccounttags :: M.Map AccountName [Tag] -- ^ Accounts which have tags declared in their directives, and those tags. (Does not include parents' tags.) - ,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts) + ,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been explicitly declared in their account directives, grouped by type. + ,jaccounttypes :: M.Map AccountName AccountType -- ^ All accounts for which a type has been declared or can be inferred from its parent or its name. ,jglobalcommoditystyles :: M.Map CommoditySymbol AmountStyle -- ^ per-commodity display styles declared globally, eg by command line option or import command ,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives ,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 8391011cb..4d455aa4a 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -21,6 +21,7 @@ module Hledger.Query ( parseQuery, parseQueryList, parseQueryTerm, + parseAccountType, simplifyQuery, filterQuery, filterQueryOrNotQuery, @@ -36,6 +37,7 @@ module Hledger.Query ( queryIsSym, queryIsReal, queryIsStatus, + queryIsType, queryIsTag, queryStartDate, queryEndDate, @@ -46,11 +48,13 @@ module Hledger.Query ( inAccountQuery, -- * matching matchesTransaction, + matchesTransactionExtra, matchesDescription, matchesPayeeWIP, matchesPosting, + matchesPostingExtra, matchesAccount, - matchesTaggedAccount, + matchesAccountExtra, matchesMixedAmount, matchesAmount, matchesCommodity, @@ -67,6 +71,8 @@ import Control.Applicative ((<|>), many, optional) import Data.Default (Default(..)) import Data.Either (fromLeft, partitionEithers) import Data.List (partition) +import Data.Map (Map) +import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Text (Text) import qualified Data.Text as T @@ -105,6 +111,7 @@ data Query = Any -- ^ always match -- and sometimes like a query option (for controlling display) | Tag Regexp (Maybe Regexp) -- ^ match if a tag's name, and optionally its value, is matched by these respective regexps -- matching the regexp if provided, exists + | Type [AccountType] -- ^ match accounts whose type is one of these (or with no types, any account) deriving (Eq,Show) instance Default Query where def = Any @@ -240,6 +247,7 @@ prefixes = map (<>":") [ ,"empty" ,"depth" ,"tag" + ,"type" ] defaultprefix :: T.Text @@ -288,6 +296,7 @@ parseQueryTerm _ (T.stripPrefix "depth:" -> Just s) parseQueryTerm _ (T.stripPrefix "cur:" -> Just s) = Left . Sym <$> toRegexCI ("^" <> s <> "$") -- support cur: as an alias parseQueryTerm _ (T.stripPrefix "tag:" -> Just s) = Left <$> parseTag s +parseQueryTerm _ (T.stripPrefix "type:" -> Just s) = Left <$> parseType s parseQueryTerm _ "" = Right $ Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix<>":"<>s @@ -341,6 +350,40 @@ parseTag s = do return $ Tag tag body where (n,v) = T.break (=='=') s +parseType :: T.Text -> Either String Query +parseType s = + case partitionEithers $ map (parseAccountType False . T.singleton) $ T.unpack s of + ([],ts) -> Right $ Type ts + ((e:_),_) -> Left e + +-- Not a great place for this, but avoids an import cycle. +-- | Case-insensitively parse a single-letter code, or a full word if permitted, as an account type. +parseAccountType :: Bool -> Text -> Either String AccountType +parseAccountType allowlongform s = + case T.toLower s of + "asset" | allowlongform -> Right Asset + "a" -> Right Asset + "liability" | allowlongform -> Right Liability + "l" -> Right Liability + "equity" | allowlongform -> Right Equity + "e" -> Right Equity + "revenue" | allowlongform -> Right Revenue + "r" -> Right Revenue + "expense" | allowlongform -> Right Expense + "x" -> Right Expense + "cash" | allowlongform -> Right Cash + "c" -> Right Cash + "conversion" | allowlongform -> Right Conversion + "v" -> Right Conversion + _ -> Left err + where + err = T.unpack $ "invalid account type " <> s <> ", should be one of " <> + (T.intercalate ", " $ + ["A","L","E","R","X","C","V"] + ++ if allowlongform + then ["Asset","Liability","Equity","Revenue","Expense","Cash","Conversion"] + else []) + -- | Parse the value part of a "status:" query, or return an error. parseStatus :: T.Text -> Either String Status parseStatus s | s `elem` ["*","1"] = Right Cleared @@ -459,6 +502,10 @@ queryIsStatus :: Query -> Bool queryIsStatus (StatusQ _) = True queryIsStatus _ = False +queryIsType :: Query -> Bool +queryIsType (Type _) = True +queryIsType _ = False + queryIsTag :: Query -> Bool queryIsTag (Tag _ _) = True queryIsTag _ = False @@ -568,35 +615,6 @@ inAccountQuery (QueryOptInAcct a : _) = Just . Acct $ accountNameToAccountRe -- matching --- | Does the query match this account name ? --- A matching in: clause is also considered a match. -matchesAccount :: Query -> AccountName -> Bool -matchesAccount (None) _ = False -matchesAccount (Not m) a = not $ matchesAccount m a -matchesAccount (Or ms) a = any (`matchesAccount` a) ms -matchesAccount (And ms) a = all (`matchesAccount` a) ms -matchesAccount (Acct r) a = regexMatchText r a -matchesAccount (Depth d) a = accountNameLevel a <= d -matchesAccount (Tag _ _) _ = False -matchesAccount _ _ = True - --- | Does the query match this account's name, and if the query includes --- tag: terms, do those match at least one of the account's tags ? -matchesTaggedAccount :: Query -> (AccountName,[Tag]) -> Bool -matchesTaggedAccount (None) _ = False -matchesTaggedAccount (Not m) (a,ts) = not $ matchesTaggedAccount m (a,ts) -matchesTaggedAccount (Or ms) (a,ts) = any (`matchesTaggedAccount` (a,ts)) ms -matchesTaggedAccount (And ms) (a,ts) = all (`matchesTaggedAccount` (a,ts)) ms -matchesTaggedAccount (Acct r) (a,_) = regexMatchText r a -matchesTaggedAccount (Depth d) (a,_) = accountNameLevel a <= d -matchesTaggedAccount (Tag namepat mvaluepat) (_,ts) = matchesTags namepat mvaluepat ts -matchesTaggedAccount _ _ = True - -matchesMixedAmount :: Query -> MixedAmount -> Bool -matchesMixedAmount q ma = case amountsRaw ma of - [] -> q `matchesAmount` nullamt - as -> any (q `matchesAmount`) as - matchesCommodity :: Query -> CommoditySymbol -> Bool matchesCommodity (Sym r) = regexMatchText r matchesCommodity _ = const True @@ -612,9 +630,6 @@ matchesAmount (Amt ord n) a = compareAmount ord n a matchesAmount (Sym r) a = matchesCommodity (Sym r) (acommodity a) matchesAmount _ _ = True --- | Is this simple (single-amount) mixed amount's quantity less than, greater than, equal to, or unsignedly equal to this number ? --- For multi-amount (multiple commodities, or just unsimplified) mixed amounts this is always true. - -- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ? compareAmount :: OrdPlus -> Quantity -> Amount -> Bool compareAmount ord q Amount{aquantity=aq} = case ord of Lt -> aq < q @@ -628,9 +643,42 @@ compareAmount ord q Amount{aquantity=aq} = case ord of Lt -> aq < q AbsGtEq -> abs aq >= abs q AbsEq -> abs aq == abs q --- | Does the match expression match this posting ? +matchesMixedAmount :: Query -> MixedAmount -> Bool +matchesMixedAmount q ma = case amountsRaw ma of + [] -> q `matchesAmount` nullamt + as -> any (q `matchesAmount`) as + +-- | Does the query match this account name ? +-- A matching in: clause is also considered a match. +matchesAccount :: Query -> AccountName -> Bool +matchesAccount (None) _ = False +matchesAccount (Not m) a = not $ matchesAccount m a +matchesAccount (Or ms) a = any (`matchesAccount` a) ms +matchesAccount (And ms) a = all (`matchesAccount` a) ms +matchesAccount (Acct r) a = regexMatchText r a +matchesAccount (Depth d) a = accountNameLevel a <= d +matchesAccount (Tag _ _) _ = False +matchesAccount _ _ = True + +-- | Like matchesAccount, but with optional extra matching features: -- --- Note that for account match we try both original and effective account +-- - If the account's type is provided, any type: terms in the query +-- must match it (and any negated type: terms must not match it). +-- +-- - If the account's tags are provided, any tag: terms must match +-- at least one of them (and any negated tag: terms must match none). +-- +matchesAccountExtra :: Query -> Maybe AccountType -> [Tag] -> AccountName -> Bool +matchesAccountExtra (Not q ) mtype mtags a = not $ matchesAccountExtra q mtype mtags a +matchesAccountExtra (Or qs) mtype mtags a = any (\q -> matchesAccountExtra q mtype mtags a) qs +matchesAccountExtra (And qs) mtype mtags a = all (\q -> matchesAccountExtra q mtype mtags a) qs +matchesAccountExtra (Tag npat vpat) _ mtags _ = matchesTags npat vpat mtags +matchesAccountExtra (Type ts) matype _ _ = elem matype $ map Just ts +matchesAccountExtra q _ _ a = matchesAccount q a + +-- | Does the match expression match this posting ? +-- When matching account name, and the posting has been transformed +-- in some way, we will match either the original or transformed name. matchesPosting :: Query -> Posting -> Bool matchesPosting (Not q) p = not $ q `matchesPosting` p matchesPosting (Any) _ = True @@ -639,8 +687,7 @@ matchesPosting (Or qs) p = any (`matchesPosting` p) qs matchesPosting (And qs) p = all (`matchesPosting` p) qs matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p -matchesPosting (Acct r) p = matches p || maybe False matches (poriginal p) - where matches = regexMatchText r . paccount +matchesPosting (Acct r) p = matches p || maybe False matches (poriginal p) where matches = regexMatchText r . paccount matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (StatusQ s) p = postingStatus p == s @@ -652,6 +699,17 @@ matchesPosting (Tag n v) p = case (reString n, v) of ("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p ("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p (_, mv) -> matchesTags n mv $ postingAllTags p +matchesPosting (Type _) _ = False + +-- | Like matchesPosting, but if the posting's account's type is provided, +-- any type: terms in the query must match it (and any negated type: terms +-- must not match it). +matchesPostingExtra :: Query -> Maybe AccountType -> Posting -> Bool +matchesPostingExtra (Not q ) mtype a = not $ matchesPostingExtra q mtype a +matchesPostingExtra (Or qs) mtype a = any (\q -> matchesPostingExtra q mtype a) qs +matchesPostingExtra (And qs) mtype a = all (\q -> matchesPostingExtra q mtype a) qs +matchesPostingExtra (Type ts) (Just atype) _ = atype `elem` ts +matchesPostingExtra q _ p = matchesPosting q p -- | Does the match expression match this transaction ? matchesTransaction :: Query -> Transaction -> Bool @@ -674,6 +732,19 @@ matchesTransaction (Tag n v) t = case (reString n, v) of ("payee", Just v) -> regexMatchText v $ transactionPayee t ("note", Just v) -> regexMatchText v $ transactionNote t (_, v) -> matchesTags n v $ transactionAllTags t +matchesTransaction (Type _) _ = False + +-- | Like matchesTransaction, but if the journal's account types are provided, +-- any type: terms in the query must match at least one posting's account type +-- (and any negated type: terms must match none). +matchesTransactionExtra :: Query -> (Maybe (Map AccountName AccountType)) -> Transaction -> Bool +matchesTransactionExtra (Not q) mtypes t = not $ matchesTransactionExtra q mtypes t +matchesTransactionExtra (Or qs) mtypes t = any (\q -> matchesTransactionExtra q mtypes t) qs +matchesTransactionExtra (And qs) mtypes t = all (\q -> matchesTransactionExtra q mtypes t) qs +matchesTransactionExtra q@(Type _) (Just atypes) t = + any (\p -> matchesPostingExtra q (postingAccountType p) p) $ tpostings t + where postingAccountType p = M.lookup (paccount p) atypes +matchesTransactionExtra q _ t = matchesTransaction q t -- | Does the query match this transaction description ? -- Tests desc: terms, any other terms are ignored. @@ -685,15 +756,7 @@ matchesDescription (Or qs) d = any (`matchesDescription` d) $ filter queryI matchesDescription (And qs) d = all (`matchesDescription` d) $ filter queryIsDesc qs matchesDescription (Code _) _ = False matchesDescription (Desc r) d = regexMatchText r d -matchesDescription (Acct _) _ = False -matchesDescription (Date _) _ = False -matchesDescription (Date2 _) _ = False -matchesDescription (StatusQ _) _ = False -matchesDescription (Real _) _ = False -matchesDescription (Amt _ _) _ = False -matchesDescription (Depth _) _ = False -matchesDescription (Sym _) _ = False -matchesDescription (Tag _ _) _ = False +matchesDescription _ _ = False -- | Does the query match this transaction payee ? -- Tests desc: (and payee: ?) terms, any other terms are ignored. @@ -817,10 +880,10 @@ tests_Query = testGroup "Query" [ assertBool "" $ Date2 nulldatespan `matchesAccount` "a" assertBool "" $ not $ Tag (toRegex' "a") Nothing `matchesAccount` "a" - ,testCase "matchesTaggedAccount" $ do + ,testCase "matchesAccountExtra" $ do let tagq = Tag (toRegexCI' "type") Nothing - assertBool "" $ not $ tagq `matchesTaggedAccount` ("a", []) - assertBool "" $ tagq `matchesTaggedAccount` ("a", [("type","")]) + assertBool "" $ not $ matchesAccountExtra tagq Nothing [] "a" + assertBool "" $ matchesAccountExtra tagq Nothing [("type","")] "a" ,testGroup "matchesPosting" [ testCase "positive match on cleared posting status" $ diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 36945506d..392a208ef 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -152,6 +152,7 @@ import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToR import Hledger.Utils import Text.Printf (printf) import Hledger.Read.InputOptions +import Data.Tree --- ** doctest setup -- $setup @@ -323,9 +324,10 @@ journalFinalise iopts@InputOpts{auto_,infer_equity_,balancingopts_,strict_,_ioDa let pj2 = pj & journalSetLastReadTime t -- save the last read time & journalAddFile (f, txt) -- save the main file's info - & journalReverse -- convert all lists to the order they were parsed + & journalReverse -- convert all lists to the order they were parsed + & journalAddAccountTypes -- build a map of all known account types pj3 <- pj2{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_} - & journalApplyCommodityStyles -- Infer and apply commodity styles - should be done early + & journalApplyCommodityStyles -- Infer and apply commodity styles - should be done early j <- pj3 & journalPostingsAddAccountTags -- Add account tags to postings' tags & journalAddForecast (forecastPeriod iopts pj3) -- Add forecast transactions if enabled @@ -340,6 +342,33 @@ journalFinalise iopts@InputOpts{auto_,infer_equity_,balancingopts_,strict_,_ioDa journalCheckCommoditiesDeclared j -- and using declared commodities return j +-- | Add a map of all known account types to the journal. +journalAddAccountTypes :: Journal -> Journal +journalAddAccountTypes j = j{jaccounttypes = journalAccountTypes j} + +-- | Build a map of all known account types, explicitly declared +-- or inferred from the account's parent or name. +journalAccountTypes :: Journal -> M.Map AccountName AccountType +journalAccountTypes j = + let + t = accountNameTreeFrom $ journalAccountNames j :: Tree AccountName + t' = settypes Nothing t :: Tree (AccountName, Maybe AccountType) + in + M.fromList [(a,t) | (a, Just t) <- flatten t'] + where + -- Map from the top of the account tree down to the leaves, + -- propagating account types downward. + settypes :: Maybe AccountType -> Tree AccountName -> Tree (AccountName, Maybe AccountType) + settypes mparenttype (Node a subs) = + let mtype = M.lookup a declaredtypes <|> mparenttype <|> accountNameInferType a + in Node (a, mtype) (map (settypes mtype) subs) + declaredtypes = journalDeclaredAccountTypes j + +-- | Build a map of the account types explicitly declared. +journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType +journalDeclaredAccountTypes Journal{jdeclaredaccounttypes} = + M.fromList $ concat [map (,t) as | (t,as) <- M.toList jdeclaredaccounttypes] + -- | To all postings in the journal, add any tags from their account -- (including those inherited from parent accounts). -- If the same tag exists on posting and account, the latter is ignored. diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index cef5b58f7..22048d5db 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -171,8 +171,9 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr ropts = cbcsubreportoptions $ _rsReportOpts rspec rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [q, _rsQuery rspec]} -- Starting balances and column postings specific to this subreport. - startbals' = startingBalances rspecsub j priceoracle $ filter (matchesPosting q) startps - colps' = map (second $ filter (matchesPosting q)) colps + startbals' = startingBalances rspecsub j priceoracle $ + filter (\p -> matchesPostingExtra q (journalAccountType j (paccount p)) p) startps + colps' = map (second $ filter (\p -> matchesPostingExtra q (journalAccountType j (paccount p)) p)) colps -- Sum the subreport totals by column. Handle these cases: -- - no subreports @@ -286,12 +287,13 @@ acctChanges ReportSpec{_rsQuery=query,_rsReportOpts=ReportOpts{accountlistmode_, declaredacctps = [nullposting{paccount=a} | a <- journalLeafAccountNamesDeclared j + , let mtype = journalAccountType j a , let atags = M.findWithDefault [] a $ jdeclaredaccounttags j - , acctandtagsq `matchesTaggedAccount` (a, atags) + , matchesAccountExtra accttypetagsq mtype atags a ] where - acctandtagsq = dbg3 "acctandtagsq" $ - filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsTag q) query + accttypetagsq = dbg3 "accttypetagsq" $ + filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsType q || queryIsTag q) query filterbydepth = case accountlistmode_ of ALTree -> filter ((depthq `matchesAccount`) . aname) -- a tree - just exclude deeper accounts diff --git a/hledger/Hledger/Cli/Commands/Accounts.hs b/hledger/Hledger/Cli/Commands/Accounts.hs index 123bdf6cb..82a71b078 100644 --- a/hledger/Hledger/Cli/Commands/Accounts.hs +++ b/hledger/Hledger/Cli/Commands/Accounts.hs @@ -57,7 +57,8 @@ accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query,_rsRepo depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth query matcheddeclaredaccts = dbg1 "matcheddeclaredaccts" $ - filter (\a -> matchesTaggedAccount nodepthq (a, (journalInheritedAccountTags j a))) $ map fst $ jdeclaredaccounts j + filter (\a -> matchesAccountExtra nodepthq (journalAccountType j a) (journalInheritedAccountTags j a) a) + $ map fst $ jdeclaredaccounts j matchedusedaccts = dbg5 "matchedusedaccts" $ map paccount $ journalPostings $ filterJournalPostings nodepthq j accts = dbg5 "accts to show" $ -- no need to nub/sort, accountTree will if | declared && not used -> matcheddeclaredaccts diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 31f3c5571..b0e3783f5 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -847,6 +847,12 @@ Match real or virtual postings respectively. **`status:, status:!, status:*`**\ Match unmarked, pending, or cleared transactions respectively. +**`type:ACCTTYPES`**\ +Match by account type (see [Declaring accounts > Account types](#account-types)). +`ACCTTYPES` is one or more of the single-letter account type codes +`ALERXCV`, case insensitive. +Eg: `hledger bal type:AL` shows asset and liability balances. + **`tag:REGEX[=REGEX]`**\ Match by tag name, and optionally also by tag value. (To match only by value, use `tag:.=REGEX`.) @@ -3065,10 +3071,10 @@ you can declare hledger accounts to be of a certain type: Declaring account types is a good idea: they are required by the convenient [balancesheet], [balancesheetequity], [incomestatement] and [cashflow] reports, and probably other things in future. -You can also use them with other commands to reliably select accounts by type, -without depending on their names. Eg: +You can also use the [`type:` query](#queries) to easily select accounts by type, +regardless of their names. Eg, to select asset and liability accounts: ```shell -hledger balance tag:type=^[AL] +hledger balance type:AL ``` As a convenience, when account types are not declared,