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