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