balance: elide boring accounts properly, cleanup
This commit is contained in:
		
							parent
							
								
									ee8ac17909
								
							
						
					
					
						commit
						de4dd43007
					
				
							
								
								
									
										173
									
								
								Account.hs
									
									
									
									
									
								
							
							
						
						
									
										173
									
								
								Account.hs
									
									
									
									
									
								
							| @ -12,7 +12,7 @@ import Ledger | |||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| -- an Account caches an account's name, balance (including sub-accounts) | -- an Account caches an account's name, balance (including sub-accounts) | ||||||
| -- and transactions (not including sub-accounts) | -- and transactions (excluding sub-accounts) | ||||||
| data Account = Account { | data Account = Account { | ||||||
|       aname :: AccountName,  |       aname :: AccountName,  | ||||||
|       atransactions :: [EntryTransaction], |       atransactions :: [EntryTransaction], | ||||||
| @ -24,13 +24,15 @@ instance Show Account where | |||||||
| 
 | 
 | ||||||
| nullacct = Account "" [] nullamt | nullacct = Account "" [] nullamt | ||||||
| 
 | 
 | ||||||
| mkAccount :: Ledger -> AccountName -> Account | ledgerAccount :: Ledger -> AccountName -> Account | ||||||
| mkAccount l a =  | ledgerAccount l a =  | ||||||
|     Account  |     Account  | ||||||
|     a  |     a  | ||||||
|     (transactionsInAccountNamed l a)  |     (transactionsInAccountNamed l a)  | ||||||
|     (aggregateBalanceInAccountNamed l a) |     (aggregateBalanceInAccountNamed l a) | ||||||
| 
 | 
 | ||||||
|  | -- queries | ||||||
|  | 
 | ||||||
| balanceInAccountNamed :: Ledger -> AccountName -> Amount | balanceInAccountNamed :: Ledger -> AccountName -> Amount | ||||||
| balanceInAccountNamed l a =  | balanceInAccountNamed l a =  | ||||||
|     sumEntryTransactions (transactionsInAccountNamed l a) |     sumEntryTransactions (transactionsInAccountNamed l a) | ||||||
| @ -47,64 +49,58 @@ aggregateTransactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransactio | |||||||
| aggregateTransactionsInAccountNamed l a =  | aggregateTransactionsInAccountNamed l a =  | ||||||
|     ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l |     ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l | ||||||
| 
 | 
 | ||||||
| -- a tree of Accounts | -- build a tree of Accounts | ||||||
| 
 |  | ||||||
| addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account | addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account | ||||||
| addDataToAccountNameTree l ant =  | addDataToAccountNameTree l ant =  | ||||||
|     Node  |     Node  | ||||||
|     (mkAccount l $ root ant)  |     (ledgerAccount l $ root ant)  | ||||||
|     (map (addDataToAccountNameTree l) $ branches ant) |     (map (addDataToAccountNameTree l) $ branches ant) | ||||||
| 
 | 
 | ||||||
| -- would be straightforward except we want to elide boring accounts when | -- balance report support | ||||||
| -- displaying account trees: | -- | ||||||
| -- a (0 txns, only 1 subacct) | -- some examples, ignoring the issue of eliding boring accounts | ||||||
| --   b (another boring acct.) | -- here is a sample account tree: | ||||||
| --     c | -- | ||||||
| --       d | -- assets | ||||||
| -- becomes: | --  cash | ||||||
| -- a:b:c | --  checking | ||||||
| --   d | --  saving | ||||||
| showAccountTree :: Ledger -> Int -> Int -> Tree Account -> String | -- equity | ||||||
| showAccountTree _ 0 _ _ = "" | -- expenses | ||||||
| showAccountTree l maxdepth indentlevel t | --  food | ||||||
|     -- if this acct is boring, don't show it (unless this is as deep as we're going) | --  shelter | ||||||
| --     | (boringacct && (maxdepth > 1)) = subacctsindented 0 | -- income | ||||||
|  | --  salary | ||||||
|  | -- liabilities | ||||||
|  | --  debts | ||||||
|  | -- | ||||||
|  | -- standard balance command shows all top-level accounts: | ||||||
|  | -- | ||||||
|  | -- > ledger bal | ||||||
|  | -- $ assets       | ||||||
|  | -- $ equity | ||||||
|  | -- $ expenses     | ||||||
|  | -- $ income       | ||||||
|  | -- $ liabilities  | ||||||
|  | -- | ||||||
|  | -- with an account pattern, show only the ones with matching names: | ||||||
|  | -- | ||||||
|  | -- > ledger bal asset | ||||||
|  | -- $ assets       | ||||||
|  | -- | ||||||
|  | -- with -s, show all subaccounts of matched accounts: | ||||||
|  | -- | ||||||
|  | -- > ledger -s bal asset | ||||||
|  | -- $ assets       | ||||||
|  | -- $  cash        | ||||||
|  | -- $  checking    | ||||||
|  | -- $  saving | ||||||
| 
 | 
 | ||||||
|     -- otherwise show normal indented account name with balance | showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String | ||||||
|     -- if this acct has one or more boring parents, prepend their names | showLedgerAccounts l acctpats showsubs maxdepth =  | ||||||
|     | otherwise =  |     concatMap  | ||||||
|         bal ++ "  " ++ indent ++ parentnames ++ leafname ++ "\n" ++ (subacctsindented 1) |     (showAccountTree l)  | ||||||
| 
 |     (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) | ||||||
|     where |  | ||||||
|       boringacct = isBoringAccount2 l name |  | ||||||
|       boringparents = takeWhile (isBoringAccount2 l) $ parentAccountNames name |  | ||||||
|       bal = printf "%20s" $ show $ abalance $ root t |  | ||||||
|       indent = replicate (indentlevel * 2) ' ' |  | ||||||
|       parentnames = concatMap (++ ":") $ map accountLeafName boringparents |  | ||||||
|       leafname = accountLeafName name |  | ||||||
|       name = aname $ root t |  | ||||||
|       subacctsindented i =  |  | ||||||
|           case maxdepth > 1 of |  | ||||||
|             True -> concatMap (showAccountTree l (maxdepth-1) (indentlevel+i)) $ branches t |  | ||||||
|             False -> "" |  | ||||||
| 
 |  | ||||||
| isBoringAccount :: Tree Account -> Bool |  | ||||||
| isBoringAccount at =  |  | ||||||
|     (length txns == 0) && ((length subaccts) == 1) && (not $ name == "top") |  | ||||||
|         where |  | ||||||
|           a = root at |  | ||||||
|           name = aname a |  | ||||||
|           txns = atransactions a |  | ||||||
|           subaccts = branches at |  | ||||||
| 
 |  | ||||||
| isBoringAccount2 :: Ledger -> AccountName -> Bool |  | ||||||
| isBoringAccount2 l a |  | ||||||
|     | a == "top" = False |  | ||||||
|     | (length txns == 0) && ((length subs) == 1) = True |  | ||||||
|     | otherwise = False |  | ||||||
|     where |  | ||||||
|       txns = transactionsInAccountNamed l a |  | ||||||
|       subs = subAccountNamesFrom (ledgerAccountNames l) a |  | ||||||
| 
 | 
 | ||||||
| ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account | ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account | ||||||
| ledgerAccountTreeMatching l [] showsubs maxdepth =  | ledgerAccountTreeMatching l [] showsubs maxdepth =  | ||||||
| @ -114,8 +110,65 @@ ledgerAccountTreeMatching l acctpats showsubs maxdepth = | |||||||
|     filterAccountNameTree acctpats showsubs maxdepth $  |     filterAccountNameTree acctpats showsubs maxdepth $  | ||||||
|     ledgerAccountNameTree l |     ledgerAccountNameTree l | ||||||
| 
 | 
 | ||||||
| showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String | -- when displaying an account tree, we elide boring accounts. | ||||||
| showLedgerAccounts l acctpats showsubs maxdepth =  | -- 1. leaf accounts and branches with 0 balance or 0 transactions are omitted | ||||||
|     concatMap  | -- 2. inner accounts with 0 transactions and 1 subaccount are displayed as | ||||||
|     (showAccountTree l 999 0)  | --    a prefix of the sub | ||||||
|     (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) | -- | ||||||
|  | -- so, for example: | ||||||
|  | -- | ||||||
|  | -- a (0 txns) | ||||||
|  | --   b (0 txns) | ||||||
|  | --     c | ||||||
|  | --       d | ||||||
|  | -- e (0 txns) | ||||||
|  | --   f | ||||||
|  | --   g | ||||||
|  | -- h (0 txns) | ||||||
|  | --   i (0 balance) | ||||||
|  | -- | ||||||
|  | -- displays as: | ||||||
|  | -- | ||||||
|  | -- a:b:c | ||||||
|  | --   d | ||||||
|  | -- e | ||||||
|  | --   f | ||||||
|  | --   g | ||||||
|  | showAccountTree :: Ledger -> Tree Account -> String | ||||||
|  | showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom | ||||||
|  |      | ||||||
|  | interestingAccountsFrom :: Tree Account -> Tree Account | ||||||
|  | interestingAccountsFrom = | ||||||
|  |     treefilter hastxns . treefilter hasbalance | ||||||
|  |     where  | ||||||
|  |       hasbalance = (/= 0) . abalance | ||||||
|  |       hastxns = (> 0) . length . atransactions | ||||||
|  | 
 | ||||||
|  | showAccountTree' l indentlevel t | ||||||
|  |     -- if this acct is boring, don't show it (unless this is as deep as we're going) | ||||||
|  |     | isBoringAccount l name = subacctsindented 0 | ||||||
|  | 
 | ||||||
|  |     -- otherwise show normal indented account name with balance | ||||||
|  |     -- if this acct has one or more boring parents, prepend their names | ||||||
|  |     | otherwise =  | ||||||
|  |         bal ++ "  " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subacctsindented 1) | ||||||
|  | 
 | ||||||
|  |     where | ||||||
|  |       subacctsindented i =  | ||||||
|  |           concatMap (showAccountTree' l (indentlevel+i)) $ branches t | ||||||
|  |       bal = printf "%20s" $ show $ abalance $ root t | ||||||
|  |       indent = replicate (indentlevel * 2) ' ' | ||||||
|  |       prefix = concatMap (++ ":") $ map accountLeafName boringparents | ||||||
|  |       boringparents = takeWhile (isBoringAccount l) $ parentAccountNames name | ||||||
|  |       leafname = accountLeafName name | ||||||
|  |       name = aname $ root t | ||||||
|  | 
 | ||||||
|  | isBoringAccount :: Ledger -> AccountName -> Bool | ||||||
|  | isBoringAccount l a | ||||||
|  |     | a == "top" = False | ||||||
|  |     | (length txns == 0) && ((length subs) == 1) = True | ||||||
|  |     | otherwise = False | ||||||
|  |     where | ||||||
|  |       txns = transactionsInAccountNamed l a | ||||||
|  |       subs = subAccountNamesFrom (ledgerAccountNames l) a | ||||||
|  | 
 | ||||||
|  | |||||||
| @ -76,12 +76,6 @@ accountNameTreeFrom accts = | |||||||
|           accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as] |           accountsFrom as = [Node a (accountsFrom $ subs a) | a <- as] | ||||||
|           subs = (subAccountNamesFrom accts) |           subs = (subAccountNamesFrom accts) | ||||||
| 
 | 
 | ||||||
| showAccountNameTree :: Tree AccountName -> String |  | ||||||
| showAccountNameTree t = |  | ||||||
|     topacct  ++ "\n" ++ concatMap showAccountNameTree (branches t) |  | ||||||
|         where |  | ||||||
|           topacct = indentAccountName 0 $ root t |  | ||||||
| 
 |  | ||||||
| filterAccountNameTree :: [String] -> Bool -> Int -> Tree AccountName -> Tree AccountName | filterAccountNameTree :: [String] -> Bool -> Int -> Tree AccountName -> Tree AccountName | ||||||
| filterAccountNameTree pats keepsubs maxdepth = | filterAccountNameTree pats keepsubs maxdepth = | ||||||
|     treefilter (\a -> matchpats a || (keepsubs && issubofmatch a)) . |     treefilter (\a -> matchpats a || (keepsubs && issubofmatch a)) . | ||||||
|  | |||||||
							
								
								
									
										93
									
								
								TODO
									
									
									
									
									
								
							
							
						
						
									
										93
									
								
								TODO
									
									
									
									
									
								
							| @ -1,102 +1,11 @@ | |||||||
| * feature: balance report account matching |  | ||||||
| 
 |  | ||||||
| sample account tree: |  | ||||||
| 
 |  | ||||||
| assets |  | ||||||
|  cash |  | ||||||
|  checking |  | ||||||
|  saving |  | ||||||
| equity |  | ||||||
| expenses |  | ||||||
|  food |  | ||||||
|  shelter |  | ||||||
| income |  | ||||||
|  salary |  | ||||||
| liabilities |  | ||||||
|  debts |  | ||||||
| 
 |  | ||||||
| standard balance command shows all top-level accounts: |  | ||||||
| 
 |  | ||||||
| > ledger bal |  | ||||||
| $ assets       |  | ||||||
| $ equity |  | ||||||
| $ expenses     |  | ||||||
| $ income       |  | ||||||
| $ liabilities  |  | ||||||
| 
 |  | ||||||
| with an account pattern, show only the ones with matching names: |  | ||||||
| 
 |  | ||||||
| > ledger bal asset |  | ||||||
| $ assets       |  | ||||||
| 
 |  | ||||||
| with -s, show all subaccounts of matched accounts: |  | ||||||
| 
 |  | ||||||
| > ledger -s bal asset |  | ||||||
| $ assets       |  | ||||||
| $  cash        |  | ||||||
| $  checking    |  | ||||||
| $  saving |  | ||||||
| 
 |  | ||||||
| again: |  | ||||||
| 
 |  | ||||||
| > ledger bal a |  | ||||||
| $ assets       |  | ||||||
| $  cash        |  | ||||||
| $  saving |  | ||||||
| $ income       |  | ||||||
| $  salary      |  | ||||||
| $ liabilities  |  | ||||||
| 
 |  | ||||||
| and including subaccounts: |  | ||||||
| 
 |  | ||||||
| > ledger -s bal a |  | ||||||
| $ assets       |  | ||||||
| $  cash        |  | ||||||
| $  checking    |  | ||||||
| $  saving |  | ||||||
| $ income       |  | ||||||
| $  salary      |  | ||||||
| $ liabilities  |  | ||||||
| $  debts |  | ||||||
| 
 |  | ||||||
| but also, elide boring accounts whenever possible, so if savings is 0 and |  | ||||||
| income/liabilities have no transactions the above would be displayed as: |  | ||||||
| 
 |  | ||||||
| > ledger -s bal a |  | ||||||
| $ assets       |  | ||||||
| $  cash        |  | ||||||
| $  checking    |  | ||||||
| $ income:salary |  | ||||||
| $ liabilities:debts |  | ||||||
| 
 |  | ||||||
| algorithm: |  | ||||||
| 
 |  | ||||||
| 1 filter account tree by name, keeping any necessary parents |  | ||||||
| 2 add subaccounts if -s |  | ||||||
| 3 display account tree, eliding boring accounts |  | ||||||
| 
 |  | ||||||
| elide boring accounts |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| optimization: add CookedLedger caching acct txns, boring status etc. | optimization: add CookedLedger caching acct txns, boring status etc. | ||||||
|  refactor apis |  refactor apis | ||||||
| 
 | 
 | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| speed | speed | ||||||
|  profile, refactor, optimize |  profile, refactor, optimize | ||||||
| 
 | 
 | ||||||
| basic features | basic features | ||||||
|  |  , in thousands | ||||||
|  -f - |  -f - | ||||||
|  print |  print | ||||||
|  -j and -J graph data output |  -j and -J graph data output | ||||||
|  | |||||||
							
								
								
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -125,6 +125,10 @@ ledger7_str = "\ | |||||||
| \    assets:cash                                $4.82\n\ | \    assets:cash                                $4.82\n\ | ||||||
| \    equity:opening balances                         \n\ | \    equity:opening balances                         \n\ | ||||||
| \\n\ | \\n\ | ||||||
|  | \2007/01/01 * opening balance\n\ | ||||||
|  | \    income:interest                                $-4.82\n\ | ||||||
|  | \    equity:opening balances                         \n\ | ||||||
|  | \\n\ | ||||||
| \2007/01/02 * ayres suites\n\ | \2007/01/02 * ayres suites\n\ | ||||||
| \    expenses:vacation                        $179.92\n\ | \    expenses:vacation                        $179.92\n\ | ||||||
| \    assets:checking                                 \n\ | \    assets:checking                                 \n\ | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user