From 73925ae965c931a7cfac99d4ff66a0175136fa86 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 1 Feb 2022 16:37:38 +1100 Subject: [PATCH] fix: types: Ensure auto postings can match against and be matched by type: queries. This requires checking parent accounts for any new accounts introduced by auto postings which do not exist in the original journal. Also refactor journalFinalise to only call journalPostingsAddAccountTags once, and use fewer intermediate variables. --- hledger-lib/Hledger/Data/AccountName.hs | 12 +++- hledger-lib/Hledger/Data/Journal.hs | 57 +++++++++++++++--- .../Hledger/Data/TransactionModifier.hs | 33 +++++++---- hledger-lib/Hledger/Query.hs | 46 +++++++-------- hledger-lib/Hledger/Read/Common.hs | 59 ++++--------------- .../Hledger/Reports/MultiBalanceReport.hs | 10 ++-- hledger/Hledger/Cli/Commands/Accounts.hs | 2 +- hledger/Hledger/Cli/Commands/Rewrite.hs | 2 +- hledger/test/query-type.test | 25 ++++++++ 9 files changed, 143 insertions(+), 103 deletions(-) diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index 20f7a41b7..fdafdf108 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -21,6 +21,7 @@ module Hledger.Data.AccountName ( ,accountNameTreeFrom ,accountSummarisedName ,accountNameInferType + ,accountNameType ,assetAccountRegex ,cashAccountRegex ,liabilityAccountRegex @@ -48,8 +49,10 @@ module Hledger.Data.AccountName ( ) where -import Data.Foldable (toList) +import Control.Applicative ((<|>)) +import Data.Foldable (asum, toList) import qualified Data.List.NonEmpty as NE +import qualified Data.Map as M import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T @@ -113,6 +116,13 @@ accountNameInferType a | regexMatchText expenseAccountRegex a = Just Expense | otherwise = Nothing +-- Extract the 'AccountType' of an 'AccountName' by looking it up in the +-- provided Map, traversing the parent accounts if necessary. If none of those +-- work, try 'accountNameInferType'. +accountNameType :: M.Map AccountName AccountType -> AccountName -> Maybe AccountType +accountNameType atypes a = asum (map (`M.lookup` atypes) $ a : parentAccountNames a) + <|> accountNameInferType a + 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 0e6938214..66f3240f0 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-| @@ -76,7 +77,11 @@ module Hledger.Data.Journal ( journalPrevTransaction, journalPostings, journalTransactionsSimilarTo, - journalAccountType, + -- * Account types + journalAccountType, + journalAccountTypes, + journalAddAccountTypes, + journalPostingsAddAccountTags, -- journalPrices, -- * Standard account types journalBalanceSheetAccountQuery, @@ -120,7 +125,7 @@ import qualified Data.Text as T import Safe (headMay, headDef, maximumMay, minimumMay) import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Time.Clock.POSIX (POSIXTime) -import Data.Tree (Tree, flatten) +import Data.Tree (Tree(..), flatten) import Text.Printf (printf) import Text.Megaparsec (ParsecT) import Text.Megaparsec.Custom (FinalParseError) @@ -550,7 +555,43 @@ journalConversionAccount = -- Newer account type functionality. journalAccountType :: Journal -> AccountName -> Maybe AccountType -journalAccountType Journal{jaccounttypes} a = M.lookup a jaccounttypes +journalAccountType Journal{jaccounttypes} = accountNameType jaccounttypes + +-- | 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 = M.fromList [(a,acctType) | (a, Just (acctType,_)) <- flatten t'] + where + t = accountNameTreeFrom $ journalAccountNames j :: Tree AccountName + t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool)) + -- Map from the top of the account tree down to the leaves, propagating + -- account types downward. Keep track of whether the account is declared + -- (True), in which case the parent account should be preferred, or merely + -- inferred (False), in which case the inferred type should be preferred. + settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool)) + settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs) + where + mtype = M.lookup a declaredtypes <|> minferred + minferred = if maybe False snd mparenttype + then mparenttype + else (,False) <$> accountNameInferType a <|> mparenttype + declaredtypes = (,True) <$> 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. +journalPostingsAddAccountTags :: Journal -> Journal +journalPostingsAddAccountTags j = journalMapPostings addtags j + where addtags p = p `postingAddTags` (journalInheritedAccountTags j $ paccount p) -- Various kinds of filtering on journals. We do it differently depending -- on the command. @@ -560,12 +601,12 @@ journalAccountType Journal{jaccounttypes} a = M.lookup a jaccounttypes -- | Keep only transactions matching the query expression. filterJournalTransactions :: Query -> Journal -> Journal -filterJournalTransactions q j@Journal{jaccounttypes, jtxns} = j{jtxns=filter (matchesTransactionExtra q (Just jaccounttypes)) jtxns} +filterJournalTransactions q j@Journal{jtxns} = j{jtxns=filter (matchesTransactionExtra (journalAccountType j) q) 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 (filterTransactionPostingsExtra (jaccounttypes j) q) ts} +filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostingsExtra (journalAccountType 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. @@ -597,9 +638,9 @@ 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 :: (AccountName -> Maybe AccountType) -> Query -> Transaction -> Transaction filterTransactionPostingsExtra atypes q t@Transaction{tpostings=ps} = - t{tpostings=filter (\p -> matchesPostingExtra q (M.lookup (paccount p) atypes) p) ps} + t{tpostings=filter (matchesPostingExtra atypes q) ps} filterTransactionRelatedPostings :: Query -> Transaction -> Transaction filterTransactionRelatedPostings q t@Transaction{tpostings=ps} = @@ -783,7 +824,7 @@ journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ -- relative dates in transaction modifier queries. journalModifyTransactions :: Day -> Journal -> Either String Journal journalModifyTransactions d j = - case modifyTransactions (journalCommodityStyles j) d (jtxnmodifiers j) (jtxns j) of + case modifyTransactions (journalAccountType j) (journalInheritedAccountTags j) (journalCommodityStyles j) d (jtxnmodifiers j) (jtxns j) of Right ts -> Right j{jtxns=ts} Left err -> Left err diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 3752bc36f..1624f0781 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -18,12 +18,12 @@ import Data.Maybe (catMaybes) import qualified Data.Text as T import Data.Time.Calendar (Day) import Hledger.Data.Types -import Hledger.Data.Dates import Hledger.Data.Amount +import Hledger.Data.Dates import Hledger.Data.Transaction (txnTieKnot) -import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting, +import Hledger.Query (Query, filterQuery, matchesAmount, matchesPostingExtra, parseQuery, queryIsAmt, queryIsSym, simplifyQuery) -import Hledger.Data.Posting (commentJoin, commentAddTag, postingApplyCommodityStyles) +import Hledger.Data.Posting (commentJoin, commentAddTag, postingAddTags, postingApplyCommodityStyles) import Hledger.Utils (dbg6, wrap) -- $setup @@ -36,9 +36,13 @@ import Hledger.Utils (dbg6, wrap) -- Or if any of them fails to be parsed, return the first error. A reference -- date is provided to help interpret relative dates in transaction modifier -- queries. -modifyTransactions :: M.Map CommoditySymbol AmountStyle -> Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction] -modifyTransactions styles d tmods ts = do - fs <- mapM (transactionModifierToFunction styles d) tmods -- convert modifiers to functions, or return a parse error +modifyTransactions :: (AccountName -> Maybe AccountType) + -> (AccountName -> [Tag]) + -> M.Map CommoditySymbol AmountStyle + -> Day -> [TransactionModifier] -> [Transaction] + -> Either String [Transaction] +modifyTransactions atypes atags styles d tmods ts = do + fs <- mapM (transactionModifierToFunction atypes atags styles d) tmods -- convert modifiers to functions, or return a parse error let modifytxn t = t'' where @@ -62,7 +66,7 @@ modifyTransactions styles d tmods ts = do -- >>> import qualified Data.Text.IO as T -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False --- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction mempty nulldate +-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction (const Nothing) (const []) mempty nulldate -- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2] -- 0000-01-01 -- ping $1.00 @@ -78,13 +82,18 @@ modifyTransactions styles d tmods ts = do -- pong $3.00 ; generated-posting: = ping -- -- -transactionModifierToFunction :: M.Map CommoditySymbol AmountStyle -> Day -> TransactionModifier -> Either String (Transaction -> Transaction) -transactionModifierToFunction styles refdate TransactionModifier{tmquerytxt, tmpostingrules} = do +transactionModifierToFunction :: (AccountName -> Maybe AccountType) + -> (AccountName -> [Tag]) + -> M.Map CommoditySymbol AmountStyle + -> Day -> TransactionModifier + -> Either String (Transaction -> Transaction) +transactionModifierToFunction atypes atags styles refdate TransactionModifier{tmquerytxt, tmpostingrules} = do q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt let - fs = map (tmPostingRuleToFunction styles q tmquerytxt) tmpostingrules - generatePostings = concatMap (\p -> p : map ($ p) (if q `matchesPosting` p then fs else [])) - Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps} + fs = map (\tmpr -> addAccountTags . tmPostingRuleToFunction styles q tmquerytxt tmpr) tmpostingrules + addAccountTags p = p `postingAddTags` atags (paccount p) + generatePostings p = p : map ($ p) (if matchesPostingExtra atypes q p then fs else []) + Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=concatMap generatePostings ps} -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, -- which will be used to make a new posting based on the old one (an "automated posting"). diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 30a48c6ad..3cf9c7de7 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -71,8 +71,6 @@ import Control.Applicative ((<|>), many, optional) import Data.Default (Default(..)) import Data.Either (fromLeft, partitionEithers) import Data.List (partition, intercalate) -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 @@ -673,13 +671,13 @@ matchesAccount _ _ = True -- - 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 +matchesAccountExtra :: (AccountName -> Maybe AccountType) -> (AccountName -> [Tag]) -> Query -> AccountName -> Bool +matchesAccountExtra atypes atags (Not q ) a = not $ matchesAccountExtra atypes atags q a +matchesAccountExtra atypes atags (Or qs) a = any (\q -> matchesAccountExtra atypes atags q a) qs +matchesAccountExtra atypes atags (And qs) a = all (\q -> matchesAccountExtra atypes atags q a) qs +matchesAccountExtra _ atags (Tag npat vpat) a = matchesTags npat vpat $ atags a +matchesAccountExtra atypes _ (Type ts) a = maybe False (`elem` ts) $ atypes a +matchesAccountExtra _ _ q a = matchesAccount q a -- | Does the match expression match this posting ? -- When matching account name, and the posting has been transformed @@ -709,12 +707,12 @@ 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 +matchesPostingExtra :: (AccountName -> Maybe AccountType) -> Query -> Posting -> Bool +matchesPostingExtra atype (Not q ) p = not $ matchesPostingExtra atype q p +matchesPostingExtra atype (Or qs) p = any (\q -> matchesPostingExtra atype q p) qs +matchesPostingExtra atype (And qs) p = all (\q -> matchesPostingExtra atype q p) qs +matchesPostingExtra atype (Type ts) p = maybe False (`elem` ts) . atype $ paccount p +matchesPostingExtra _ q p = matchesPosting q p -- | Does the match expression match this transaction ? matchesTransaction :: Query -> Transaction -> Bool @@ -742,14 +740,12 @@ 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 +matchesTransactionExtra :: (AccountName -> Maybe AccountType) -> Query -> Transaction -> Bool +matchesTransactionExtra atype (Not q) t = not $ matchesTransactionExtra atype q t +matchesTransactionExtra atype (Or qs) t = any (\q -> matchesTransactionExtra atype q t) qs +matchesTransactionExtra atype (And qs) t = all (\q -> matchesTransactionExtra atype q t) qs +matchesTransactionExtra atype q@(Type _) t = any (matchesPostingExtra atype q) $ tpostings t +matchesTransactionExtra _ q t = matchesTransaction q t -- | Does the query match this transaction description ? -- Tests desc: terms, any other terms are ignored. @@ -887,8 +883,8 @@ tests_Query = testGroup "Query" [ ,testCase "matchesAccountExtra" $ do let tagq = Tag (toRegexCI' "type") Nothing - assertBool "" $ not $ matchesAccountExtra tagq Nothing [] "a" - assertBool "" $ matchesAccountExtra tagq Nothing [("type","")] "a" + assertBool "" $ not $ matchesAccountExtra (const Nothing) (const []) tagq "a" + assertBool "" $ matchesAccountExtra (const Nothing) (const [("type","")]) tagq "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 140e9f0b4..30355e127 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -152,7 +152,6 @@ import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToR import Hledger.Utils import Text.Printf (printf) import Hledger.Read.InputOptions -import Data.Tree --- ** doctest setup -- $setup @@ -321,19 +320,17 @@ journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT Str journalFinalise iopts@InputOpts{auto_,infer_equity_,balancingopts_,strict_,_ioDay} f txt pj = do t <- liftIO getPOSIXTime liftEither $ do - 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 - & journalAddAccountTypes -- build a map of all known account types - pj3 <- pj2{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_} + j <- pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_} + & 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 + & journalAddAccountTypes -- build a map of all known account types & 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 - & journalPostingsAddAccountTags -- Add account tags again to affect forecast transactions -- PERF: just to the new transactions ? - & (if auto_ && not (null $ jtxnmodifiers pj3) then journalAddAutoPostings _ioDay balancingopts_ else pure) -- Add auto postings if enabled - >>= Right . journalPostingsAddAccountTags -- Add account tags again to affect auto postings -- PERF: just to the new postings ? + <&> journalAddForecast (forecastPeriod iopts pj) -- Add forecast transactions if enabled + <&> journalPostingsAddAccountTags -- Add account tags to postings, so they can be matched by auto postings. + >>= (if auto_ && not (null $ jtxnmodifiers pj) + then journalAddAutoPostings _ioDay balancingopts_ -- Add auto postings if enabled, and account tags if needed + else pure) >>= journalBalanceTransactions balancingopts_ -- Balance all transactions and maybe check balance assertions. <&> (if infer_equity_ then journalAddInferredEquityPostings else id) -- Add inferred equity postings, after balancing transactions and generating auto postings <&> journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions @@ -342,42 +339,6 @@ 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 = M.fromList [(a,acctType) | (a, Just (acctType,_)) <- flatten t'] - where - t = accountNameTreeFrom $ journalAccountNames j :: Tree AccountName - t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool)) - -- Map from the top of the account tree down to the leaves, propagating - -- account types downward. Keep track of whether the account is declared - -- (True), in which case the parent account should be preferred, or merely - -- inferred (False), in which case the inferred type should be preferred. - settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool)) - settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs) - where - mtype = M.lookup a declaredtypes <|> minferred - minferred = if maybe False snd mparenttype - then mparenttype - else (,False) <$> accountNameInferType a <|> mparenttype - declaredtypes = (,True) <$> 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. -journalPostingsAddAccountTags :: Journal -> Journal -journalPostingsAddAccountTags j = journalMapPostings addtags j - where addtags p = p `postingAddTags` (journalInheritedAccountTags j $ paccount p) - -- | Apply any auto posting rules to generate extra postings on this journal's transactions. journalAddAutoPostings :: Day -> BalancingOpts -> Journal -> Either String Journal journalAddAutoPostings d bopts = diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 22048d5db..9da221420 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -171,9 +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 (\p -> matchesPostingExtra q (journalAccountType j (paccount p)) p) startps - colps' = map (second $ filter (\p -> matchesPostingExtra q (journalAccountType j (paccount p)) p)) colps + startbals' = startingBalances rspecsub j priceoracle $ + filter (matchesPostingExtra (journalAccountType j) q) startps + colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) q)) colps -- Sum the subreport totals by column. Handle these cases: -- - no subreports @@ -287,9 +287,7 @@ 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 - , matchesAccountExtra accttypetagsq mtype atags a + , matchesAccountExtra (journalAccountType j) (journalAccountTags j) accttypetagsq a ] where accttypetagsq = dbg3 "accttypetagsq" $ diff --git a/hledger/Hledger/Cli/Commands/Accounts.hs b/hledger/Hledger/Cli/Commands/Accounts.hs index 960e50acd..c61b3e87a 100644 --- a/hledger/Hledger/Cli/Commands/Accounts.hs +++ b/hledger/Hledger/Cli/Commands/Accounts.hs @@ -60,7 +60,7 @@ accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query,_rsRepo depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth query matcheddeclaredaccts = dbg1 "matcheddeclaredaccts" $ - filter (\a -> matchesAccountExtra nodepthq (journalAccountType j a) (journalInheritedAccountTags j a) a) + filter (matchesAccountExtra (journalAccountType j) (journalInheritedAccountTags j) nodepthq) $ 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 diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index f9e574ce1..45a1e5617 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -41,7 +41,7 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j@Journal{jtxns=ts} = d -- rewrite matched transactions let today = _rsDay rspec let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j - let j' = j{jtxns=either error' id $ modifyTransactions mempty today modifiers ts} -- PARTIAL: + let j' = j{jtxns=either error' id $ modifyTransactions (journalAccountType j) (journalInheritedAccountTags j) mempty today modifiers ts} -- PARTIAL: -- run the print command, showing all transactions, or show diffs printOrDiff rawopts opts{reportspec_=rspec{_rsQuery=Any}} j j' diff --git a/hledger/test/query-type.test b/hledger/test/query-type.test index 7efaa1b3f..8c27a9ad4 100644 --- a/hledger/test/query-type.test +++ b/hledger/test/query-type.test @@ -95,3 +95,28 @@ $ hledger -f- accounts type:v equity:conversion equity:trading equity:trade + +# 13. type: can be used in and can match auto postings +< +account assets ; type:a + += type:a + (assets:b) 1 + +2022-02-02 Test + (assets) 2 + +$ hledger -f- reg --auto type:a +2022-02-02 Test (assets) 2 2 + (assets:b) 1 3 + +# 14. type: can be used in and can match auto postings with no known parents +< += type:a + (expenses:b) 1 + +2022-02-02 Test + (assets) 2 + +$ hledger -f- reg --auto type:x +2022-02-02 Test (expenses:b) 1 1