From 1e1c819f4e4f6fc7d9620255d78f655e768d7dad Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 10 Mar 2007 21:24:57 +0000 Subject: [PATCH] more tree support, properly filter balance report by (one) account regexp --- Account.hs | 40 +++++++++--------- AccountName.hs | 13 +++--- BasicTypes.hs | 2 +- TODO | 111 +++++++++++++++++++++++++++++++++++++++++++++---- Utils.hs | 26 ++++++++++-- hledger.hs | 15 +++---- 6 files changed, 164 insertions(+), 43 deletions(-) diff --git a/Account.hs b/Account.hs index c6337c049..cedd5fd59 100644 --- a/Account.hs +++ b/Account.hs @@ -49,8 +49,8 @@ aggregateTransactionsInAccountNamed l a = addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account addDataToAccountNameTree l ant = Node - (mkAccount l $ rootLabel ant) - (map (addDataToAccountNameTree l) $ subForest ant) + (mkAccount l $ root 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 -ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l) +ledgerAccountTreeMatching :: Ledger -> Bool -> [String] -> Tree Account +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 --- ledgerAccountTreeForAccount l a = addDataToAccountNameTree l (ledgerAccountNameTree l) - -ledgerAccountsMatching :: Ledger -> [String] -> [Account] -ledgerAccountsMatching l acctpats = undefined - -showLedgerAccounts :: Ledger -> Int -> String -showLedgerAccounts l maxdepth = - concatMap (showAccountTree l maxdepth 0) (subForest (ledgerAccountTree l)) +showLedgerAccounts :: Ledger -> Bool -> [String] -> String +showLedgerAccounts l showsubs acctpats = + concatMap + (showAccountTree l 999 0) + (branches (ledgerAccountTreeMatching l showsubs acctpats)) diff --git a/AccountName.hs b/AccountName.hs index 70f4e4de0..546a926ff 100644 --- a/AccountName.hs +++ b/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 = - accountNameFromComponents $ rtail $ accountNameComponents a +parentAccountName a = accountNameFromComponents $ init $ 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 diff --git a/BasicTypes.hs b/BasicTypes.hs index dd212a002..a5758065e 100644 --- a/BasicTypes.hs +++ b/BasicTypes.hs @@ -1,4 +1,4 @@ -module BasicTypes +module BasicTypes where import Utils diff --git a/TODO b/TODO index 912dbfa17..f5d63b1d4 100644 --- a/TODO +++ b/TODO @@ -1,17 +1,111 @@ -make it fast - profile, refactor - * CookedLedger caching acct txns, boring status etc. - refactor apis +* feature: balance report account matching + +sample account tree: + +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 diff --git a/Utils.hs b/Utils.hs index 8cc03747a..8f8a7f51a 100644 --- a/Utils.hs +++ b/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. + diff --git a/hledger.hs b/hledger.hs index 2acc7de22..3d7c0b6af 100644 --- a/hledger.hs +++ b/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 - True -> showLedgerAccounts ledger 999 - False -> showLedgerAccounts ledger 1 - where - showsubs = (ShowSubs `elem` opts) - (acctpats,_) = ledgerPatternArgs args + putStr $ showLedgerAccounts ledger showsubs acctpats + where + showsubs = (ShowSubs `elem` opts) + (acctpats,_) = ledgerPatternArgs args + +