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) | ||||
| -- and transactions (not including sub-accounts) | ||||
| -- and transactions (excluding sub-accounts) | ||||
| data Account = Account { | ||||
|       aname :: AccountName,  | ||||
|       atransactions :: [EntryTransaction], | ||||
| @ -24,13 +24,15 @@ instance Show Account where | ||||
| 
 | ||||
| nullacct = Account "" [] nullamt | ||||
| 
 | ||||
| mkAccount :: Ledger -> AccountName -> Account | ||||
| mkAccount l a =  | ||||
| ledgerAccount :: Ledger -> AccountName -> Account | ||||
| ledgerAccount l a =  | ||||
|     Account  | ||||
|     a  | ||||
|     (transactionsInAccountNamed l a)  | ||||
|     (aggregateBalanceInAccountNamed l a) | ||||
| 
 | ||||
| -- queries | ||||
| 
 | ||||
| balanceInAccountNamed :: Ledger -> AccountName -> Amount | ||||
| balanceInAccountNamed l a =  | ||||
|     sumEntryTransactions (transactionsInAccountNamed l a) | ||||
| @ -47,64 +49,58 @@ aggregateTransactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransactio | ||||
| aggregateTransactionsInAccountNamed l a =  | ||||
|     ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l | ||||
| 
 | ||||
| -- a tree of Accounts | ||||
| 
 | ||||
| -- build a tree of Accounts | ||||
| addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account | ||||
| addDataToAccountNameTree l ant =  | ||||
|     Node  | ||||
|     (mkAccount l $ root ant)  | ||||
|     (ledgerAccount l $ root ant)  | ||||
|     (map (addDataToAccountNameTree l) $ branches ant) | ||||
| 
 | ||||
| -- would be straightforward except we want to elide boring accounts when | ||||
| -- displaying account trees: | ||||
| -- a (0 txns, only 1 subacct) | ||||
| --   b (another boring acct.) | ||||
| --     c | ||||
| --       d | ||||
| -- becomes: | ||||
| -- a:b:c | ||||
| --   d | ||||
| showAccountTree :: Ledger -> Int -> Int -> Tree Account -> String | ||||
| showAccountTree _ 0 _ _ = "" | ||||
| showAccountTree l maxdepth indentlevel t | ||||
|     -- if this acct is boring, don't show it (unless this is as deep as we're going) | ||||
| --     | (boringacct && (maxdepth > 1)) = subacctsindented 0 | ||||
| -- balance report support | ||||
| -- | ||||
| -- some examples, ignoring the issue of eliding boring accounts | ||||
| -- here is a 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 | ||||
| 
 | ||||
|     -- otherwise show normal indented account name with balance | ||||
|     -- if this acct has one or more boring parents, prepend their names | ||||
|     | otherwise =  | ||||
|         bal ++ "  " ++ indent ++ parentnames ++ leafname ++ "\n" ++ (subacctsindented 1) | ||||
| 
 | ||||
|     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 | ||||
| showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String | ||||
| showLedgerAccounts l acctpats showsubs maxdepth =  | ||||
|     concatMap  | ||||
|     (showAccountTree l)  | ||||
|     (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) | ||||
| 
 | ||||
| ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account | ||||
| ledgerAccountTreeMatching l [] showsubs maxdepth =  | ||||
| @ -114,8 +110,65 @@ ledgerAccountTreeMatching l acctpats showsubs maxdepth = | ||||
|     filterAccountNameTree acctpats showsubs maxdepth $  | ||||
|     ledgerAccountNameTree l | ||||
| 
 | ||||
| showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String | ||||
| showLedgerAccounts l acctpats showsubs maxdepth =  | ||||
|     concatMap  | ||||
|     (showAccountTree l 999 0)  | ||||
|     (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) | ||||
| -- when displaying an account tree, we elide boring accounts. | ||||
| -- 1. leaf accounts and branches with 0 balance or 0 transactions are omitted | ||||
| -- 2. inner accounts with 0 transactions and 1 subaccount are displayed as | ||||
| --    a prefix of the sub | ||||
| -- | ||||
| -- 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] | ||||
|           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 pats keepsubs maxdepth = | ||||
|     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. | ||||
|  refactor apis | ||||
| 
 | ||||
| 
 | ||||
| 
 | ||||
| speed | ||||
|  profile, refactor, optimize | ||||
| 
 | ||||
| basic features | ||||
|  , in thousands | ||||
|  -f - | ||||
|  print | ||||
|  -j and -J graph data output | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user