more tree support, properly filter balance report by (one) account regexp

Account.hs

@@ -49,8 +49,8 @@ aggregateTransactionsInAccountNamed l a =
 addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account
 addDataToAccountNameTree l ant = 
     Node 
-    (mkAccount l $ rootLabel ant) 
+    (mkAccount l $ root ant) 
-    (map (addDataToAccountNameTree l) $ subForest ant)
+    (map (addDataToAccountNameTree l) $ branches ant)
 
 -- would be straightforward except we want to elide boring accounts when
 -- displaying account trees:
@@ -65,7 +65,7 @@ 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
+--     | (boringacct && (maxdepth > 1)) = subacctsindented 0
 
     -- otherwise show normal indented account name with balance
     -- if this acct has one or more boring parents, prepend their names
@@ -75,24 +75,24 @@ showAccountTree l maxdepth indentlevel t
     where
       boringacct = isBoringAccount2 l name
       boringparents = takeWhile (isBoringAccount2 l) $ parentAccountNames name
-      bal = printf "%20s" $ show $ abalance $ rootLabel t
+      bal = printf "%20s" $ show $ abalance $ root t
       indent = replicate (indentlevel * 2) ' '
       parentnames = concatMap (++ ":") $ map accountLeafName boringparents
       leafname = accountLeafName name
-      name = aname $ rootLabel t
+      name = aname $ root t
       subacctsindented i = 
           case maxdepth > 1 of
-            True -> concatMap (showAccountTree l (maxdepth-1) (indentlevel+i)) $ subForest t
+            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 = rootLabel at
+          a = root at
           name = aname a
           txns = atransactions a
-          subaccts = subForest at
+          subaccts = branches at
 
 isBoringAccount2 :: Ledger -> AccountName -> Bool
 isBoringAccount2 l a
@@ -103,15 +103,17 @@ isBoringAccount2 l a
       txns = transactionsInAccountNamed l a
       subs = subAccountNamesFrom (ledgerAccountNames l) a
 
-ledgerAccountTree :: Ledger -> Tree Account
+ledgerAccountTreeMatching :: Ledger -> Bool -> [String] -> Tree Account
-ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l)
+ledgerAccountTreeMatching l showsubs [] = 
+    ledgerAccountTreeMatching l showsubs [".*"]
+ledgerAccountTreeMatching l showsubs acctpats = 
+    addDataToAccountNameTree l $ 
+    filterAccountNameTree acctpat $ 
+    ledgerAccountNameTree l
+        where acctpat = head acctpats
 
--- ledgerAccountTreeForAccount :: Ledger -> AccountName -> Tree Account
+showLedgerAccounts :: Ledger -> Bool -> [String] -> String
--- ledgerAccountTreeForAccount l a = addDataToAccountNameTree l (ledgerAccountNameTree l)
+showLedgerAccounts l showsubs acctpats = 
-
+    concatMap 
-ledgerAccountsMatching :: Ledger -> [String] -> [Account]
+    (showAccountTree l 999 0) 
-ledgerAccountsMatching l acctpats = undefined
+    (branches (ledgerAccountTreeMatching l showsubs acctpats))
-
-showLedgerAccounts :: Ledger -> Int -> String
-showLedgerAccounts l maxdepth = 
-    concatMap (showAccountTree l maxdepth 0) (subForest (ledgerAccountTree l))

AccountName.hs

@@ -14,7 +14,7 @@ accountNameFromComponents :: [String] -> AccountName
 accountNameFromComponents = concat . intersperse ":"
 
 accountLeafName :: AccountName -> String
-accountLeafName = rhead . accountNameComponents
+accountLeafName = last . accountNameComponents
 
 accountNameLevel :: AccountName -> Int
 accountNameLevel = length . accountNameComponents
@@ -29,8 +29,7 @@ topAccountNames :: [AccountName] -> [AccountName]
 topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1]
 
 parentAccountName :: AccountName -> AccountName
-parentAccountName a = 
+parentAccountName a = accountNameFromComponents $ init $ accountNameComponents a
-    accountNameFromComponents $ rtail $ accountNameComponents a
 
 parentAccountNames :: AccountName -> [AccountName]
 parentAccountNames a = parentAccountNames' $ parentAccountName a
@@ -79,7 +78,11 @@ accountNameTreeFrom accts =
 
 showAccountNameTree :: Tree AccountName -> String
 showAccountNameTree t =
-    topacct  ++ "\n" ++ concatMap showAccountNameTree (subForest t)
+    topacct  ++ "\n" ++ concatMap showAccountNameTree (branches t)
         where
-          topacct = indentAccountName 0 $ rootLabel t
+          topacct = indentAccountName 0 $ root t
+
+filterAccountNameTree :: String -> Tree AccountName -> Tree AccountName
+filterAccountNameTree s =  treefilter ((matchAccountName s) . accountLeafName)
+--any (flip matchAccountName . accountLeafName) acctpats
 

TODO

@@ -1,17 +1,111 @@
-make it fast
+* feature: balance report account matching
- profile, refactor
+
-  * CookedLedger caching acct txns, boring status etc.
+sample account tree:
-   refactor apis
+
+assets
+ cash
+ checking
+ saving
+equity
+expenses
+ food
+ shelter
+income
+ salary
+liabilities
+ debts
+
+standard balance command shows all top-level accounts:
+
+> ledger bal
+$ assets      
+$ equity
+$ expenses    
+$ income      
+$ liabilities 
+
+with an account pattern, show only the ones with matching names:
+
+> ledger bal asset
+$ assets      
+
+with -s, show all subaccounts of matched accounts:
+
+> ledger -s bal asset
+$ assets      
+$  cash       
+$  checking   
+$  saving
+
+again:
+
+> ledger bal a
+$ assets      
+$  cash       
+$  saving
+$ income      
+$  salary     
+$ liabilities 
+
+and including subaccounts:
+
+> ledger -s bal a
+$ assets      
+$  cash       
+$  checking   
+$  saving
+$ income      
+$  salary     
+$ liabilities 
+$  debts
+
+but also, elide boring accounts whenever possible, so if savings is 0 and
+income/liabilities have no transactions the above would be displayed as:
+
+> ledger -s bal a
+$ assets      
+$  cash       
+$  checking   
+$ income:salary
+$ liabilities:debts
+
+algorithm:
+
+1 filter account tree by name, keeping any necessary parents
+2 add subaccounts if -s
+3 display account tree, eliding boring accounts
+
+* include subaccounts
+elide boring accounts
+handle multiple patterns
+
+
+
+
+
+
+
+
+
+
+
+
+optimization: add CookedLedger caching acct txns, boring status etc.
+ refactor apis
+
+
+
+speed
+ profile, refactor, optimize
 
 basic features
- * balance report account matching
  -f -
  print
  -j and -J graph data output
  !include
  read timelog files
 
-more features
+advanced features
  handle mixed amounts
  3.0-style elision
  -p period expressions
@@ -26,15 +120,16 @@ new features
  timelog simple amount entries
  better layout
 
-tests
+testing
  better use of quickcheck/smallcheck
   http://blog.codersbase.com/2006/09/01/simple-unit-testing-in-haskell/
  ledger compatibility tests
 
-docs
+documentation
  literate docs
  better use of haddock
 
 marketing
  set up as a cabal/hackage project following wiki howto ?
+  http://en.wikibooks.org/wiki/Haskell/Packaging
  announce on haskell list, wiki

Utils.hs

@@ -17,9 +17,6 @@ import Text.Printf
 import Text.Regex
 
 
-rhead = head . reverse 
-rtail = reverse . tail . reverse 
-
 splitAtElement :: Eq a => a -> [a] -> [[a]]
 splitAtElement e l = 
     case dropWhile (e==) l of
@@ -39,3 +36,26 @@ tildeExpand ('~':'/':xs) =  getHomeDirectory >>= return . (++ ('/':xs))
 --                                return (homeDirectory pw ++ path)
 tildeExpand xs           =  return xs
 
+
+-- tree tools
+
+root = rootLabel
+branches = subForest
+
+-- 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)
+
+-- remove all subtrees whose nodes do not fulfill predicate
+treefilter :: (a -> Bool) -> Tree a -> Tree a
+treefilter f t = Node 
+                 (root t) 
+                 (map (treefilter f) $ filter (treeany f) $ branches t)
+    
+-- is predicate true in any node of tree ?
+treeany :: (a -> Bool) -> Tree a -> Bool
+treeany f t = (f $ root t) || (any (treeany f) $ branches t)
+    
+-- treedrop -- remove the leaves which do fulfill predicate. 
+-- treedropall -- do this repeatedly.
+

hledger.hs

@@ -30,6 +30,7 @@ import System.Environment (withArgs) -- for testing in old hugs
 import Test.HUnit (runTestTT)
 import Test.QuickCheck (quickCheck)
 import Text.ParserCombinators.Parsec (ParseError)
+import Debug.Trace
 
 import Options
 import Models
@@ -72,7 +73,7 @@ balance opts args = do
 -- doWithLedgerFile =
 --     getLedgerFilePath >>= parseLedgerFile >>= doWithParsed
 
-doWithParsed :: (a -> IO ()) -> (Either ParseError a) -> IO ()
+doWithParsed :: Show a => (a -> IO ()) -> (Either ParseError a) -> IO ()
 doWithParsed a p = do
   case p of Left e -> parseError e
             Right v -> a v
@@ -86,9 +87,9 @@ printRegister opts args ledger = do
 
 printBalance :: [Flag] -> [String] -> Ledger -> IO ()
 printBalance opts args ledger = do
-  putStr $ case showsubs of
+  putStr $ showLedgerAccounts ledger showsubs acctpats
-             True -> showLedgerAccounts ledger 999
+    where 
-             False -> showLedgerAccounts ledger 1
+      showsubs = (ShowSubs `elem` opts)
-      where 
+      (acctpats,_) = ledgerPatternArgs args
-        showsubs = (ShowSubs `elem` opts)
+
-        (acctpats,_) = ledgerPatternArgs args
+