mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-08 07:09:28 +03:00
more tree support, properly filter balance report by (one) account regexp
This commit is contained in:
parent
453ca1206e
commit
1e1c819f4e
40
Account.hs
40
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))
|
||||
|
@ -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
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
module BasicTypes
|
||||
module BasicTypes
|
||||
where
|
||||
import Utils
|
||||
|
||||
|
111
TODO
111
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
|
||||
|
26
Utils.hs
26
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.
|
||||
|
||||
|
15
hledger.hs
15
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
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user