dev: refactor: clarify journalAccountTypes

This commit is contained in:
Simon Michael 2024-10-17 12:00:48 -10:00
parent e44cbbf1a4
commit da11d74ae6

View File

@ -154,6 +154,7 @@ import System.FilePath (takeFileName)
import Data.Ord (comparing) import Data.Ord (comparing)
import Hledger.Data.Dates (nulldate) import Hledger.Data.Dates (nulldate)
import Data.List (sort) import Data.List (sort)
import Data.Function ((&))
-- import Data.Function ((&)) -- import Data.Function ((&))
@ -576,27 +577,31 @@ journalAccountType Journal{jaccounttypes} = accountNameType jaccounttypes
journalAddAccountTypes :: Journal -> Journal journalAddAccountTypes :: Journal -> Journal
journalAddAccountTypes j = j{jaccounttypes = journalAccountTypes j} journalAddAccountTypes j = j{jaccounttypes = journalAccountTypes j}
-- | An account type inherited from the parent account(s),
-- and whether it was originally declared by an account directive (true) or inferred from an account name (false).
type ParentAccountType = ( AccountType, Bool )
-- | Build a map of all known account types, explicitly declared -- | Build a map of all known account types, explicitly declared
-- or inferred from the account's parent or name. -- or inferred from the account's parent or name.
journalAccountTypes :: Journal -> M.Map AccountName AccountType journalAccountTypes :: Journal -> M.Map AccountName AccountType
journalAccountTypes j = M.fromList [(a,acctType) | (a, Just (acctType,_)) <- flatten t'] journalAccountTypes j = M.fromList [(a,acctType) | (a, Just (acctType,_)) <- flatten t']
where where
t = accountNameTreeFrom $ journalAccountNames j :: Tree AccountName t = accountNameTreeFrom $ journalAccountNames j :: Tree AccountName
-- Map from the top of the account tree down to the leaves, propagating -- Map from the top of the account tree down to the leaves, applying any explicitly declared account types,
-- account types downward. Keep track of whether the account is declared -- otherwise inferring account types from account names when possible, and propagating account types downward.
-- (True), in which case the parent account should be preferred, or merely -- Declared account types (possibly inherited from parent) are preferred, inferred types are used as a fallback.
-- inferred (False), in which case the inferred type should be preferred. t' = setTypeHereAndBelow Nothing t :: Tree (AccountName, Maybe (AccountType, Bool))
t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool))
where where
settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool)) declaredtypesbyname = journalDeclaredAccountTypes j & fmap (,True)
settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs) setTypeHereAndBelow :: Maybe ParentAccountType -> Tree AccountName -> Tree (AccountName, Maybe ParentAccountType)
setTypeHereAndBelow mparenttype (Node a subs) = Node (a, mnewtype) (map (setTypeHereAndBelow mnewtype) subs)
where where
mtype = M.lookup a declaredtypes <|> minferred mnewtype = mthisacctdeclaredtype <|> mparentacctdeclaredtype <|> mthisacctinferredtype <|> mparentacctinferredtype
where where
declaredtypes = (,True) <$> journalDeclaredAccountTypes j mthisacctdeclaredtype = M.lookup a declaredtypesbyname
minferred = if maybe False snd mparenttype mparentacctdeclaredtype = if fromMaybe False $ snd <$> mparenttype then mparenttype else Nothing
then mparenttype mparentacctinferredtype = if not $ fromMaybe True $ snd <$> mparenttype then mparenttype else Nothing
else (,False) <$> accountNameInferType a <|> mparenttype mthisacctinferredtype = accountNameInferType a & fmap (,False)
-- | Build a map of the account types explicitly declared for each account. -- | Build a map of the account types explicitly declared for each account.
journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType
@ -616,7 +621,8 @@ journalPostingsAddAccountTags j = journalMapPostings addtags j
journalBaseConversionAccount :: Journal -> AccountName journalBaseConversionAccount :: Journal -> AccountName
journalBaseConversionAccount = headDef defaultBaseConversionAccount . journalConversionAccounts journalBaseConversionAccount = headDef defaultBaseConversionAccount . journalConversionAccounts
-- | All the accounts declared or inferred as V/Conversion type in this journal. -- | All the accounts in this journal which are declared or inferred as V/Conversion type.
-- This does not include new account names which might be generated by --infer-equity, currently.
journalConversionAccounts :: Journal -> [AccountName] journalConversionAccounts :: Journal -> [AccountName]
journalConversionAccounts = M.keys . M.filter (==Conversion) . jaccounttypes journalConversionAccounts = M.keys . M.filter (==Conversion) . jaccounttypes