From a1d10691a3b2c495a2df08b68b7c29ad9efdeb5c Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 18 Oct 2008 02:43:13 +0000 Subject: [PATCH] more code cleanups --- BalanceCommand.hs | 23 +++++++++++----------- Ledger/Entry.hs | 18 ----------------- RegisterCommand.hs | 49 +++++++++++++++++++++++++++------------------- Tests.hs | 2 +- 4 files changed, 42 insertions(+), 50 deletions(-) diff --git a/BalanceCommand.hs b/BalanceCommand.hs index 102128b7c..2adde5206 100644 --- a/BalanceCommand.hs +++ b/BalanceCommand.hs @@ -164,21 +164,22 @@ showBalanceReport opts args l = acctsstr ++ totalstr -- eliding boring parent accounts. Requires a list of the account names we -- are interested in to help with that. showAccountTreeWithBalances :: [AccountName] -> Tree Account -> String -showAccountTreeWithBalances matchedacctnames = - showAccountTreeWithBalances' matchedacctnames 0 "" +showAccountTreeWithBalances matchednames = + showAccountTreeWithBalances' matchednames 0 "" where showAccountTreeWithBalances' :: [AccountName] -> Int -> String -> Tree Account -> String - showAccountTreeWithBalances' matchedacctnames indentlevel prefix (Node (Account fullname _ bal) subs) = - if isboringparent then showsubswithprefix else showacct ++ showsubswithindent + showAccountTreeWithBalances' matchednames indent prefix (Node (Account fullname _ bal) subs) + | not isboringparent = this ++ subswithindent + | otherwise = subswithprefix where - showsubswithprefix = showsubs indentlevel (prefix++leafname++":") - showsubswithindent = showsubs (indentlevel+1) "" - showsubs i p = concatMap (showAccountTreeWithBalances' matchedacctnames i p) subs - showacct = showbal ++ " " ++ indent ++ prefix ++ leafname ++ "\n" + subswithindent = showsubs (indent+1) "" + subswithprefix = showsubs indent (prefix++leafname++":") + showsubs i p = concatMap (showAccountTreeWithBalances' matchednames i p) subs + this = showbal ++ spaces ++ prefix ++ leafname ++ "\n" showbal = printf "%20s" $ show bal - indent = replicate (indentlevel * 2) ' ' + spaces = " " ++ replicate (indent * 2) ' ' leafname = accountLeafName fullname + isboringparent = numsubs >= 1 && (bal == subbal || not matched) numsubs = length subs subbal = abalance $ root $ head subs - matched = fullname `elem` matchedacctnames - isboringparent = numsubs >= 1 && (bal == subbal || not matched) + matched = fullname `elem` matchednames diff --git a/Ledger/Entry.hs b/Ledger/Entry.hs index 99e7769eb..75ce754b0 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -15,24 +15,6 @@ import Ledger.Amount instance Show Entry where show = showEntry -{- -Helpers for the register report. A register entry is displayed as two -or more lines like this: - -@ -date description account amount balance -DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA - aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA - ... ... ... - -datewidth = 10 -descwidth = 20 -acctwidth = 22 -amtwidth = 11 -balwidth = 12 -@ --} - showEntryDescription e = (showDate $ edate e) ++ " " ++ (showDescription $ edescription e) ++ " " showDate d = printf "%-10s" d diff --git a/RegisterCommand.hs b/RegisterCommand.hs index 4bd35a04b..fac39b914 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -12,27 +12,36 @@ import Options -- | Print a register report. register :: [Opt] -> [String] -> Ledger -> IO () -register opts args l = putStr $ showTransactionsWithBalances opts args l +register opts args l = putStr $ showRegisterReport opts args l -showTransactionsWithBalances :: [Opt] -> [String] -> Ledger -> String -showTransactionsWithBalances opts args l = - unlines $ showTransactionsWithBalances' ts nulltxn startingbalance - where - ts = filter matchtxn $ ledgerTransactions l - matchtxn (Transaction _ _ desc acct _ _) = matchLedgerPatterns False apats acct - apats = fst $ parseAccountDescriptionArgs args - startingbalance = nullamt - showTransactionsWithBalances' :: [Transaction] -> Transaction -> Amount -> [String] - showTransactionsWithBalances' [] _ _ = [] - showTransactionsWithBalances' (t@Transaction{amount=a}:ts) tprev b = - (if isZeroAmount a then [] else this) ++ rest - where - b' = b + (amount t) - sameentry (Transaction {entryno=e1}) (Transaction {entryno=e2}) = e1 == e2 - this = if sameentry t tprev - then [showTransactionWithoutDescription t b'] - else [showTransactionWithDescription t b'] - rest = showTransactionsWithBalances' ts t b' +{- | +Generate the register report. Each ledger entry is displayed as two or +more lines like this: + +@ +date (10) description (20) account (22) amount (11) balance (12) +DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA + aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA + ... ... ... +@ +-} +showRegisterReport :: [Opt] -> [String] -> Ledger -> String +showRegisterReport opts args l = showtxns ts nulltxn nullamt + where + ts = filter matchtxn $ ledgerTransactions l + matchtxn Transaction{account=a} = matchLedgerPatterns False apats a + apats = fst $ parseAccountDescriptionArgs args + + -- show transactions, one per line, keeping a running balance + showtxns [] _ _ = "" + showtxns (t@Transaction{amount=a}:ts) tprev bal = + (if isZeroAmount a then "" else this) ++ showtxns ts t bal' + where + this = if t `issame` tprev + then showTransactionWithoutDescription t bal' + else showTransactionWithDescription t bal' + issame t1 t2 = entryno t1 == entryno t2 + bal' = bal + amount t showTransactionWithDescription :: Transaction -> Amount -> String showTransactionWithDescription t b = diff --git a/Tests.hs b/Tests.hs index b6d4b03e4..de872ab7c 100644 --- a/Tests.hs +++ b/Tests.hs @@ -218,7 +218,7 @@ registercommandtests = TestList [ "register does something" ~: do l <- ledgerfromfile "sample.ledger" - assertnotequal "" $ showTransactionsWithBalances [] [] l + assertnotequal "" $ showRegisterReport [] [] l ] -- | Assert a parsed thing equals some expected thing, or print a parse error.