rename ledger functions
This commit is contained in:
Simon Michael
parent
bd84e95f5e
commit
362d3831ea
34
Account.hs
34
Account.hs
@ -20,8 +20,8 @@ instance Show Account where
|
||||
|
||||
nullacct = Account "" [] nullamt
|
||||
|
||||
ledgerAccount :: RawLedger -> AccountName -> Account
|
||||
ledgerAccount l a =
|
||||
rawLedgerAccount :: RawLedger -> AccountName -> Account
|
||||
rawLedgerAccount l a =
|
||||
Account
|
||||
a
|
||||
(transactionsInAccountNamed l a)
|
||||
@ -39,17 +39,17 @@ aggregateBalanceInAccountNamed l a =
|
||||
|
||||
transactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
|
||||
transactionsInAccountNamed l a =
|
||||
ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l
|
||||
rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l
|
||||
|
||||
aggregateTransactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction]
|
||||
aggregateTransactionsInAccountNamed l a =
|
||||
ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l
|
||||
rawLedgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l
|
||||
|
||||
-- build a tree of Accounts
|
||||
addDataToAccountNameTree :: RawLedger -> Tree AccountName -> Tree Account
|
||||
addDataToAccountNameTree l ant =
|
||||
Node
|
||||
(ledgerAccount l $ root ant)
|
||||
(rawLedgerAccount l $ root ant)
|
||||
(map (addDataToAccountNameTree l) $ branches ant)
|
||||
|
||||
-- balance report support
|
||||
@ -92,19 +92,19 @@ addDataToAccountNameTree l ant =
|
||||
-- $ checking
|
||||
-- $ saving
|
||||
|
||||
showLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String
|
||||
showLedgerAccounts l acctpats showsubs maxdepth =
|
||||
showRawLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String
|
||||
showRawLedgerAccounts l acctpats showsubs maxdepth =
|
||||
concatMap
|
||||
(showAccountTree l)
|
||||
(branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth))
|
||||
(branches (rawLedgerAccountTreeMatching l acctpats showsubs maxdepth))
|
||||
|
||||
ledgerAccountTreeMatching :: RawLedger -> [String] -> Bool -> Int -> Tree Account
|
||||
ledgerAccountTreeMatching l [] showsubs maxdepth =
|
||||
ledgerAccountTreeMatching l [".*"] showsubs maxdepth
|
||||
ledgerAccountTreeMatching l acctpats showsubs maxdepth =
|
||||
rawLedgerAccountTreeMatching :: RawLedger -> [String] -> Bool -> Int -> Tree Account
|
||||
rawLedgerAccountTreeMatching l [] showsubs maxdepth =
|
||||
rawLedgerAccountTreeMatching l [".*"] showsubs maxdepth
|
||||
rawLedgerAccountTreeMatching l acctpats showsubs maxdepth =
|
||||
addDataToAccountNameTree l $
|
||||
filterAccountNameTree acctpats showsubs maxdepth $
|
||||
ledgerAccountNameTree l
|
||||
rawLedgerAccountNameTree l
|
||||
|
||||
-- when displaying an account tree, we elide boring accounts.
|
||||
-- 1. leaf accounts and branches with 0 balance or 0 transactions are omitted
|
||||
@ -157,7 +157,7 @@ isBoringInnerAccount l a
|
||||
where
|
||||
name = aname a
|
||||
txns = atransactions a
|
||||
subs = subAccountNamesFrom (ledgerAccountNames l) name
|
||||
subs = subAccountNamesFrom (rawLedgerAccountNames l) name
|
||||
|
||||
-- darnit, still need this
|
||||
isBoringInnerAccountName :: RawLedger -> AccountName -> Bool
|
||||
@ -167,7 +167,7 @@ isBoringInnerAccountName l name
|
||||
| otherwise = False
|
||||
where
|
||||
txns = transactionsInAccountNamed l name
|
||||
subs = subAccountNamesFrom (ledgerAccountNames l) name
|
||||
subs = subAccountNamesFrom (rawLedgerAccountNames l) name
|
||||
|
||||
interestingAccountsFrom :: Tree Account -> Tree Account
|
||||
interestingAccountsFrom =
|
||||
@ -176,5 +176,5 @@ interestingAccountsFrom =
|
||||
hasbalance = (/= 0) . abalance
|
||||
hastxns = (> 0) . length . atransactions
|
||||
|
||||
ledgerAccountTree :: RawLedger -> Tree Account
|
||||
ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l)
|
||||
rawLedgerAccountTree :: RawLedger -> Tree Account
|
||||
rawLedgerAccountTree l = addDataToAccountNameTree l (rawLedgerAccountNameTree l)
|
||||
|
||||
36
Ledger.hs
36
Ledger.hs
@ -14,36 +14,36 @@ cacheLedger :: RawLedger -> Ledger
|
||||
cacheLedger l =
|
||||
Ledger
|
||||
l
|
||||
(ledgerAccountNameTree l)
|
||||
(Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l])
|
||||
(rawLedgerAccountNameTree l)
|
||||
(Map.fromList [(a, rawLedgerAccount l a) | a <- rawLedgerAccountNames l])
|
||||
|
||||
cLedgerTransactions :: Ledger -> [EntryTransaction]
|
||||
cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
|
||||
ledgerTransactions :: Ledger -> [EntryTransaction]
|
||||
ledgerTransactions l = concatMap atransactions $ Map.elems $ accounts l
|
||||
|
||||
-- unoptimised
|
||||
cLedgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
|
||||
cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ rawledger l
|
||||
ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction]
|
||||
ledgerTransactionsMatching pats l = rawLedgerTransactionsMatching pats $ rawledger l
|
||||
|
||||
-- XXX optimise
|
||||
cLedgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction]
|
||||
cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (rawledger l)
|
||||
cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (rawledger l)
|
||||
cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (rawledger l)
|
||||
cLedgerTransactionsMatching1 (acctregexps,descregexps) l =
|
||||
ledgerTransactionsMatching1 :: ([String],[String]) -> Ledger -> [EntryTransaction]
|
||||
ledgerTransactionsMatching1 ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) (rawledger l)
|
||||
ledgerTransactionsMatching1 (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) (rawledger l)
|
||||
ledgerTransactionsMatching1 ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) (rawledger l)
|
||||
ledgerTransactionsMatching1 (acctregexps,descregexps) l =
|
||||
intersect
|
||||
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
|
||||
(concat [filter (matchTransactionDescription r) ts | r <- descregexps])
|
||||
where ts = cLedgerTransactions l
|
||||
where ts = ledgerTransactions l
|
||||
|
||||
-- unoptimised
|
||||
showCLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
|
||||
showCLedgerAccounts l acctpats showsubs maxdepth =
|
||||
showLedgerAccounts (rawledger l) acctpats showsubs maxdepth
|
||||
showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String
|
||||
showLedgerAccounts l acctpats showsubs maxdepth =
|
||||
showRawLedgerAccounts (rawledger l) acctpats showsubs maxdepth
|
||||
|
||||
-- XXX optimise
|
||||
showCLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String
|
||||
showCLedgerAccounts1 l acctpats showsubs maxdepth =
|
||||
showLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String
|
||||
showLedgerAccounts1 l acctpats showsubs maxdepth =
|
||||
concatMap
|
||||
(showAccountTree (rawledger l))
|
||||
(branches (ledgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth))
|
||||
(branches (rawLedgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth))
|
||||
|
||||
|
||||
44
RawLedger.hs
44
RawLedger.hs
@ -15,42 +15,42 @@ instance Show RawLedger where
|
||||
(length $ modifier_entries l) +
|
||||
(length $ periodic_entries l))
|
||||
|
||||
ledgerTransactions :: RawLedger -> [EntryTransaction]
|
||||
ledgerTransactions l = entryTransactionsFrom $ entries l
|
||||
rawLedgerTransactions :: RawLedger -> [EntryTransaction]
|
||||
rawLedgerTransactions l = entryTransactionsFrom $ entries l
|
||||
|
||||
ledgerTransactionsMatching :: ([String],[String]) -> RawLedger -> [EntryTransaction]
|
||||
ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l
|
||||
ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l
|
||||
ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l
|
||||
ledgerTransactionsMatching (acctregexps,descregexps) l =
|
||||
rawLedgerTransactionsMatching :: ([String],[String]) -> RawLedger -> [EntryTransaction]
|
||||
rawLedgerTransactionsMatching ([],[]) l = rawLedgerTransactionsMatching ([".*"],[".*"]) l
|
||||
rawLedgerTransactionsMatching (rs,[]) l = rawLedgerTransactionsMatching (rs,[".*"]) l
|
||||
rawLedgerTransactionsMatching ([],rs) l = rawLedgerTransactionsMatching ([".*"],rs) l
|
||||
rawLedgerTransactionsMatching (acctregexps,descregexps) l =
|
||||
intersect
|
||||
(concat [filter (matchTransactionAccount r) ts | r <- acctregexps])
|
||||
(concat [filter (matchTransactionDescription r) ts | r <- descregexps])
|
||||
where ts = ledgerTransactions l
|
||||
where ts = rawLedgerTransactions l
|
||||
|
||||
ledgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction]
|
||||
ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l
|
||||
rawLedgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction]
|
||||
rawLedgerAccountTransactions l a = rawLedgerTransactionsMatching (["^" ++ a ++ "$"], []) l
|
||||
|
||||
accountNamesFromTransactions :: [EntryTransaction] -> [AccountName]
|
||||
accountNamesFromTransactions ts = nub $ map account ts
|
||||
|
||||
ledgerAccountNamesUsed :: RawLedger -> [AccountName]
|
||||
ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
|
||||
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
|
||||
rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l
|
||||
|
||||
ledgerAccountNames :: RawLedger -> [AccountName]
|
||||
ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed
|
||||
rawLedgerAccountNames :: RawLedger -> [AccountName]
|
||||
rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
|
||||
|
||||
ledgerTopAccountNames :: RawLedger -> [AccountName]
|
||||
ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l)
|
||||
rawLedgerTopAccountNames :: RawLedger -> [AccountName]
|
||||
rawLedgerTopAccountNames l = filter (notElem ':') (rawLedgerAccountNames l)
|
||||
|
||||
ledgerAccountNamesMatching :: [String] -> RawLedger -> [AccountName]
|
||||
ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l
|
||||
ledgerAccountNamesMatching acctregexps l =
|
||||
rawLedgerAccountNamesMatching :: [String] -> RawLedger -> [AccountName]
|
||||
rawLedgerAccountNamesMatching [] l = rawLedgerAccountNamesMatching [".*"] l
|
||||
rawLedgerAccountNamesMatching acctregexps l =
|
||||
concat [filter (matchAccountName r) accountNames | r <- acctregexps]
|
||||
where accountNames = ledgerTopAccountNames l
|
||||
where accountNames = rawLedgerTopAccountNames l
|
||||
|
||||
ledgerAccountNameTree :: RawLedger -> Tree AccountName
|
||||
ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l
|
||||
rawLedgerAccountNameTree :: RawLedger -> Tree AccountName
|
||||
rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
|
||||
|
||||
|
||||
|
||||
|
||||
4
Tests.hs
4
Tests.hs
@ -288,7 +288,7 @@ test_ledgerAccountNames =
|
||||
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
|
||||
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
|
||||
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
|
||||
(ledgerAccountNames ledger7)
|
||||
(rawLedgerAccountNames ledger7)
|
||||
|
||||
test_cacheLedger =
|
||||
assertEqual' 14 (length $ Map.keys $ accounts $ cacheLedger ledger7)
|
||||
@ -301,7 +301,7 @@ props = mapM quickCheck
|
||||
parse' ledgertransaction transaction1_str `parseEquals`
|
||||
(Transaction "expenses:food:dining" (Amount (getcurrency "$") 10))
|
||||
,
|
||||
ledgerAccountNames ledger7 ==
|
||||
rawLedgerAccountNames ledger7 ==
|
||||
["assets","assets:cash","assets:checking","assets:saving","equity",
|
||||
"equity:opening balances","expenses","expenses:food","expenses:food:dining",
|
||||
"expenses:phone","expenses:vacation","liabilities","liabilities:credit cards",
|
||||
|
||||
10
hledger.hs
10
hledger.hs
@ -39,7 +39,7 @@ register opts acctpats descpats = do
|
||||
where
|
||||
printRegister l =
|
||||
putStr $ showTransactionsWithBalances
|
||||
(cLedgerTransactionsMatching (acctpats,descpats) l)
|
||||
(ledgerTransactionsMatching (acctpats,descpats) l)
|
||||
0
|
||||
|
||||
balance :: [Flag] -> [String] -> [String] -> IO ()
|
||||
@ -47,7 +47,7 @@ balance opts acctpats _ = do
|
||||
doWithLedger opts printBalance
|
||||
where
|
||||
printBalance l =
|
||||
putStr $ showCLedgerAccounts l acctpats showsubs maxdepth
|
||||
putStr $ showLedgerAccounts l acctpats showsubs maxdepth
|
||||
where
|
||||
showsubs = (ShowSubs `elem` opts)
|
||||
maxdepth = case (acctpats, showsubs) of
|
||||
@ -76,6 +76,6 @@ doWithParsed cmd parsed = do
|
||||
--
|
||||
-- p <- ledgerFilePath [] >>= parseLedgerFile
|
||||
-- let l = either (\_ -> RawLedger [] [] []) id p
|
||||
-- let ant = ledgerAccountNameTree l
|
||||
-- let at = ledgerAccountTreeMatching l [] True 999
|
||||
-- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999
|
||||
-- let ant = rawLedgerAccountNameTree l
|
||||
-- let at = rawLedgerAccountTreeMatching l [] True 999
|
||||
-- putStr $ drawTree $ treemap show $ rawLedgerAccountTreeMatching l ["a"] False 999
|
||||
|
||||
Loading…
Reference in New Issue
Block a user