From 7d2a868640a9b6824a2dc35de85b9e97045eb57b Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 10 Mar 2007 23:05:30 +0000
Subject: [PATCH] fix, show only top level by default

---
 Account.hs     | 16 ++++++++--------
 AccountName.hs |  7 ++++---
 Utils.hs       |  6 ++++++
 hledger.hs     |  7 +++++--
 4 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/Account.hs b/Account.hs
index 1a218d608..8bd22add8 100644
--- a/Account.hs
+++ b/Account.hs
@@ -106,16 +106,16 @@ isBoringAccount2 l a
       txns = transactionsInAccountNamed l a
       subs = subAccountNamesFrom (ledgerAccountNames l) a
 
-ledgerAccountTreeMatching :: Ledger -> Bool -> [String] -> Tree Account
-ledgerAccountTreeMatching l showsubs [] = 
-    ledgerAccountTreeMatching l showsubs [".*"]
-ledgerAccountTreeMatching l showsubs acctpats = 
+ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account
+ledgerAccountTreeMatching l [] showsubs maxdepth = 
+    ledgerAccountTreeMatching l [".*"] showsubs maxdepth
+ledgerAccountTreeMatching l acctpats showsubs maxdepth = 
     addDataToAccountNameTree l $ 
-    filterAccountNameTree acctpats showsubs $ 
+    filterAccountNameTree acctpats showsubs maxdepth $ 
     ledgerAccountNameTree l
 
-showLedgerAccounts :: Ledger -> Bool -> [String] -> String
-showLedgerAccounts l showsubs acctpats = 
+showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
+showLedgerAccounts l acctpats showsubs maxdepth = 
     concatMap 
     (showAccountTree l 999 0) 
-    (branches (ledgerAccountTreeMatching l showsubs acctpats))
+    (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))
diff --git a/AccountName.hs b/AccountName.hs
index c621808d8..328437876 100644
--- a/AccountName.hs
+++ b/AccountName.hs
@@ -82,9 +82,10 @@ showAccountNameTree t =
         where
           topacct = indentAccountName 0 $ root t
 
-filterAccountNameTree :: [String] -> Bool -> Tree AccountName -> Tree AccountName
-filterAccountNameTree pats keepsubs =
-    treefilter $ \a -> matchpats a || (keepsubs && issubofmatch a)
+filterAccountNameTree :: [String] -> Bool -> Int -> Tree AccountName -> Tree AccountName
+filterAccountNameTree pats keepsubs maxdepth =
+    treefilter (\a -> matchpats a || (keepsubs && issubofmatch a)) .
+    treeprune maxdepth
     where
       matchpats a = any (match a) pats
       match a pat = matchAccountName pat $ accountLeafName a
diff --git a/Utils.hs b/Utils.hs
index 8f8a7f51a..e4335e3fb 100644
--- a/Utils.hs
+++ b/Utils.hs
@@ -42,6 +42,12 @@ tildeExpand xs           =  return xs
 root = rootLabel
 branches = subForest
 
+-- remove all nodes past a certain depth
+treeprune :: Int -> Tree a -> Tree a
+treeprune 0 t = Node (root t) []
+treeprune d t = 
+    Node (root t) (map (treeprune $ d-1) $ branches t)
+
 -- apply f to all tree nodes
 treemap :: (a -> b) -> Tree a -> Tree b
 treemap f t = Node (f $ root t) (map (treemap f) $ branches t)
diff --git a/hledger.hs b/hledger.hs
index 3d7c0b6af..1562711ce 100644
--- a/hledger.hs
+++ b/hledger.hs
@@ -87,9 +87,12 @@ printRegister opts args ledger = do
 
 printBalance :: [Flag] -> [String] -> Ledger -> IO ()
 printBalance opts args ledger = do
-  putStr $ showLedgerAccounts ledger showsubs acctpats
+  putStr $ showLedgerAccounts ledger acctpats showsubs maxdepth
     where 
-      showsubs = (ShowSubs `elem` opts)
       (acctpats,_) = ledgerPatternArgs args
+      showsubs = (ShowSubs `elem` opts)
+      maxdepth = case (acctpats, showsubs) of
+                   ([],False) -> 1
+                   otherwise  -> 9999