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,