slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ref: journalAccountTypes

Browse Source
This commit is contained in:
Simon Michael 2022-04-11 09:18:23 -10:00
parent f48ef6db83
commit aa3807e157
1 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
hledger-lib/Hledger/Data/Journal.hs
View File

@ -428,6 +428,8 @@ letterPairs :: String -> [String]
letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)
letterPairs _ = [] letterPairs _ = []
-- Older account type code
-- queries for standard account types -- queries for standard account types
-- | Get a query for accounts of the specified types in this journal. -- | Get a query for accounts of the specified types in this journal.
@ -538,7 +540,7 @@ journalConversionAccount =
. M.findWithDefault [] Conversion . M.findWithDefault [] Conversion
. jdeclaredaccounttypes . jdeclaredaccounttypes
-- Newer account type functionality. -- Newer account type code.
journalAccountType :: Journal -> AccountName -> Maybe AccountType journalAccountType :: Journal -> AccountName -> Maybe AccountType
journalAccountType Journal{jaccounttypes} = accountNameType jaccounttypes journalAccountType Journal{jaccounttypes} = accountNameType jaccounttypes
@ -553,19 +555,21 @@ 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
t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool))
-- 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, propagating
-- account types downward. Keep track of whether the account is declared -- account types downward. Keep track of whether the account is declared
-- (True), in which case the parent account should be preferred, or merely -- (True), in which case the parent account should be preferred, or merely
-- inferred (False), in which case the inferred type should be preferred. -- inferred (False), in which case the inferred type should be preferred.
t' = settypes Nothing t :: Tree (AccountName, Maybe (AccountType, Bool))
where
settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool)) settypes :: Maybe (AccountType, Bool) -> Tree AccountName -> Tree (AccountName, Maybe (AccountType, Bool))
settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs) settypes mparenttype (Node a subs) = Node (a, mtype) (map (settypes mtype) subs)
where where
mtype = M.lookup a declaredtypes <|> minferred mtype = M.lookup a declaredtypes <|> minferred
where
declaredtypes = (,True) <$> journalDeclaredAccountTypes j
minferred = if maybe False snd mparenttype minferred = if maybe False snd mparenttype
then mparenttype then mparenttype
else (,False) <$> accountNameInferType a <|> mparenttype else (,False) <$> accountNameInferType a <|> mparenttype
declaredtypes = (,True) <$> journalDeclaredAccountTypes j
-- | Build a map of the account types explicitly declared. -- | Build a map of the account types explicitly declared.
journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType