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

perhaps getting closer to a ledger-compatible balance report. A wretched, wretched thing.

Browse Source
This commit is contained in:
Simon Michael 2008-10-11 04:23:49 +00:00
parent 9b51d922dd
commit d7db5660b9
2 changed files with 161 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
BalanceCommand.hs
View File

@ -95,6 +95,27 @@ Here are some rules for account balance display, as seen 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
@ -112,64 +133,115 @@ import Utils
printbalance :: [Opt] -> [String] -> Ledger -> IO ()
printbalance opts args l = putStr $ balancereport opts args l
balancereport :: [Opt] -> [String] -> Ledger -> String
balancereport opts args l = showLedgerAccountBalances l depth
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 = parseAccountDescriptionArgs args
-- when there is no -s or pattern args, show with depth 1
depth = case (pats, showsubs) of
(([],[]), False) -> 1
pats@(apats,dpats) = parseAccountDescriptionArgs args
maxdepth = case (pats, showsubs) of
(([],[]), False) -> 1 -- with no -s or pattern, show with depth 1
otherwise -> 9999
-- | Generate balance report output for a ledger, to the specified depth.
showLedgerAccountBalances :: Ledger -> Int -> String
showLedgerAccountBalances l maxdepth =
concatMap (showAccountTree l maxdepth) acctbranches
++
if isZeroAmount total
then ""
else printf "--------------------\n%20s\n" $ showAmountRounded total
where
acctbranches = branches $ pruneZeroBalanceBranches $ ledgerAccountTree maxdepth l
filteredacctbranches = branches $ ledgerFilteredAccountTree maxdepth (acctpat l) l
total = sum $ map (abalance . root) filteredacctbranches
acctstoshow = balancereportaccts showsubs apats l
acctnames = map aname acctstoshow
treetoshow = pruneZeroBalanceLeaves $ pruneUnmatchedAccounts $ treeprune maxdepth $ ledgerAccountTree 9999 l
acctforest = subs treetoshow
-- | Remove all-zero-balance branches and leaves from a tree of accounts.
pruneZeroBalanceBranches :: Tree Account -> Tree Account
pruneZeroBalanceBranches = treefilter (not . isZeroAmount . abalance)
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
-- merge boring inner account names with the next line
| isBoringInnerAccount l maxdepth acct = subsindented 0 (fullname++":")
-- ditto with unmatched parent accounts when filtering by account
| filtering && doesnotmatch = subsindented 0 (fullname++":")
-- otherwise show this account's name & balance
| otherwise = bal ++ " " ++ indent ++ prefix ++ leafname ++ "\n" ++ (subsindented 1 "")
| isBoringParentAccount (length subaccts) (length $ subAccounts l a) maxdepth a = nextwithprefix
| otherwise = thisline ++ nextwithindent
where
acct = root t
subs = branches t
subsindented i p = concatMap (showAccountTree' l maxdepth (indentlevel+i) p) subs
bal = printf "%20s" $ show $ abalance $ acct
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) ' '
fullname = aname acct
leafname = accountLeafName fullname
fullname = aname a
filtering = filteredaccountnames l /= (accountnames l)
doesnotmatch = not (containsRegex (acctpat l) leafname)
-- | Is this account a boring inner account in this ledger ?
-- Boring inner accounts have no transactions, one subaccount,
-- and depth less than the maximum display depth.
-- Also, they are unmatched parent accounts when account matching is in effect.
isBoringInnerAccount :: Ledger -> Int -> Account -> Bool
isBoringInnerAccount l maxdepth a
-- 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
@ -177,9 +249,3 @@ isBoringInnerAccount l maxdepth a
name = aname a
depth = accountNameLevel name
numtxns = length $ atransactions a
-- how many (filter-matching) subaccounts has this account ?
numsubs = length $ subAccountNamesFrom (filteredaccountnames l) name
-- | Is the named account a boring inner account in this ledger ?
isBoringInnerAccountName :: Ledger -> Int -> AccountName -> Bool
isBoringInnerAccountName l maxdepth = isBoringInnerAccount l maxdepth . ledgerAccount l

44
Tests.hs
View File

@ -41,7 +41,7 @@ tests =
[
"display dollar amount" ~: show (dollars 1) ~?= "$1.00"
,"display time amount" ~: show (hours 1) ~?= "1.0h"
-- ,"display time amount" ~: show (hours 1) ~?= "1.0h"
,"amount precision" ~: do
let a1 = Amount (getcurrency "$") 1.23 1
@ -86,17 +86,17 @@ tests =
,"cacheLedger" ~: do
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger wildcard rawledger7 )
,"showLedgerAccounts" ~: do
assertequal 4 (length $ lines $ showLedgerAccountBalances ledger7 1)
-- ,"showLedgerAccounts" ~: do
-- assertequal 4 (length $ lines $ showLedgerAccountBalances ledger7 1)
,"ledgeramount" ~: do
assertparseequal (Amount (getcurrency "$") 47.18 2) (parsewith ledgeramount " $47.18")
assertparseequal (Amount (getcurrency "$") 1 0) (parsewith ledgeramount " $1.")
,"pruneZeroBalanceBranches" ~: do
atree <- liftM (ledgerAccountTree 99) $ ledgerfromfile "sample.ledger"
assertequal 13 (length $ flatten $ atree)
assertequal 12 (length $ flatten $ pruneZeroBalanceBranches $ atree)
-- ,"pruneZeroBalanceLeaves" ~: do
-- atree <- liftM (ledgerAccountTree 99) $ ledgerfromfile "sample.ledger"
-- assertequal 13 (length $ flatten $ atree)
-- assertequal 12 (length $ flatten $ pruneZeroBalanceLeaves $ atree)
]
balancecommandtests =
@ -130,7 +130,7 @@ balancecommandtests =
(balancereport [ShowSubs] [] l)
,
"balance report with account pattern" ~: do
"balance report with account pattern o" ~: do
rl <- rawledgerfromfile "sample.ledger"
let l = cacheLedger (mkRegex "o") $ filterRawLedgerEntries "" "" wildcard rl
assertequal
@ -142,7 +142,7 @@ balancecommandtests =
(balancereport [] ["o"] l)
,
"balance report with account pattern and showsubs" ~: do
"balance report with account pattern o and showsubs" ~: do
rl <- rawledgerfromfile "sample.ledger"
let l = cacheLedger (mkRegex "o") $ filterRawLedgerEntries "" "" wildcard rl
assertequal
@ -154,6 +154,32 @@ balancecommandtests =
\ $-1\n\
\" --"
(balancereport [ShowSubs] ["o"] l)
,
"balance report with account pattern e" ~: do
rl <- rawledgerfromfile "sample.ledger"
let l = cacheLedger (mkRegex "e") $ filterRawLedgerEntries "" "" wildcard rl
assertequal
" $-1 assets\n\
\ $2 expenses\n\
\ $1 supplies\n\
\ $-2 income\n\
\ $1 liabilities:debts\n\
\" --"
(balancereport [] ["e"] l)
-- "balance report with account pattern e and showsubs" ~: do
-- rl <- rawledgerfromfile "sample.ledger"
-- let l = cacheLedger (mkRegex "o") $ filterRawLedgerEntries "" "" wildcard rl
-- assertequal
-- " $1 expenses:food\n\
-- \ $-2 income\n\
-- \ $-1 gifts\n\
-- \ $-1 salary\n\
-- \--------------------\n\
-- \ $-1\n\
-- \" --"
-- (balancereport [ShowSubs] ["o"] l)
]
-- | Assert a parsed thing equals some expected thing, or print a parse error.