252 lines
8.5 KiB
Haskell
252 lines
8.5 KiB
Haskell
{-|
|
|
|
|
A ledger-compatible @balance@ command. Here's how it should work:
|
|
|
|
A sample account tree (as in the sample.ledger file):
|
|
|
|
@
|
|
assets
|
|
cash
|
|
checking
|
|
saving
|
|
expenses
|
|
food
|
|
supplies
|
|
income
|
|
gifts
|
|
salary
|
|
liabilities
|
|
debts
|
|
@
|
|
|
|
The balance command shows top-level accounts by default:
|
|
|
|
@
|
|
\> ledger balance
|
|
$-1 assets
|
|
$2 expenses
|
|
$-2 income
|
|
$1 liabilities
|
|
@
|
|
|
|
With -s (--showsubs), also show the subaccounts:
|
|
|
|
@
|
|
$-1 assets
|
|
$-2 cash
|
|
$1 saving
|
|
$2 expenses
|
|
$1 food
|
|
$1 supplies
|
|
$-2 income
|
|
$-1 gifts
|
|
$-1 salary
|
|
$1 liabilities:debts
|
|
@
|
|
|
|
- @checking@ is not shown because it has a zero balance and no interesting
|
|
subaccounts.
|
|
|
|
- @liabilities@ is displayed only as a prefix because it has no transactions
|
|
of its own and only one subaccount.
|
|
|
|
With an account pattern, show only the accounts with matching names:
|
|
|
|
@
|
|
\> ledger balance o
|
|
$1 expenses:food
|
|
$-2 income
|
|
--------------------
|
|
$-1
|
|
@
|
|
|
|
- The o matched @food@ and @income@, so they are shown.
|
|
|
|
- Parents of matched accounts are also shown for context (@expenses@).
|
|
|
|
- This time the grand total is also shown, because it is not zero.
|
|
|
|
Again, -s adds the subaccounts:
|
|
|
|
@
|
|
\> ledger -s balance o
|
|
$1 expenses:food
|
|
$-2 income
|
|
$-1 gifts
|
|
$-1 salary
|
|
--------------------
|
|
$-1
|
|
@
|
|
|
|
- @food@ has no subaccounts. @income@ has two, so they are shown.
|
|
|
|
- We do not add the subaccounts of parents included for context (@expenses@).
|
|
|
|
Here are some rules for account balance display, as seen above:
|
|
|
|
- grand total is omitted if it is 0
|
|
|
|
- leaf accounts and branches with 0 balance or 0 transactions are omitted
|
|
|
|
- inner accounts with 0 transactions and 1 subaccount are displayed inline
|
|
|
|
- in a filtered report, matched accounts are displayed with their parents
|
|
inline (a consequence of the above)
|
|
|
|
- in a showsubs report, all subaccounts of matched accounts are displayed
|
|
|
|
-}
|
|
{-
|
|
let's start over:
|
|
|
|
a simple balance report lists top-level non-boring accounts, with their aggregated balances, followed by the total
|
|
|
|
a balance report with showsubs lists all non-boring accounts, with their aggregated balances, followed by the total
|
|
|
|
a filtered balance report lists non-boring accounts whose leafname matches the filter, with their aggregated balances, followed by the total
|
|
|
|
a filtered balance report with showsubs lists non-boring accounts whose leafname matches the filter, plus their subaccounts, with their aggregated balances, followed by the total
|
|
|
|
the total is the sum of the aggregated balances shown, excluding subaccounts whose parent's balance is shown. If the total is zero it is not shown.
|
|
|
|
boring accounts are
|
|
- leaf accounts with zero balance; these are never shown
|
|
- non-matched parent accounts of matched accounts, when filtering; these are shown inline
|
|
- parent accounts with no transactions of their own and a single subaccount; these are shown inline
|
|
|
|
maxdepth may affect this further
|
|
|
|
-}
|
|
|
|
module BalanceCommand
|
|
where
|
|
import Ledger.Utils
|
|
import Ledger.Types
|
|
import Ledger.Amount
|
|
import Ledger.AccountName
|
|
import Ledger.Ledger
|
|
import Options
|
|
import Utils
|
|
|
|
|
|
-- | Print a balance report.
|
|
printbalance :: [Opt] -> [String] -> Ledger -> IO ()
|
|
printbalance opts args l = putStr $ balancereport opts args l
|
|
|
|
balancereport = balancereport1
|
|
|
|
-- | List the accounts for which we should show balances in the balance
|
|
-- report, based on the options.
|
|
balancereportaccts :: Bool -> [String] -> Ledger -> [Account]
|
|
balancereportaccts False [] l = topAccounts l
|
|
balancereportaccts False pats l = accountsMatching (regexFor pats) l
|
|
balancereportaccts True pats l = addsubaccts l $ balancereportaccts False pats l
|
|
|
|
-- | Add (in tree order) any missing subacccounts to a list of accounts.
|
|
addsubaccts l as = concatMap addsubs as where addsubs = maybe [] flatten . ledgerAccountTreeAt l
|
|
|
|
balancereport2 :: [Opt] -> [String] -> Ledger -> String
|
|
balancereport2 opts args l = acctsstr ++ totalstr
|
|
where
|
|
accts = balancereportaccts (ShowSubs `elem` opts) args l
|
|
showacct a =
|
|
bal ++ " " ++ indent ++ prefix ++ fullname ++ "\n"
|
|
where
|
|
bal = printf "%20s" $ show $ abalance a
|
|
indentlevel = 0
|
|
prefix = ""
|
|
indent = replicate (indentlevel * 2) ' '
|
|
fullname = aname a
|
|
leafname = accountLeafName fullname
|
|
acctsstr = concatMap showacct accts
|
|
total = sumAmounts $ map abalance $ removeduplicatebalances accts
|
|
removeduplicatebalances as = filter (not . hasparentshowing) as
|
|
where
|
|
hasparentshowing a = (parentAccountName $ aname a) `elem` names
|
|
names = map aname as
|
|
totalstr
|
|
| isZeroAmount total = ""
|
|
| otherwise = printf "--------------------\n%20s\n" $ showAmountRounded total
|
|
|
|
-- | Generate balance report output for a ledger.
|
|
balancereport1 :: [Opt] -> [String] -> Ledger -> String
|
|
balancereport1 opts args l = acctsstr ++ totalstr
|
|
where
|
|
showsubs = (ShowSubs `elem` opts)
|
|
pats@(apats,dpats) = parseAccountDescriptionArgs args
|
|
maxdepth = case (pats, showsubs) of
|
|
(([],[]), False) -> 1 -- with no -s or pattern, show with depth 1
|
|
otherwise -> 9999
|
|
|
|
acctstoshow = balancereportaccts showsubs apats l
|
|
acctnames = map aname acctstoshow
|
|
treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l
|
|
acctforest = subs treetoshow
|
|
|
|
acctsstr = concatMap (showAccountTree l maxdepth) acctforest
|
|
|
|
totalstr
|
|
| isZeroAmount total = ""
|
|
| otherwise = printf "--------------------\n%20s\n" $ showAmountRounded total
|
|
total = sumAmounts $ map abalance $ nonredundantaccts
|
|
nonredundantaccts = filter (not . hasparentshowing) acctstoshow
|
|
hasparentshowing a = (parentAccountName $ aname a) `elem` acctnames
|
|
|
|
-- remove any accounts from the tree which are not one of the acctstoshow,
|
|
-- or one of their parents, or one of their subaccounts when doing showsubs
|
|
pruneUnmatchedAccounts :: Tree Account -> Tree Account
|
|
pruneUnmatchedAccounts = treefilter matched
|
|
where
|
|
matched :: Account -> Bool
|
|
matched (Account name _ _)
|
|
| name `elem` acctnames = True
|
|
| any (name `isAccountNamePrefixOf`) acctnames = True
|
|
| showsubs && any (`isAccountNamePrefixOf` name) acctnames = True
|
|
| otherwise = False
|
|
|
|
-- remove all zero-balance leaf accounts (recursively)
|
|
pruneZeroBalanceLeaves :: Tree Account -> Tree Account
|
|
pruneZeroBalanceLeaves = treefilter (not . isZeroAmount . abalance)
|
|
|
|
-- | Get the string representation of a tree of accounts.
|
|
-- The ledger from which the accounts come is required so that
|
|
-- we can check for boring accounts.
|
|
showAccountTree :: Ledger -> Int -> Tree Account -> String
|
|
showAccountTree l maxdepth = showAccountTree' l maxdepth 0 ""
|
|
where
|
|
showAccountTree' :: Ledger -> Int -> Int -> String -> Tree Account -> String
|
|
showAccountTree' l maxdepth indentlevel prefix t
|
|
|
|
| isBoringParentAccount (length subaccts) (length $ subAccounts l a) maxdepth a = nextwithprefix
|
|
| otherwise = thisline ++ nextwithindent
|
|
|
|
where
|
|
a = root t
|
|
subaccts = subs t
|
|
nextwithprefix = showsubs 0 (fullname++":")
|
|
nextwithindent = showsubs 1 ""
|
|
showsubs i p = concatMap (showAccountTree' l maxdepth (indentlevel+i) p) subaccts
|
|
thisline = bal ++ " " ++ indent ++ prefix ++ leafname ++ "\n"
|
|
|
|
bal = printf "%20s" $ show $ abalance $ a
|
|
indent = replicate (indentlevel * 2) ' '
|
|
leafname = accountLeafName fullname
|
|
fullname = aname a
|
|
filtering = filteredaccountnames l /= (accountnames l)
|
|
doesnotmatch = not (containsRegex (acctpat l) leafname)
|
|
|
|
-- Boring parent accounts have the same balance as their
|
|
-- single child. In other words they have exactly one child
|
|
-- (which we may not be showing) and no transactions. Also
|
|
-- their depth is less than the maximum display depth.
|
|
-- ..or some such thing..
|
|
--isBoringParentAccount :: Int -> Int -> Account -> Bool
|
|
isBoringParentAccount numsubs realnumsubs maxdepth a
|
|
| name == "top" = False
|
|
| depth < maxdepth && numtxns == 0 && numsubs == 1 = True
|
|
| otherwise = False
|
|
where
|
|
name = aname a
|
|
depth = accountNameLevel name
|
|
numtxns = length $ atransactions a
|