rename ledger functions
This commit is contained in:
parent
bd84e95f5e
commit
362d3831ea
34
Account.hs
34
Account.hs
@ -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)
|
||||||
|
|||||||
36
Ledger.hs
36
Ledger.hs
@ -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))
|
||||||
|
|
||||||
|
|||||||
44
RawLedger.hs
44
RawLedger.hs
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
4
Tests.hs
4
Tests.hs
@ -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",
|
||||||
|
|||||||
10
hledger.hs
10
hledger.hs
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user