simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2025-01-04 00:07:29 +03:00
Code Issues Projects Releases Wiki Activity

a new balance report implementation that passes all tests

Browse Source
This commit is contained in:
Simon Michael 2009-03-15 11:12:29 +00:00
parent 967e125378
commit 23dcc981d7
1 changed files with 41 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
BalanceCommand.hs
View File

@ -108,7 +108,9 @@ import Ledger.Utils
import Ledger.Types import Ledger.Types
import Ledger.Amount import Ledger.Amount
import Ledger.AccountName import Ledger.AccountName
import Ledger.Transaction
import Ledger.Ledger import Ledger.Ledger
import Ledger.Parse
import Options import Options
import Utils import Utils
@ -117,134 +119,48 @@ import Utils
balance :: [Opt] -> [String] -> Ledger -> IO () balance :: [Opt] -> [String] -> Ledger -> IO ()
balance opts args l = putStr $ showBalanceReport opts args l balance opts args l = putStr $ showBalanceReport opts args l
-- | Generate balance report output for a ledger. -- | Generate a balance report with the specified options for this ledger.
showBalanceReport :: [Opt] -> [String] -> Ledger -> String showBalanceReport :: [Opt] -> [String] -> Ledger -> String
showBalanceReport opts args l = acctsstr ++ (if collapse then "" else totalstr) showBalanceReport opts args l = acctsstr ++ totalstr
where where
acctsstr = concatMap showatree $ subs t acctsstr = unlines $ map showacct interestingaccts
showatree t = showAccountTreeWithBalances matchedacctnames t
matchedacctnames = balancereportacctnames l sub apats t
t = (if empty then id else pruneZeroBalanceLeaves) $ ledgerAccountTree maxdepth l
apats = fst $ parseAccountDescriptionArgs opts args
maxdepth = fromMaybe 9999 $ depthFromOpts opts
sub = SubTotal `elem` opts || (isJust $ depthFromOpts opts)
empty = Empty `elem` opts
collapse = Collapse `elem` opts
totalstr = if isZeroMixedAmount total
then ""
else printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmount total
total = sum $ map (abalance . ledgerAccount l) $ nonredundantaccts
nonredundantaccts = filter (not . hasparentshowing) matchedacctnames
hasparentshowing aname = (parentAccountName $ aname) `elem` matchedacctnames
-- | Identify the accounts we are interested in seeing balances for in the
-- balance report, based on the -s flag and account patterns. See Tests.hs.
balancereportacctnames :: Ledger -> Bool -> [String] -> Tree Account -> [AccountName]
balancereportacctnames l False [] t = filter (/= "top") $ map aname $ flatten $ treeprune 1 t
balancereportacctnames l False pats t = filter (/= "top") $ ns
where
ns = filter (matchpats_balance pats) $ map aname $ flatten t'
t' | null $ positivepats pats = treeprune 1 t
| otherwise = t
balancereportacctnames l True pats t = nub $ map aname $ addsubaccts l $ as
where
as = map (ledgerAccount l) ns
ns = balancereportacctnames l False pats t
-- add (in tree order) any missing subaccounts to a list of accounts
addsubaccts :: Ledger -> [Account] -> [Account]
addsubaccts l as = concatMap addsubs as where addsubs = maybe [] flatten . ledgerAccountTreeAt l
-- | Remove all sub-trees whose accounts have a zero balance.
pruneZeroBalanceLeaves :: Tree Account -> Tree Account
pruneZeroBalanceLeaves = treefilter (not . isZeroMixedAmount . abalance)
-- | Show this tree of accounts with balances, eliding boring parent
-- accounts and omitting uninteresting subaccounts based on the provided
-- list of account names we want to see balances for.
showAccountTreeWithBalances :: [AccountName] -> Tree Account -> String
showAccountTreeWithBalances matchednames t = showAccountTreeWithBalances' matchednames 0 "" t
where
showAccountTreeWithBalances' :: [AccountName] -> Int -> String -> Tree Account -> String
showAccountTreeWithBalances' matchednames indent prefix (Node (Account fullname _ bal) subs)
| isboringparent && hasmatchedsubs = subsprefixed
| ismatched = this ++ subsindented
| otherwise = subsnoindent
where where
subsprefixed = showsubs indent (prefix++leafname++":") showacct = showInterestingAccount l interestingaccts
subsnoindent = showsubs indent "" interestingaccts = filter (isInteresting opts l) acctnames
subsindented = showsubs (indent+1) "" acctnames = sort $ tail $ flatten $ treemap aname accttree
showsubs i p = concatMap (showAccountTreeWithBalances' matchednames i p) subs accttree = ledgerAccountTree (depthFromOpts opts) l
hasmatchedsubs = any ((`elem` matchednames) . aname) $ concatMap flatten subs totalstr | isZeroMixedAmount total = ""
amt = padleft 20 $ showMixedAmount bal | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmount total
this = concatTopPadded [amt, spaces ++ prefix ++ leafname] ++ "\n" where
spaces = " " ++ replicate (indent * 2) ' ' total = sum $ map abalance $ topAccounts l
leafname = accountLeafName fullname
ismatched = fullname `elem` matchednames
-- XXX -- | Display one line of the balance report with appropriate indenting and eliding.
isboringparent = numsubs >= 1 && (bal == subbal || not ismatched) showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String
subbal = abalance $ root $ head subs showInterestingAccount l interestingaccts a = concatTopPadded [amt, " ", depthspacer ++ partialname]
numsubs = length subs where
{- gives: amt = padleft 20 $ showMixedAmount $ abalance $ ledgerAccount l a
### Failure in: 52:balance report elides zero-balance root account(s) -- the depth spacer (indent) is two spaces for each interesting parent
expected: "" parents = parentAccountNames a
but got: " 0 test\n" interestingparents = filter (`elem` interestingaccts) parents
Cases: 58 Tried: 58 Errors: 0 Failures: 1 depthspacer = replicate (2 * length interestingparents) ' '
Eg: -- the partial name is the account's leaf name, prefixed by the
~/src/hledger$ hledger -f sample2.ledger -s bal -- names of any boring parents immediately above
0 test partialname = accountNameFromComponents $ (reverse $ map accountLeafName ps) ++ [accountLeafName a]
$2 a:aa where ps = takeWhile boring parents where boring = not . (`elem` interestingparents)
$-2 b
~/src/hledger$ ledger -f sample2.ledger -s bal
$2 test:a:aa
$-2 test:b
-}
-- | Is the named account considered interesting for this ledger's balance report ?
isInteresting :: [Opt] -> Ledger -> AccountName -> Bool
isInteresting opts l a
| numinterestingsubs==1 && not atmaxdepth = notlikesub
| otherwise = notzero || emptyflag
where
atmaxdepth = accountNameLevel a == depthFromOpts opts
emptyflag = Empty `elem` opts
acct = ledgerAccount l a
notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct
notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumTransactions $ atransactions acct
numinterestingsubs = length $ filter isInterestingTree subtrees
where
isInterestingTree t = treeany (isInteresting opts l . aname) t
subtrees = map (fromJust . ledgerAccountTreeAt l) $ subAccounts l $ ledgerAccount l a
-- isboringparent = hassubs && (not ismatched || (bal `mixedAmountEquals` subsbal))
-- hassubs = not $ null subs
-- subsbal = sum $ map (abalance . root) subs
{- gives:
### Failure in: 37:balance report with -s
expected: " $-1 assets\n $1 bank:saving\n $-2 cash\n $2 expenses\n $1 food\n $1 supplies\n $-2 income\n $-1 gifts\n $-1 salary\n $1 liabilities:debts\n"
but got: " $1 assets:bank:saving\n $-2 assets:cash\n $1 expenses:food\n $1 expenses:supplies\n $-1 income:gifts\n $-1 income:salary\n $1 liabilities:debts\n"
### Failure in: 39:balance report --depth activates -s
expected: " $-1 assets\n $1 bank\n $-2 cash\n $2 expenses\n $1 food\n $1 supplies\n $-2 income\n $-1 gifts\n $-1 salary\n $1 liabilities:debts\n"
but got: " $1 assets:bank\n $-2 assets:cash\n $1 expenses:food\n $1 expenses:supplies\n $-1 income:gifts\n $-1 income:salary\n $1 liabilities:debts\n"
### Failure in: 41:balance report with account pattern o and -s
expected: " $1 expenses:food\n $-2 income\n $-1 gifts\n $-1 salary\n--------------------\n $-1\n"
but got: " $1 expenses:food\n $-1 income:gifts\n $-1 income:salary\n--------------------\n $-1\n"
### Failure in: 42:balance report with account pattern a
expected: " $-1 assets\n $1 bank:saving\n $-2 cash\n $-1 income:salary\n $1 liabilities\n--------------------\n $-1\n"
but got: " $1 assets:bank:saving\n $-2 assets:cash\n $-1 income:salary\n $1 liabilities\n--------------------\n $-1\n"
### Failure in: 43:balance report with account pattern e
expected: " $-1 assets\n $2 expenses\n $1 supplies\n $-2 income\n $1 liabilities:debts\n"
but got: " $-1 assets\n $1 expenses:supplies\n $-2 income\n $1 liabilities:debts\n"
### Failure in: 49:balance report with -E shows zero-balance accounts
expected: " $-1 assets\n $1 bank\n $0 checking\n $1 saving\n $-2 cash\n--------------------\n $-1\n"
but got: " $0 assets:bank:checking\n $1 assets:bank:saving\n $-2 assets:cash\n--------------------\n $-1\n"
### Failure in: 52:balance report elides zero-balance root account(s)
expected: ""
but got: " 0 test\n"
Cases: 58 Tried: 58 Errors: 0 Failures: 7
Eg:
~/src/hledger$ hledger -f sample.ledger -s bal
$1 assets:bank:saving
$-2 assets:cash
$1 expenses:food
$1 expenses:supplies
$-1 income:gifts
$-1 income:salary
$1 liabilities:debts
~/src/hledger$ ledger -f sample.ledger -s bal
$-1 assets
$1 bank:saving
$-2 cash
$2 expenses
$1 food
$1 supplies
$-2 income
$-1 gifts
$-1 salary
$1 liabilities:debts
-}