fix, show only top level by default

This commit is contained in:
Simon Michael 2007-03-10 23:05:30 +00:00
parent a881f713c1
commit 7d2a868640
4 changed files with 23 additions and 13 deletions

View File

@ -106,16 +106,16 @@ isBoringAccount2 l a
txns = transactionsInAccountNamed l a txns = transactionsInAccountNamed l a
subs = subAccountNamesFrom (ledgerAccountNames l) a subs = subAccountNamesFrom (ledgerAccountNames l) a
ledgerAccountTreeMatching :: Ledger -> Bool -> [String] -> Tree Account ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account
ledgerAccountTreeMatching l showsubs [] = ledgerAccountTreeMatching l [] showsubs maxdepth =
ledgerAccountTreeMatching l showsubs [".*"] ledgerAccountTreeMatching l [".*"] showsubs maxdepth
ledgerAccountTreeMatching l showsubs acctpats = ledgerAccountTreeMatching l acctpats showsubs maxdepth =
addDataToAccountNameTree l $ addDataToAccountNameTree l $
filterAccountNameTree acctpats showsubs $ filterAccountNameTree acctpats showsubs maxdepth $
ledgerAccountNameTree l ledgerAccountNameTree l
showLedgerAccounts :: Ledger -> Bool -> [String] -> String showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
showLedgerAccounts l showsubs acctpats = showLedgerAccounts l acctpats showsubs maxdepth =
concatMap concatMap
(showAccountTree l 999 0) (showAccountTree l 999 0)
(branches (ledgerAccountTreeMatching l showsubs acctpats)) (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))

View File

@ -82,9 +82,10 @@ showAccountNameTree t =
where where
topacct = indentAccountName 0 $ root t topacct = indentAccountName 0 $ root t
filterAccountNameTree :: [String] -> Bool -> Tree AccountName -> Tree AccountName filterAccountNameTree :: [String] -> Bool -> Int -> Tree AccountName -> Tree AccountName
filterAccountNameTree pats keepsubs = filterAccountNameTree pats keepsubs maxdepth =
treefilter $ \a -> matchpats a || (keepsubs && issubofmatch a) treefilter (\a -> matchpats a || (keepsubs && issubofmatch a)) .
treeprune maxdepth
where where
matchpats a = any (match a) pats matchpats a = any (match a) pats
match a pat = matchAccountName pat $ accountLeafName a match a pat = matchAccountName pat $ accountLeafName a

View File

@ -42,6 +42,12 @@ tildeExpand xs = return xs
root = rootLabel root = rootLabel
branches = subForest 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 -- apply f to all tree nodes
treemap :: (a -> b) -> Tree a -> Tree b treemap :: (a -> b) -> Tree a -> Tree b
treemap f t = Node (f $ root t) (map (treemap f) $ branches t) treemap f t = Node (f $ root t) (map (treemap f) $ branches t)

View File

@ -87,9 +87,12 @@ printRegister opts args ledger = do
printBalance :: [Flag] -> [String] -> Ledger -> IO () printBalance :: [Flag] -> [String] -> Ledger -> IO ()
printBalance opts args ledger = do printBalance opts args ledger = do
putStr $ showLedgerAccounts ledger showsubs acctpats putStr $ showLedgerAccounts ledger acctpats showsubs maxdepth
where where
showsubs = (ShowSubs `elem` opts)
(acctpats,_) = ledgerPatternArgs args (acctpats,_) = ledgerPatternArgs args
showsubs = (ShowSubs `elem` opts)
maxdepth = case (acctpats, showsubs) of
([],False) -> 1
otherwise -> 9999