rename Ledger -> RawLedger, CachedLedger -> Ledger
This commit is contained in:
		
							parent
							
								
									df55743697
								
							
						
					
					
						commit
						bd84e95f5e
					
				
							
								
								
									
										26
									
								
								Account.hs
									
									
									
									
									
								
							
							
						
						
									
										26
									
								
								Account.hs
									
									
									
									
									
								
							| @ -9,7 +9,7 @@ import Amount | |||||||
| import Entry | import Entry | ||||||
| import Transaction | import Transaction | ||||||
| import EntryTransaction | import EntryTransaction | ||||||
| import Ledger | import RawLedger | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| -- an Account caches an account's name, balance (including sub-accounts) | -- an Account caches an account's name, balance (including sub-accounts) | ||||||
| @ -20,7 +20,7 @@ instance Show Account where | |||||||
| 
 | 
 | ||||||
| nullacct = Account "" [] nullamt | nullacct = Account "" [] nullamt | ||||||
| 
 | 
 | ||||||
| ledgerAccount :: Ledger -> AccountName -> Account | ledgerAccount :: RawLedger -> AccountName -> Account | ||||||
| ledgerAccount l a =  | ledgerAccount l a =  | ||||||
|     Account  |     Account  | ||||||
|     a  |     a  | ||||||
| @ -29,24 +29,24 @@ ledgerAccount l a = | |||||||
| 
 | 
 | ||||||
| -- queries | -- queries | ||||||
| 
 | 
 | ||||||
| balanceInAccountNamed :: Ledger -> AccountName -> Amount | balanceInAccountNamed :: RawLedger -> AccountName -> Amount | ||||||
| balanceInAccountNamed l a =  | balanceInAccountNamed l a =  | ||||||
|     sumEntryTransactions (transactionsInAccountNamed l a) |     sumEntryTransactions (transactionsInAccountNamed l a) | ||||||
| 
 | 
 | ||||||
| aggregateBalanceInAccountNamed :: Ledger -> AccountName -> Amount | aggregateBalanceInAccountNamed :: RawLedger -> AccountName -> Amount | ||||||
| aggregateBalanceInAccountNamed l a =  | aggregateBalanceInAccountNamed l a =  | ||||||
|     sumEntryTransactions (aggregateTransactionsInAccountNamed l a) |     sumEntryTransactions (aggregateTransactionsInAccountNamed l a) | ||||||
| 
 | 
 | ||||||
| transactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction] | transactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction] | ||||||
| transactionsInAccountNamed l a = | transactionsInAccountNamed l a = | ||||||
|     ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l |     ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l | ||||||
| 
 | 
 | ||||||
| aggregateTransactionsInAccountNamed :: Ledger -> AccountName -> [EntryTransaction] | aggregateTransactionsInAccountNamed :: RawLedger -> AccountName -> [EntryTransaction] | ||||||
| aggregateTransactionsInAccountNamed l a =  | aggregateTransactionsInAccountNamed l a =  | ||||||
|     ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l |     ledgerTransactionsMatching (["^" ++ a ++ "(:.+)?$"], []) l | ||||||
| 
 | 
 | ||||||
| -- build a tree of Accounts | -- build a tree of Accounts | ||||||
| addDataToAccountNameTree :: Ledger -> Tree AccountName -> Tree Account | addDataToAccountNameTree :: RawLedger -> Tree AccountName -> Tree Account | ||||||
| addDataToAccountNameTree l ant =  | addDataToAccountNameTree l ant =  | ||||||
|     Node  |     Node  | ||||||
|     (ledgerAccount l $ root ant)  |     (ledgerAccount l $ root ant)  | ||||||
| @ -92,13 +92,13 @@ addDataToAccountNameTree l ant = | |||||||
| -- $  checking    | -- $  checking    | ||||||
| -- $  saving | -- $  saving | ||||||
| 
 | 
 | ||||||
| showLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String | showLedgerAccounts :: RawLedger -> [String] -> Bool -> Int -> String | ||||||
| showLedgerAccounts l acctpats showsubs maxdepth =  | showLedgerAccounts l acctpats showsubs maxdepth =  | ||||||
|     concatMap  |     concatMap  | ||||||
|     (showAccountTree l)  |     (showAccountTree l)  | ||||||
|     (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) |     (branches (ledgerAccountTreeMatching l acctpats showsubs maxdepth)) | ||||||
| 
 | 
 | ||||||
| ledgerAccountTreeMatching :: Ledger -> [String] -> Bool -> Int -> Tree Account | ledgerAccountTreeMatching :: RawLedger -> [String] -> Bool -> Int -> Tree Account | ||||||
| ledgerAccountTreeMatching l [] showsubs maxdepth =  | ledgerAccountTreeMatching l [] showsubs maxdepth =  | ||||||
|     ledgerAccountTreeMatching l [".*"] showsubs maxdepth |     ledgerAccountTreeMatching l [".*"] showsubs maxdepth | ||||||
| ledgerAccountTreeMatching l acctpats showsubs maxdepth =  | ledgerAccountTreeMatching l acctpats showsubs maxdepth =  | ||||||
| @ -130,7 +130,7 @@ ledgerAccountTreeMatching l acctpats showsubs maxdepth = | |||||||
| -- e | -- e | ||||||
| --   f | --   f | ||||||
| --   g | --   g | ||||||
| showAccountTree :: Ledger -> Tree Account -> String | showAccountTree :: RawLedger -> Tree Account -> String | ||||||
| showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom | showAccountTree l = showAccountTree' l 0 . interestingAccountsFrom | ||||||
| 
 | 
 | ||||||
| showAccountTree' l indentlevel t | showAccountTree' l indentlevel t | ||||||
| @ -149,7 +149,7 @@ showAccountTree' l indentlevel t | |||||||
|       boringparents = takeWhile (isBoringInnerAccountName l) $ parentAccountNames $ aname acct |       boringparents = takeWhile (isBoringInnerAccountName l) $ parentAccountNames $ aname acct | ||||||
|       leafname = accountLeafName $ aname acct |       leafname = accountLeafName $ aname acct | ||||||
| 
 | 
 | ||||||
| isBoringInnerAccount :: Ledger -> Account -> Bool | isBoringInnerAccount :: RawLedger -> Account -> Bool | ||||||
| isBoringInnerAccount l a | isBoringInnerAccount l a | ||||||
|     | name == "top" = False |     | name == "top" = False | ||||||
|     | (length txns == 0) && ((length subs) == 1) = True |     | (length txns == 0) && ((length subs) == 1) = True | ||||||
| @ -160,7 +160,7 @@ isBoringInnerAccount l a | |||||||
|       subs = subAccountNamesFrom (ledgerAccountNames l) name |       subs = subAccountNamesFrom (ledgerAccountNames l) name | ||||||
| 
 | 
 | ||||||
| -- darnit, still need this | -- darnit, still need this | ||||||
| isBoringInnerAccountName :: Ledger -> AccountName -> Bool | isBoringInnerAccountName :: RawLedger -> AccountName -> Bool | ||||||
| isBoringInnerAccountName l name | isBoringInnerAccountName l name | ||||||
|     | name == "top" = False |     | name == "top" = False | ||||||
|     | (length txns == 0) && ((length subs) == 1) = True |     | (length txns == 0) && ((length subs) == 1) = True | ||||||
| @ -176,5 +176,5 @@ interestingAccountsFrom = | |||||||
|       hasbalance = (/= 0) . abalance |       hasbalance = (/= 0) . abalance | ||||||
|       hastxns = (> 0) . length . atransactions |       hastxns = (> 0) . length . atransactions | ||||||
| 
 | 
 | ||||||
| ledgerAccountTree :: Ledger -> Tree Account | ledgerAccountTree :: RawLedger -> Tree Account | ||||||
| ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l) | ledgerAccountTree l = addDataToAccountNameTree l (ledgerAccountNameTree l) | ||||||
|  | |||||||
| @ -1,49 +0,0 @@ | |||||||
| module CachedLedger |  | ||||||
| where |  | ||||||
| import qualified Data.Map as Map |  | ||||||
| 
 |  | ||||||
| import Utils |  | ||||||
| import Types |  | ||||||
| import Account |  | ||||||
| import AccountName |  | ||||||
| import EntryTransaction |  | ||||||
| import Ledger |  | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| cacheLedger :: Ledger -> CachedLedger |  | ||||||
| cacheLedger l =  |  | ||||||
|     CachedLedger  |  | ||||||
|     l |  | ||||||
|     (ledgerAccountNameTree l) |  | ||||||
|     (Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l]) |  | ||||||
| 
 |  | ||||||
| cLedgerTransactions :: CachedLedger -> [EntryTransaction] |  | ||||||
| cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l |  | ||||||
| 
 |  | ||||||
| -- unoptimised |  | ||||||
| cLedgerTransactionsMatching :: ([String],[String]) -> CachedLedger -> [EntryTransaction] |  | ||||||
| cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ uncached_ledger l |  | ||||||
| 
 |  | ||||||
| -- XXX optimise |  | ||||||
| cLedgerTransactionsMatching1 :: ([String],[String]) -> CachedLedger -> [EntryTransaction] |  | ||||||
| cLedgerTransactionsMatching1 ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) (uncached_ledger l) |  | ||||||
| cLedgerTransactionsMatching1 (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) (uncached_ledger l) |  | ||||||
| cLedgerTransactionsMatching1 ([],rs) l = ledgerTransactionsMatching ([".*"],rs) (uncached_ledger l) |  | ||||||
| cLedgerTransactionsMatching1 (acctregexps,descregexps) l = |  | ||||||
|     intersect  |  | ||||||
|     (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) |  | ||||||
|     (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) |  | ||||||
|     where ts = cLedgerTransactions l |  | ||||||
| 
 |  | ||||||
| -- unoptimised |  | ||||||
| showCLedgerAccounts :: CachedLedger -> [String] -> Bool -> Int -> String |  | ||||||
| showCLedgerAccounts l acctpats showsubs maxdepth =  |  | ||||||
|     showLedgerAccounts (uncached_ledger l) acctpats showsubs maxdepth |  | ||||||
| 
 |  | ||||||
| -- XXX optimise |  | ||||||
| showCLedgerAccounts1 :: CachedLedger -> [String] -> Bool -> Int -> String |  | ||||||
| showCLedgerAccounts1 l acctpats showsubs maxdepth =  |  | ||||||
|     concatMap  |  | ||||||
|     (showAccountTree (uncached_ledger l))  |  | ||||||
|     (branches (ledgerAccountTreeMatching (uncached_ledger l) acctpats showsubs maxdepth)) |  | ||||||
| 
 |  | ||||||
							
								
								
									
										71
									
								
								Ledger.hs
									
									
									
									
									
								
							
							
						
						
									
										71
									
								
								Ledger.hs
									
									
									
									
									
								
							| @ -3,54 +3,47 @@ where | |||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
| 
 | 
 | ||||||
| import Utils | import Utils | ||||||
| import AccountName |  | ||||||
| import Types | import Types | ||||||
| import Entry | import Account | ||||||
|  | import AccountName | ||||||
| import EntryTransaction | import EntryTransaction | ||||||
|  | import RawLedger | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| instance Show Ledger where | cacheLedger :: RawLedger -> Ledger | ||||||
|     show l = printf "Ledger with %d entries" | cacheLedger l =  | ||||||
|              ((length $ entries l) + |     Ledger  | ||||||
|               (length $ modifier_entries l) + |     l | ||||||
|               (length $ periodic_entries l)) |     (ledgerAccountNameTree l) | ||||||
|  |     (Map.fromList [(a, ledgerAccount l a) | a <- ledgerAccountNames l]) | ||||||
| 
 | 
 | ||||||
| ledgerTransactions :: Ledger -> [EntryTransaction] | cLedgerTransactions :: Ledger -> [EntryTransaction] | ||||||
| ledgerTransactions l = entryTransactionsFrom $ entries l | cLedgerTransactions l = concatMap atransactions $ Map.elems $ accounts l | ||||||
| 
 | 
 | ||||||
| ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] | -- unoptimised | ||||||
| ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l | cLedgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] | ||||||
| ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l | cLedgerTransactionsMatching pats l = ledgerTransactionsMatching pats $ rawledger l | ||||||
| ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l | 
 | ||||||
| ledgerTransactionsMatching (acctregexps,descregexps) 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 = | ||||||
|     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 = cLedgerTransactions l | ||||||
| 
 |  | ||||||
| ledgerAccountTransactions :: Ledger -> AccountName -> [EntryTransaction] |  | ||||||
| ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l |  | ||||||
|             |  | ||||||
| accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] |  | ||||||
| accountNamesFromTransactions ts = nub $ map account ts |  | ||||||
| 
 |  | ||||||
| ledgerAccountNamesUsed :: Ledger -> [AccountName] |  | ||||||
| ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l |  | ||||||
| 
 |  | ||||||
| ledgerAccountNames :: Ledger -> [AccountName] |  | ||||||
| ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed |  | ||||||
| 
 |  | ||||||
| ledgerTopAccountNames :: Ledger -> [AccountName] |  | ||||||
| ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l) |  | ||||||
| 
 |  | ||||||
| ledgerAccountNamesMatching :: [String] -> Ledger -> [AccountName] |  | ||||||
| ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l |  | ||||||
| ledgerAccountNamesMatching acctregexps l = |  | ||||||
|     concat [filter (matchAccountName r) accountNames | r <- acctregexps] |  | ||||||
|         where accountNames = ledgerTopAccountNames l |  | ||||||
| 
 |  | ||||||
| ledgerAccountNameTree :: Ledger -> Tree AccountName |  | ||||||
| ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l |  | ||||||
| 
 | 
 | ||||||
|  | -- unoptimised | ||||||
|  | showCLedgerAccounts :: Ledger -> [String] -> Bool -> Int -> String | ||||||
|  | showCLedgerAccounts l acctpats showsubs maxdepth =  | ||||||
|  |     showLedgerAccounts (rawledger l) acctpats showsubs maxdepth | ||||||
| 
 | 
 | ||||||
|  | -- XXX optimise | ||||||
|  | showCLedgerAccounts1 :: Ledger -> [String] -> Bool -> Int -> String | ||||||
|  | showCLedgerAccounts1 l acctpats showsubs maxdepth =  | ||||||
|  |     concatMap  | ||||||
|  |     (showAccountTree (rawledger l))  | ||||||
|  |     (branches (ledgerAccountTreeMatching (rawledger l) acctpats showsubs maxdepth)) | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -8,9 +8,9 @@ module Models ( | |||||||
|                module Entry, |                module Entry, | ||||||
|                module TimeLog, |                module TimeLog, | ||||||
|                module EntryTransaction, |                module EntryTransaction, | ||||||
|                module Ledger, |                module RawLedger, | ||||||
|                module Account, |                module Account, | ||||||
|                module CachedLedger, |                module Ledger, | ||||||
|               ) |               ) | ||||||
| where | where | ||||||
| import qualified Data.Map as Map | import qualified Data.Map as Map | ||||||
| @ -23,7 +23,7 @@ import Transaction | |||||||
| import Entry | import Entry | ||||||
| import TimeLog | import TimeLog | ||||||
| import EntryTransaction | import EntryTransaction | ||||||
| import Ledger | import RawLedger | ||||||
| import Account | import Account | ||||||
| import CachedLedger | import Ledger | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										10
									
								
								Parse.hs
									
									
									
									
									
								
							
							
						
						
									
										10
									
								
								Parse.hs
									
									
									
									
									
								
							| @ -36,7 +36,7 @@ reserved   = P.reserved lexer | |||||||
| reservedOp = P.reservedOp lexer | reservedOp = P.reservedOp lexer | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| ledgerfile :: Parser Ledger | ledgerfile :: Parser RawLedger | ||||||
| ledgerfile = ledger <|> ledgerfromtimelog | ledgerfile = ledger <|> ledgerfromtimelog | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| @ -141,7 +141,7 @@ i, o, b, h | |||||||
| -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs | -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs | ||||||
| -- sample data in Tests.hs  | -- sample data in Tests.hs  | ||||||
| 
 | 
 | ||||||
| ledger :: Parser Ledger | ledger :: Parser RawLedger | ||||||
| ledger = do | ledger = do | ||||||
|   ledgernondatalines |   ledgernondatalines | ||||||
|   -- for now these must come first, unlike ledger |   -- for now these must come first, unlike ledger | ||||||
| @ -150,7 +150,7 @@ ledger = do | |||||||
|   -- |   -- | ||||||
|   entries <- (many ledgerentry) <?> "entry" |   entries <- (many ledgerentry) <?> "entry" | ||||||
|   eof |   eof | ||||||
|   return $ Ledger modifier_entries periodic_entries entries |   return $ RawLedger modifier_entries periodic_entries entries | ||||||
| 
 | 
 | ||||||
| ledgernondatalines :: Parser [String] | ledgernondatalines :: Parser [String] | ||||||
| ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) | ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) | ||||||
| @ -287,7 +287,7 @@ o 2007/03/10 17:26:02 | |||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
| ledgerfromtimelog :: Parser Ledger | ledgerfromtimelog :: Parser RawLedger | ||||||
| ledgerfromtimelog = do  | ledgerfromtimelog = do  | ||||||
|   tl <- timelog |   tl <- timelog | ||||||
|   return $ ledgerFromTimeLog tl |   return $ ledgerFromTimeLog tl | ||||||
| @ -320,7 +320,7 @@ printParseResult :: Show v => Either ParseError v -> IO () | |||||||
| printParseResult r = case r of Left e -> parseError e | printParseResult r = case r of Left e -> parseError e | ||||||
|                                Right v -> print v |                                Right v -> print v | ||||||
| 
 | 
 | ||||||
| parseLedgerFile :: String -> IO (Either ParseError Ledger) | parseLedgerFile :: String -> IO (Either ParseError RawLedger) | ||||||
| parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin | parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin | ||||||
| parseLedgerFile f   = parseFromFile ledgerfile f | parseLedgerFile f   = parseFromFile ledgerfile f | ||||||
|      |      | ||||||
|  | |||||||
							
								
								
									
										56
									
								
								RawLedger.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										56
									
								
								RawLedger.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,56 @@ | |||||||
|  | module RawLedger | ||||||
|  | where | ||||||
|  | import qualified Data.Map as Map | ||||||
|  | 
 | ||||||
|  | import Utils | ||||||
|  | import AccountName | ||||||
|  | import Types | ||||||
|  | import Entry | ||||||
|  | import EntryTransaction | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | instance Show RawLedger where | ||||||
|  |     show l = printf "RawLedger with %d entries" | ||||||
|  |              ((length $ entries l) + | ||||||
|  |               (length $ modifier_entries l) + | ||||||
|  |               (length $ periodic_entries l)) | ||||||
|  | 
 | ||||||
|  | ledgerTransactions :: RawLedger -> [EntryTransaction] | ||||||
|  | ledgerTransactions 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 = | ||||||
|  |     intersect  | ||||||
|  |     (concat [filter (matchTransactionAccount r) ts | r <- acctregexps]) | ||||||
|  |     (concat [filter (matchTransactionDescription r) ts | r <- descregexps]) | ||||||
|  |     where ts = ledgerTransactions l | ||||||
|  | 
 | ||||||
|  | ledgerAccountTransactions :: RawLedger -> AccountName -> [EntryTransaction] | ||||||
|  | ledgerAccountTransactions l a = ledgerTransactionsMatching (["^" ++ a ++ "$"], []) l | ||||||
|  |             | ||||||
|  | accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] | ||||||
|  | accountNamesFromTransactions ts = nub $ map account ts | ||||||
|  | 
 | ||||||
|  | ledgerAccountNamesUsed :: RawLedger -> [AccountName] | ||||||
|  | ledgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l | ||||||
|  | 
 | ||||||
|  | ledgerAccountNames :: RawLedger -> [AccountName] | ||||||
|  | ledgerAccountNames = sort . expandAccountNames . ledgerAccountNamesUsed | ||||||
|  | 
 | ||||||
|  | ledgerTopAccountNames :: RawLedger -> [AccountName] | ||||||
|  | ledgerTopAccountNames l = filter (notElem ':') (ledgerAccountNames l) | ||||||
|  | 
 | ||||||
|  | ledgerAccountNamesMatching :: [String] -> RawLedger -> [AccountName] | ||||||
|  | ledgerAccountNamesMatching [] l = ledgerAccountNamesMatching [".*"] l | ||||||
|  | ledgerAccountNamesMatching acctregexps l = | ||||||
|  |     concat [filter (matchAccountName r) accountNames | r <- acctregexps] | ||||||
|  |         where accountNames = ledgerTopAccountNames l | ||||||
|  | 
 | ||||||
|  | ledgerAccountNameTree :: RawLedger -> Tree AccountName | ||||||
|  | ledgerAccountNameTree l = accountNameTreeFrom $ ledgerAccountNames l | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
							
								
								
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -155,7 +155,7 @@ ledger7_str = "\ | |||||||
| \\n" --" | \\n" --" | ||||||
| 
 | 
 | ||||||
| l = ledger7 | l = ledger7 | ||||||
| ledger7 = Ledger | ledger7 = RawLedger | ||||||
|           []  |           []  | ||||||
|           []  |           []  | ||||||
|           [ |           [ | ||||||
|  | |||||||
| @ -6,7 +6,7 @@ import Currency | |||||||
| import Amount | import Amount | ||||||
| import Transaction | import Transaction | ||||||
| import Entry | import Entry | ||||||
| import Ledger | import RawLedger | ||||||
| 
 | 
 | ||||||
| instance Show TimeLogEntry where  | instance Show TimeLogEntry where  | ||||||
|     show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t) |     show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t) | ||||||
| @ -14,9 +14,9 @@ instance Show TimeLogEntry where | |||||||
| instance Show TimeLog where | instance Show TimeLog where | ||||||
|     show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl |     show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl | ||||||
| 
 | 
 | ||||||
| ledgerFromTimeLog :: TimeLog -> Ledger | ledgerFromTimeLog :: TimeLog -> RawLedger | ||||||
| ledgerFromTimeLog tl =  | ledgerFromTimeLog tl =  | ||||||
|     Ledger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) |     RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) | ||||||
| 
 | 
 | ||||||
| entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry] | entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry] | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										12
									
								
								Types.hs
									
									
									
									
									
								
							
							
						
						
									
										12
									
								
								Types.hs
									
									
									
									
									
								
							| @ -17,9 +17,9 @@ hledger | |||||||
|    Models |    Models | ||||||
|     TimeLog |     TimeLog | ||||||
|      TimeLogEntry |      TimeLogEntry | ||||||
|     CachedLedger |     Ledger | ||||||
|      Account |      Account | ||||||
|       Ledger |       RawLedger | ||||||
|        EntryTransaction |        EntryTransaction | ||||||
|         Entry |         Entry | ||||||
|          Transaction |          Transaction | ||||||
| @ -92,7 +92,7 @@ data TimeLog = TimeLog { | |||||||
|     } deriving (Eq) |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| -- a parsed ledger file | -- a parsed ledger file | ||||||
| data Ledger = Ledger { | data RawLedger = RawLedger { | ||||||
|       modifier_entries :: [ModifierEntry], |       modifier_entries :: [ModifierEntry], | ||||||
|       periodic_entries :: [PeriodicEntry], |       periodic_entries :: [PeriodicEntry], | ||||||
|       entries :: [Entry] |       entries :: [Entry] | ||||||
| @ -104,7 +104,7 @@ data Ledger = Ledger { | |||||||
| -- "transactions" in modules above EntryTransaction. | -- "transactions" in modules above EntryTransaction. | ||||||
| type EntryTransaction = (Entry,Transaction) | type EntryTransaction = (Entry,Transaction) | ||||||
| 
 | 
 | ||||||
| -- all information for a particular account, derived from a Ledger | -- all information for a particular account, derived from a RawLedger | ||||||
| data Account = Account { | data Account = Account { | ||||||
|       aname :: AccountName,  |       aname :: AccountName,  | ||||||
|       atransactions :: [EntryTransaction], -- excludes sub-accounts |       atransactions :: [EntryTransaction], -- excludes sub-accounts | ||||||
| @ -112,8 +112,8 @@ data Account = Account { | |||||||
|     } |     } | ||||||
| 
 | 
 | ||||||
| -- a ledger with account info cached for faster queries | -- a ledger with account info cached for faster queries | ||||||
| data CachedLedger = CachedLedger { | data Ledger = Ledger { | ||||||
|       uncached_ledger :: Ledger,  |       rawledger :: RawLedger,  | ||||||
|       accountnames :: Tree AccountName, |       accountnames :: Tree AccountName, | ||||||
|       accounts :: Map.Map AccountName Account |       accounts :: Map.Map AccountName Account | ||||||
|     } |     } | ||||||
|  | |||||||
| @ -63,11 +63,11 @@ selftest = do | |||||||
| 
 | 
 | ||||||
| -- utils | -- utils | ||||||
| 
 | 
 | ||||||
| doWithLedger :: [Flag] -> (CachedLedger -> IO ()) -> IO () | doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO () | ||||||
| doWithLedger opts cmd = do | doWithLedger opts cmd = do | ||||||
|     ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd |     ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd | ||||||
| 
 | 
 | ||||||
| doWithParsed :: (CachedLedger -> IO ()) -> (Either ParseError Ledger) -> IO () | doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO () | ||||||
| doWithParsed cmd parsed = do | doWithParsed cmd parsed = do | ||||||
|   case parsed of Left e -> parseError e |   case parsed of Left e -> parseError e | ||||||
|                  Right l -> cmd $ cacheLedger l |                  Right l -> cmd $ cacheLedger l | ||||||
| @ -75,7 +75,7 @@ doWithParsed cmd parsed = do | |||||||
| -- interactive testing: | -- interactive testing: | ||||||
| -- | -- | ||||||
| -- p <- ledgerFilePath [] >>= parseLedgerFile | -- p <- ledgerFilePath [] >>= parseLedgerFile | ||||||
| -- let l = either (\_ -> Ledger [] [] []) id p | -- let l = either (\_ -> RawLedger [] [] []) id p | ||||||
| -- let ant = ledgerAccountNameTree l | -- let ant = ledgerAccountNameTree l | ||||||
| -- let at = ledgerAccountTreeMatching l [] True 999 | -- let at = ledgerAccountTreeMatching l [] True 999 | ||||||
| -- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999 | -- putStr $ drawTree $ treemap show $ ledgerAccountTreeMatching l ["a"] False 999 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user