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

This commit is contained in:
Simon Michael 2007-03-10 21:24:57 +00:00
parent 453ca1206e
commit 1e1c819f4e
6 changed files with 164 additions and 43 deletions

View File

@ -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))

View File

@ -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

View File

@ -1,4 +1,4 @@
module BasicTypes
module BasicTypes
where
import Utils

111
TODO
View File

@ -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

View File

@ -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.

View File

@ -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