rename ledger functions

This commit is contained in:
Simon Michael 2007-07-02 19:39:34 +00:00
parent bd84e95f5e
commit 362d3831ea
5 changed files with 64 additions and 64 deletions

View File

@ -20,8 +20,8 @@ instance Show Account where
nullacct = Account "" [] nullamt nullacct = Account "" [] nullamt
ledgerAccount :: RawLedger -> AccountName -> Account rawLedgerAccount :: RawLedger -> AccountName -> Account
ledgerAccount l a = rawLedgerAccount l a =
Account Account
a a
(transactionsInAccountNamed l a) (transactionsInAccountNamed l a)
@ -39,17 +39,17 @@ aggregateBalanceInAccountNamed l a =
transactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction] transactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
transactionsInAccountNamed l a = transactionsInAccountNamed l a =
ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l
aggregateTransactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction] aggregateTransactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
aggregateTransactionsInAccountNamed l a = aggregateTransactionsInAccountNamed l a =
ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l rawLedgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l
-- build a tree of Accounts -- build a tree of Accounts
addDataToAccountNameTree :: RawLedger -> Tree AccountName -> Tree Account addDataToAccountNameTree :: RawLedger -> Tree AccountName -> Tree Account
addDataToAccountNameTree l ant = addDataToAccountNameTree l ant =
Node Node
(ledgerAccount l $ root ant) (rawLedgerAccount l $ root ant)
(map (addDataToAccountNameTree l) $ branches ant) (map (addDataToAccountNameTree l) $ branches ant)
-- balance report support -- balance report support
@ -92,19 +92,19 @@ addDataToAccountNameTree l ant =
-- $ checking -- $ checking
-- $ saving -- $ saving
showLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String showRawLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String
showLedgerAccounts l acctpats showsubs maxdepth = showRawLedgerAccounts l acctpats showsubs maxdepth =
concatMap concatMap
(showAccountTree l) (showAccountTree l)
(branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) (branches (rawLedgerAccountTreeMatching l acctpats showsubs maxdepth))
ledgerAccountTreeMatching :: RawLedger -> [String] -> Bool -> Int -> Tree Account rawLedgerAccountTreeMatching :: RawLedger -> [String] -> Bool -> Int -> Tree Account
ledgerAccountTreeMatching l [] showsubs maxdepth = rawLedgerAccountTreeMatching l [] showsubs maxdepth =
ledgerAccountTreeMatching l [".*"] showsubs maxdepth rawLedgerAccountTreeMatching l [".*"] showsubs maxdepth
ledgerAccountTreeMatching l acctpats showsubs maxdepth = rawLedgerAccountTreeMatching l acctpats showsubs maxdepth =
addDataToAccountNameTree l $ addDataToAccountNameTree l $
filterAccountNameTree acctpats showsubs maxdepth $ filterAccountNameTree acctpats showsubs maxdepth $
ledgerAccountNameTree l rawLedgerAccountNameTree l
-- when displaying an account tree, we elide boring accounts. -- when displaying an account tree, we elide boring accounts.
-- 1. leaf accounts and branches with 0 balance or 0 transactions are omitted -- 1. leaf accounts and branches with 0 balance or 0 transactions are omitted
@ -157,7 +157,7 @@ isBoringInnerAccount l a
where where
name = aname a name = aname a
txns = atransactions a txns = atransactions a
subs = subAccountNamesFrom (ledgerAccountNames l) name subs = subAccountNamesFrom (rawLedgerAccountNames l) name
-- darnit, still need this -- darnit, still need this
isBoringInnerAccountName :: RawLedger -> AccountName -> Bool isBoringInnerAccountName :: RawLedger -> AccountName -> Bool
@ -167,7 +167,7 @@ isBoringInnerAccountName l name
| otherwise = False | otherwise = False
where where
txns = transactionsInAccountNamed l name txns = transactionsInAccountNamed l name
subs = subAccountNamesFrom (ledgerAccountNames l) name subs = subAccountNamesFrom (rawLedgerAccountNames l) name
interestingAccountsFrom :: Tree Account -> Tree Account interestingAccountsFrom :: Tree Account -> Tree Account
interestingAccountsFrom = interestingAccountsFrom =
@ -176,5 +176,5 @@ interestingAccountsFrom =
hasbalance = (/= 0) . abalance hasbalance = (/= 0) . abalance
hastxns = (> 0) . length . atransactions hastxns = (> 0) . length . atransactions
ledgerAccountTree :: RawLedger -> Tree Account rawLedgerAccountTree :: RawLedger -> Tree Account
ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l) rawLedgerAccountTree l = addDataToAccountNameTree l (rawLedgerAccountNameTree l)

View File

@ -14,36 +14,36 @@ cacheLedger :: RawLedger -> Ledger
cacheLedger l = cacheLedger l =
Ledger Ledger
l l
(ledgerAccountNameTree l) (rawLedgerAccountNameTree l)
(Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l]) (Map.fromList [(a, rawLedgerAccount l a) | a <- rawLedgerAccountNames l])
cLedgerTransactions :: Ledger -> [EntryTransaction] ledgerTransactions :: Ledger -> [EntryTransaction]
cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l ledgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
-- unoptimised -- unoptimised
cLedgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ rawledger l ledgerTransactionsMatching pats l = rawLedgerTransactionsMatching pats $ rawledger l
-- XXX optimise -- XXX optimise
cLedgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction] ledgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction]
cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (rawledger l) ledgerTransactionsMatching1 ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) (rawledger l)
cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (rawledger l) ledgerTransactionsMatching1 (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) (rawledger l)
cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (rawledger l) ledgerTransactionsMatching1 ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) (rawledger l)
cLedgerTransactionsMatching1 (acctregexps,descregexps) l = ledgerTransactionsMatching1 (acctregexps,descregexps) l =
intersect intersect
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
(concat [filter (matchTransactionDescription r) ts | r <- descregexps]) (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
where ts = cLedgerTransactions l where ts = ledgerTransactions l
-- unoptimised -- unoptimised
showCLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
showCLedgerAccounts l acctpats showsubs maxdepth = showLedgerAccounts l acctpats showsubs maxdepth =
showLedgerAccounts (rawledger l) acctpats showsubs maxdepth showRawLedgerAccounts (rawledger l) acctpats showsubs maxdepth
-- XXX optimise -- XXX optimise
showCLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String showLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String
showCLedgerAccounts1 l acctpats showsubs maxdepth = showLedgerAccounts1 l acctpats showsubs maxdepth =
concatMap concatMap
(showAccountTree (rawledger l)) (showAccountTree (rawledger l))
(branches (ledgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth)) (branches (rawLedgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth))

View File

@ -15,42 +15,42 @@ instance Show RawLedger where
(length $ modifier_entries l) + (length $ modifier_entries l) +
(length $ periodic_entries l)) (length $ periodic_entries l))
ledgerTransactions :: RawLedger -> [EntryTransaction] rawLedgerTransactions :: RawLedger -> [EntryTransaction]
ledgerTransactions l = entryTransactionsFrom $ entries l rawLedgerTransactions l = entryTransactionsFrom $ entries l
ledgerTransactionsMatching :: ([String],[String]) -> RawLedger -> [EntryTransaction] rawLedgerTransactionsMatching :: ([String],[String]) -> RawLedger -> [EntryTransaction]
ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l rawLedgerTransactionsMatching ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) l
ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l rawLedgerTransactionsMatching (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) l
ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l rawLedgerTransactionsMatching ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) l
ledgerTransactionsMatching (acctregexps,descregexps) l = rawLedgerTransactionsMatching (acctregexps,descregexps) l =
intersect intersect
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) (concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
(concat [filter (matchTransactionDescription r) ts | r <- descregexps]) (concat [filter (matchTransactionDescription r) ts | r <- descregexps])
where ts = ledgerTransactions l where ts = rawLedgerTransactions l
ledgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction] rawLedgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction]
ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l rawLedgerAccountTransactions l a = rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l
accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
accountNamesFromTransactions ts = nub $ map account ts accountNamesFromTransactions ts = nub $ map account ts
ledgerAccountNamesUsed :: RawLedger -> [AccountName] rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
ledgerAccountNames :: RawLedger -> [AccountName] rawLedgerAccountNames :: RawLedger -> [AccountName]
ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
ledgerTopAccountNames :: RawLedger -> [AccountName] rawLedgerTopAccountNames :: RawLedger -> [AccountName]
ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l) rawLedgerTopAccountNames l = filter (notElem ':') (rawLedgerAccountNames l)
ledgerAccountNamesMatching :: [String] -> RawLedger -> [AccountName] rawLedgerAccountNamesMatching :: [String] -> RawLedger -> [AccountName]
ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l rawLedgerAccountNamesMatching [] l = rawLedgerAccountNamesMatching [".*"] l
ledgerAccountNamesMatching acctregexps l = rawLedgerAccountNamesMatching acctregexps l =
concat [filter (matchAccountName r) accountNames | r <- acctregexps] concat [filter (matchAccountName r) accountNames | r <- acctregexps]
where accountNames = ledgerTopAccountNames l where accountNames = rawLedgerTopAccountNames l
ledgerAccountNameTree :: RawLedger -> Tree AccountName rawLedgerAccountNameTree :: RawLedger -> Tree AccountName
ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l

View File

@ -288,7 +288,7 @@ test_ledgerAccountNames =
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances", ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation", "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"] "liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
(ledgerAccountNames ledger7) (rawLedgerAccountNames ledger7)
test_cacheLedger = test_cacheLedger =
assertEqual' 14 (length $ Map.keys $ accounts $ cacheLedger ledger7) assertEqual' 14 (length $ Map.keys $ accounts $ cacheLedger ledger7)
@ -301,7 +301,7 @@ props = mapM quickCheck
parse' ledgertransaction transaction1_str `parseEquals` parse' ledgertransaction transaction1_str `parseEquals`
(Transaction "expenses:food:dining" (Amount (getcurrency "$") 10)) (Transaction "expenses:food:dining" (Amount (getcurrency "$") 10))
, ,
ledgerAccountNames ledger7 == rawLedgerAccountNames ledger7 ==
["assets","assets:cash","assets:checking","assets:saving","equity", ["assets","assets:cash","assets:checking","assets:saving","equity",
"equity:opening balances","expenses","expenses:food","expenses:food:dining", "equity:opening balances","expenses","expenses:food","expenses:food:dining",
"expenses:phone","expenses:vacation","liabilities","liabilities:credit cards", "expenses:phone","expenses:vacation","liabilities","liabilities:credit cards",

View File

@ -39,7 +39,7 @@ register opts acctpats descpats = do
where where
printRegister l = printRegister l =
putStr $ showTransactionsWithBalances putStr $ showTransactionsWithBalances
(cLedgerTransactionsMatching (acctpats,descpats) l) (ledgerTransactionsMatching (acctpats,descpats) l)
0 0
balance :: [Flag] -> [String] -> [String] -> IO () balance :: [Flag] -> [String] -> [String] -> IO ()
@ -47,7 +47,7 @@ balance opts acctpats _ = do
doWithLedger opts printBalance doWithLedger opts printBalance
where where
printBalance l = printBalance l =
putStr $ showCLedgerAccounts l acctpats showsubs maxdepth putStr $ showLedgerAccounts l acctpats showsubs maxdepth
where where
showsubs = (ShowSubs `elem` opts) showsubs = (ShowSubs `elem` opts)
maxdepth = case (acctpats, showsubs) of maxdepth = case (acctpats, showsubs) of
@ -76,6 +76,6 @@ doWithParsed cmd parsed = do
-- --
-- p <- ledgerFilePath [] >>= parseLedgerFile -- p <- ledgerFilePath [] >>= parseLedgerFile
-- let l = either (\_ -> RawLedger [] [] []) id p -- let l = either (\_ -> RawLedger [] [] []) id p
-- let ant = ledgerAccountNameTree l -- let ant = rawLedgerAccountNameTree l
-- let at = ledgerAccountTreeMatching l [] True 999 -- let at = rawLedgerAccountTreeMatching l [] True 999
-- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999 -- putStr $ drawTree $ treemap show $ rawLedgerAccountTreeMatching l ["a"] False 999