From c370d34de69aea8652dec56c6e1f57fa497fbc91 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 19 Feb 2007 21:20:06 +0000 Subject: [PATCH] elide boring accounts in balance report, like ledger --- Account.hs | 92 +++++++++++++++++++++++++++++--------------------- AccountName.hs | 30 ++++++++-------- Ledger.hs | 6 ++-- TODO | 2 -- hledger.hs | 4 +-- 5 files changed, 73 insertions(+), 61 deletions(-) diff --git a/Account.hs b/Account.hs index 730f4cd68..f7d90c698 100644 --- a/Account.hs +++ b/Account.hs @@ -47,52 +47,66 @@ addDataToAccountNameTree l ant = where aname = antacctname ant -showAccountTreeWithBalances :: Ledger -> Int -> Tree Account -> String -showAccountTreeWithBalances l depth at = (showAccountTreesWithBalances l depth) (branches at) - -showAccountTreesWithBalances :: Ledger -> Int -> [Tree Account] -> String -showAccountTreesWithBalances _ 0 _ = "" -showAccountTreesWithBalances l depth ats = - concatMap showAccountBranch ats - where - showAccountBranch :: Tree Account -> String - showAccountBranch at = - topacct ++ "\n" ++ subaccts --- case boring of --- True -> --- False -> - where - topacct = (showAmount bal) ++ " " ++ (indentAccountName name) - showAmount amt = printf "%20s" (show amt) - name = aname $ atacct at - txns = atransactions $ atacct at - bal = abalance $ atacct at - subaccts = (showAccountTreesWithBalances l (depth - 1)) $ branches at - boring = (length txns == 0) && ((length subaccts) == 1) - --- we want to elide boring accounts in the account tree --- --- a (2 txns) --- b (boring acct - 0 txns, exactly 1 sub) --- c (5 txns) +-- would be straightforward except we want to elide boring accounts when +-- displaying account trees: +-- a (0 txns, only 1 subacct) +-- b (another boring acct.) +-- c -- d --- to: --- a (2 txns) --- b:c (5 txns) --- d +-- becomes: +-- a:b:c +-- d +showAccountTree :: Ledger -> Int -> Int -> Tree Account -> String +showAccountTree _ 0 _ _ = "" +showAccountTree l maxdepth indentlevel t + -- if this acct is boring, don't show it (unless this is as deep as we're going) + | (boringacct && (maxdepth > 1)) = subacctsindented 0 --- elideAccountTree at = at + -- otherwise show normal indented account name with balance + -- if this acct has one or more boring parents, prepend their names + | otherwise = + bal ++ " " ++ indent ++ parentnames ++ leafname ++ "\n" ++ (subacctsindented 1) -elideAccountTree :: Tree Account -> Tree Account -elideAccountTree = id + where + boringacct = isBoringAccount2 l name + boringparents = takeWhile (isBoringAccount2 l) $ parentAccountNames name + bal = printf "%20s" $ show $ abalance $ atacct t + indent = replicate (indentlevel * 2) ' ' + parentnames = concatMap (++ ":") $ map accountLeafName boringparents + leafname = accountLeafName name + name = aname $ atacct 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 = atacct 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 ledgerAccountTree :: Ledger -> Tree Account -ledgerAccountTree l = elideAccountTree $ addDataToAccountNameTree l (ledgerAccountNameTree l) +ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l) + +-- ledgerAccountTreeForAccount :: Ledger -> AccountName -> Tree Account +-- ledgerAccountTreeForAccount l a = addDataToAccountNameTree l (ledgerAccountNameTree l) ledgerAccountsMatching :: Ledger -> [String] -> [Account] ledgerAccountsMatching l acctpats = undefined showLedgerAccounts :: Ledger -> Int -> String -showLedgerAccounts l depth = - showAccountTreeWithBalances l depth (ledgerAccountTree l) - +showLedgerAccounts l maxdepth = + concatMap (showAccountTree l maxdepth 0) (branches (ledgerAccountTree l)) diff --git a/AccountName.hs b/AccountName.hs index fa456ab7f..36ee5c0d2 100644 --- a/AccountName.hs +++ b/AccountName.hs @@ -29,11 +29,15 @@ expandAccountNames as = nub $ concat $ map expand as topAccountNames :: [AccountName] -> [AccountName] topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1] -parentAccountName :: AccountName -> Maybe AccountName +parentAccountName :: AccountName -> AccountName parentAccountName a = - case accountNameLevel a > 1 of - True -> Just $ accountNameFromComponents $ rtail $ accountNameComponents a - False -> Nothing + accountNameFromComponents $ rtail $ accountNameComponents a + +parentAccountNames :: AccountName -> [AccountName] +parentAccountNames a = parentAccountNames' $ parentAccountName a + where + parentAccountNames' "" = [] + parentAccountNames' a = [a] ++ (parentAccountNames' $ parentAccountName a) s `isSubAccountNameOf` p = ((p ++ ":") `isPrefixOf` s) && (accountNameLevel s == (accountNameLevel p + 1)) @@ -47,8 +51,10 @@ matchAccountName s a = Nothing -> False otherwise -> True -indentAccountName :: AccountName -> String -indentAccountName a = replicate (((accountNameLevel a) - 1) * 2) ' ' ++ (accountLeafName a) +indentAccountName :: Int -> AccountName -> String +indentAccountName indentcorrection a = + replicate (indentlevel * 2) ' ' ++ (accountLeafName a) + where indentlevel = ((accountNameLevel a) - 1) + indentcorrection -- We could almost get by with just the above, but we need smarter @@ -75,14 +81,8 @@ accountNameTreeFrom accts = subs = (subAccountNamesFrom accts) showAccountNameTree :: Tree AccountName -> String -showAccountNameTree at = showAccountNameTrees $ branches at - -showAccountNameTrees :: [Tree AccountName] -> String -showAccountNameTrees ats = - concatMap showAccountNameBranch ats +showAccountNameTree t = + topacct ++ "\n" ++ concatMap showAccountNameTree (branches t) where - showAccountNameBranch at = topacct ++ "\n" ++ subaccts - where - topacct = indentAccountName $ antacctname at - subaccts = showAccountNameTrees $ branches at + topacct = indentAccountName 0 $ antacctname t diff --git a/Ledger.hs b/Ledger.hs index 8b98df566..d5b4822f7 100644 --- a/Ledger.hs +++ b/Ledger.hs @@ -15,9 +15,9 @@ data Ledger = Ledger { instance Show Ledger where show l = printf "Ledger with %d normal, %d modifier, %d periodic entries" - (show $ length $ modifier_entries l) - (show $ length $ periodic_entries l) - (show $ length $ entries l) + (length $ modifier_entries l) + (length $ periodic_entries l) + (length $ entries l) ledgerTransactions :: Ledger -> [EntryTransaction] ledgerTransactions l = entryTransactionsFrom $ entries l diff --git a/TODO b/TODO index f092fba88..4f95ad1eb 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,4 @@ basic features - balance - elide boring accounts handle mixed amounts and currencies print entry diff --git a/hledger.hs b/hledger.hs index a598e9264..5a452155c 100644 --- a/hledger.hs +++ b/hledger.hs @@ -4,7 +4,7 @@ hledger - ledger-compatible money management utilities (& haskell study) GPLv3, (c) Simon Michael & contributors, John Wiegley's ledger is at http://newartisans.com/ledger.html -The model/type/class hierarchy is roughly like this: +modules/models are organized roughly like this: hledger Options @@ -95,7 +95,7 @@ printBalance opts args ledger = do -- False -> depthOption opts putStr $ case showsubs of True -> showLedgerAccounts ledger 999 - False -> showLedgerAccounts ledger (getDepth opts) + False -> showLedgerAccounts ledger 1 where showsubs = (ShowSubs `elem` opts) (acctpats,_) = ledgerPatternArgs args