fix: types: Make sure type: query will correctly match subtypes, so

type:a will also match cash accounts, and type:e will also match
conversion accounts.
This commit is contained in:
Stephen Morgan 2022-02-03 20:22:38 +11:00 committed by Simon Michael
parent 73925ae965
commit 2e4cfccf1b
3 changed files with 34 additions and 7 deletions

View File

@ -162,6 +162,20 @@ instance Show AccountType where
show Cash = "C"
show Conversion = "V"
-- | Check whether the first argument is a subtype of the second: either equal
-- or one of the defined subtypes.
isAccountSubtypeOf :: AccountType -> AccountType -> Bool
isAccountSubtypeOf Asset Asset = True
isAccountSubtypeOf Liability Liability = True
isAccountSubtypeOf Equity Equity = True
isAccountSubtypeOf Revenue Revenue = True
isAccountSubtypeOf Expense Expense = True
isAccountSubtypeOf Cash Cash = True
isAccountSubtypeOf Cash Asset = True
isAccountSubtypeOf Conversion Conversion = True
isAccountSubtypeOf Conversion Equity = True
isAccountSubtypeOf _ _ = False
-- not worth the trouble, letters defined in accountdirectivep for now
--instance Read AccountType
-- where

View File

@ -672,12 +672,12 @@ matchesAccount _ _ = True
-- at least one of them (and any negated tag: terms must match none).
--
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 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 atypes _ (Type ts) a = maybe False (\t -> any (t `isAccountSubtypeOf`) ts) $ atypes a
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
matchesAccountExtra _ _ q a = matchesAccount q a
-- | Does the match expression match this posting ?
-- When matching account name, and the posting has been transformed
@ -711,8 +711,8 @@ matchesPostingExtra :: (AccountName -> Maybe AccountType) -> Query -> Posting ->
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
matchesPostingExtra atype (Type ts) p = maybe False (\t -> any (t `isAccountSubtypeOf`) ts) . atype $ paccount p
matchesPostingExtra _ q p = matchesPosting q p
-- | Does the match expression match this transaction ?
matchesTransaction :: Query -> Transaction -> Bool

View File

@ -71,15 +71,18 @@ a:aa
# 10. type: is aware of inferred account types.
<
account assets
account assets:cash
account liabilities
$ hledger -f- accounts type:a
assets
assets:cash
# 11. type: can identify cash accounts in the default case
<
account assets
account assets:cash
account liabilities
$ hledger -f- accounts type:c
assets:cash
@ -120,3 +123,13 @@ $ hledger -f- reg --auto type:a
$ hledger -f- reg --auto type:x
2022-02-02 Test (expenses:b) 1 1
# 15. type:a matches cash accounts and type:e matches conversion accounts
<
2022-02-02 Test
(assets:cash) 1
(equity:conversion) 2
$ hledger -f- reg type:ae
2022-02-02 Test (assets:cash) 1 1
(equity:conversion) 2 3