renamed types: RawLedger, Entry, Transaction, EntryTransaction -> LedgerFile, LedgerEntry, LedgerTransaction, Transaction
This commit is contained in:
		
							parent
							
								
									0d8bd83b7f
								
							
						
					
					
						commit
						a1b060f4cf
					
				| @ -4,9 +4,9 @@ import Utils | ||||
| import Types | ||||
| import AccountName | ||||
| import Amount | ||||
| import Entry | ||||
| import LedgerEntry | ||||
| import LedgerTransaction | ||||
| import Transaction | ||||
| import EntryTransaction | ||||
| 
 | ||||
| 
 | ||||
| instance Show Account where | ||||
|  | ||||
| @ -1,81 +0,0 @@ | ||||
| module EntryTransaction | ||||
| where | ||||
| import Utils | ||||
| import Types | ||||
| import AccountName | ||||
| import Entry | ||||
| import Transaction | ||||
| import Amount | ||||
| import Currency | ||||
| 
 | ||||
| 
 | ||||
| entry       (e,t) = e | ||||
| transaction (e,t) = t | ||||
| date        (e,t) = edate e | ||||
| status      (e,t) = estatus e | ||||
| code        (e,t) = ecode e | ||||
| description (e,t) = edescription e | ||||
| account     (e,t) = taccount t | ||||
| amount      (e,t) = tamount t | ||||
|                                           | ||||
| flattenEntry :: Entry -> [EntryTransaction] | ||||
| flattenEntry e = [(e,t) | t <- etransactions e] | ||||
| 
 | ||||
| entryTransactionSetPrecision :: Int -> EntryTransaction -> EntryTransaction | ||||
| entryTransactionSetPrecision p (e, Transaction a amt) = (e, Transaction a amt{precision=p}) | ||||
| 
 | ||||
| accountNamesFromTransactions :: [EntryTransaction] -> [AccountName] | ||||
| accountNamesFromTransactions ts = nub $ map account ts | ||||
| 
 | ||||
| entryTransactionsFrom :: [Entry] -> [EntryTransaction] | ||||
| entryTransactionsFrom es = concat $ map flattenEntry es | ||||
| 
 | ||||
| sumEntryTransactions :: [EntryTransaction] -> Amount | ||||
| sumEntryTransactions ets =  | ||||
|     sumTransactions $ map transaction ets | ||||
| 
 | ||||
| matchTransactionAccount :: Regex -> EntryTransaction -> Bool | ||||
| matchTransactionAccount r t = | ||||
|     case matchRegex r (account t) of | ||||
|       Nothing -> False | ||||
|       otherwise -> True | ||||
| 
 | ||||
| matchTransactionDescription :: Regex -> EntryTransaction -> Bool | ||||
| matchTransactionDescription r t = | ||||
|     case matchRegex r (description t) of | ||||
|       Nothing -> False | ||||
|       otherwise -> True | ||||
| 
 | ||||
| -- for register command  | ||||
| 
 | ||||
| showTransactionsWithBalances :: [EntryTransaction] -> Amount -> String | ||||
| showTransactionsWithBalances [] _ = [] | ||||
| showTransactionsWithBalances ts b = | ||||
|     unlines $ showTransactionsWithBalances' ts dummyt b | ||||
|         where | ||||
|           dummyt = (Entry "" False "" "" [], Transaction "" (dollars 0)) | ||||
|           showTransactionsWithBalances' [] _ _ = [] | ||||
|           showTransactionsWithBalances' (t:ts) tprev b = | ||||
|               (if (entry t /= (entry tprev)) | ||||
|                then [showTransactionDescriptionAndBalance t b'] | ||||
|                else [showTransactionAndBalance t b']) | ||||
|               ++ (showTransactionsWithBalances' ts t b') | ||||
|                   where b' = b + (amount t) | ||||
| 
 | ||||
| showTransactionDescriptionAndBalance :: EntryTransaction -> Amount -> String | ||||
| showTransactionDescriptionAndBalance t b = | ||||
|     (showEntryDescription $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) | ||||
| 
 | ||||
| showTransactionAndBalance :: EntryTransaction -> Amount -> String | ||||
| showTransactionAndBalance t b = | ||||
|     (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b) | ||||
| 
 | ||||
| showBalance :: Amount -> String | ||||
| showBalance b = printf " %12s" (showAmountRoundedOrZero b) | ||||
| 
 | ||||
| transactionsWithAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] | ||||
| transactionsWithAccountName a ts = [t | t <- ts, account t == a] | ||||
|      | ||||
| transactionsWithOrBelowAccountName :: AccountName -> [EntryTransaction] -> [EntryTransaction] | ||||
| transactionsWithOrBelowAccountName a ts =  | ||||
|     [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)] | ||||
							
								
								
									
										18
									
								
								Ledger.hs
									
									
									
									
									
								
							
							
						
						
									
										18
									
								
								Ledger.hs
									
									
									
									
									
								
							| @ -7,20 +7,20 @@ import Types | ||||
| import Amount | ||||
| import Account | ||||
| import AccountName | ||||
| import EntryTransaction | ||||
| import RawLedger | ||||
| import Transaction | ||||
| import LedgerFile | ||||
| 
 | ||||
| 
 | ||||
| rawLedgerTransactions :: RawLedger -> [EntryTransaction] | ||||
| rawLedgerTransactions :: LedgerFile -> [Transaction] | ||||
| rawLedgerTransactions l = entryTransactionsFrom $ entries l | ||||
| 
 | ||||
| rawLedgerAccountNamesUsed :: RawLedger -> [AccountName] | ||||
| rawLedgerAccountNamesUsed :: LedgerFile -> [AccountName] | ||||
| rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l | ||||
| 
 | ||||
| rawLedgerAccountNames :: RawLedger -> [AccountName] | ||||
| rawLedgerAccountNames :: LedgerFile -> [AccountName] | ||||
| rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed | ||||
| 
 | ||||
| rawLedgerAccountNameTree :: RawLedger -> Tree AccountName | ||||
| rawLedgerAccountNameTree :: LedgerFile -> Tree AccountName | ||||
| rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l | ||||
| 
 | ||||
| 
 | ||||
| @ -33,7 +33,7 @@ instance Show Ledger where | ||||
| 
 | ||||
| -- at startup, we augment the parsed ledger entries with an account map | ||||
| -- and other things useful for performance | ||||
| cacheLedger :: RawLedger -> Ledger | ||||
| cacheLedger :: LedgerFile -> Ledger | ||||
| cacheLedger l =  | ||||
|     let  | ||||
|         ant = rawLedgerAccountNameTree l | ||||
| @ -65,13 +65,13 @@ ledgerAccount l a = (accounts l) ! a | ||||
| -- amount, to help with report output. It should perhaps be done in the | ||||
| -- display functions, but those are far removed from the ledger. Keep in | ||||
| -- mind if doing more arithmetic with these. | ||||
| ledgerTransactions :: Ledger -> [EntryTransaction] | ||||
| ledgerTransactions :: Ledger -> [Transaction] | ||||
| ledgerTransactions l =  | ||||
|     setprecisions $ rawLedgerTransactions $ rawledger l | ||||
|     where | ||||
|       setprecisions = map (entryTransactionSetPrecision (lprecision l)) | ||||
| 
 | ||||
| ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [EntryTransaction] | ||||
| ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction] | ||||
| ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l | ||||
| ledgerTransactionsMatching (rs,[]) l = ledgerTransactionsMatching (rs,[".*"]) l | ||||
| ledgerTransactionsMatching ([],rs) l = ledgerTransactionsMatching ([".*"],rs) l | ||||
|  | ||||
| @ -1,13 +1,13 @@ | ||||
| 
 | ||||
| module Entry | ||||
| module LedgerEntry | ||||
| where | ||||
| import Utils | ||||
| import Types | ||||
| import Transaction | ||||
| import LedgerTransaction | ||||
| import Amount | ||||
| 
 | ||||
| 
 | ||||
| instance Show Entry where show = showEntryDescription | ||||
| instance Show LedgerEntry where show = showEntryDescription | ||||
| 
 | ||||
| -- for register report | ||||
| -- | ||||
| @ -26,12 +26,12 @@ showEntryDescription e = (showDate $ edate e) ++ " " ++ (showDescription $ edesc | ||||
| showDate d = printf "%-10s" d | ||||
| showDescription s = printf "%-20s" (elideRight 20 s) | ||||
| 
 | ||||
| isEntryBalanced :: Entry -> Bool | ||||
| isEntryBalanced :: LedgerEntry -> Bool | ||||
| isEntryBalanced e = (sumTransactions . etransactions) e == 0 | ||||
| 
 | ||||
| autofillEntry :: Entry -> Entry | ||||
| autofillEntry :: LedgerEntry -> LedgerEntry | ||||
| autofillEntry e =  | ||||
|     Entry (edate e) (estatus e) (ecode e) (edescription e) | ||||
|     LedgerEntry (edate e) (estatus e) (ecode e) (edescription e) | ||||
|               (autofillTransactions (etransactions e)) | ||||
| 
 | ||||
| -- the print command shows cleaned up ledger file entries, something like: | ||||
| @ -46,7 +46,7 @@ autofillEntry e = | ||||
| -- amtwidth     = 11 | ||||
| -- commentwidth = 20 | ||||
| 
 | ||||
| showEntry :: Entry -> String | ||||
| showEntry :: LedgerEntry -> String | ||||
| showEntry e =  | ||||
|     unlines $ ["", description] ++ (showtxns $ etransactions e) | ||||
|     where | ||||
| @ -63,12 +63,12 @@ showEntry e = | ||||
|       showamount = printf "%11s" . showAmountRounded | ||||
|       showaccountname = printf "%-35s" . elideRight 35 | ||||
| 
 | ||||
| showEntries :: [Entry] -> String | ||||
| showEntries :: [LedgerEntry] -> String | ||||
| showEntries = concatMap showEntry | ||||
| 
 | ||||
| entrySetPrecision :: Int -> Entry -> Entry | ||||
| entrySetPrecision p (Entry d s c desc ts) =  | ||||
|     Entry d s c desc $ map (transactionSetPrecision p) ts | ||||
| entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry | ||||
| entrySetPrecision p (LedgerEntry d s c desc ts) =  | ||||
|     LedgerEntry d s c desc $ map (transactionSetPrecision p) ts | ||||
|                  | ||||
| 
 | ||||
| -- modifier & periodic entries | ||||
| @ -1,15 +1,15 @@ | ||||
| module RawLedger | ||||
| module LedgerFile | ||||
| where | ||||
| import qualified Data.Map as Map | ||||
| 
 | ||||
| import Utils | ||||
| import Types | ||||
| import AccountName | ||||
| import Entry | ||||
| import LedgerEntry | ||||
| 
 | ||||
| 
 | ||||
| instance Show RawLedger where | ||||
|     show l = printf "RawLedger with %d entries" | ||||
| instance Show LedgerFile where | ||||
|     show l = printf "LedgerFile with %d entries" | ||||
|              ((length $ entries l) + | ||||
|               (length $ modifier_entries l) + | ||||
|               (length $ periodic_entries l)) | ||||
							
								
								
									
										37
									
								
								LedgerTransaction.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										37
									
								
								LedgerTransaction.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,37 @@ | ||||
| 
 | ||||
| module LedgerTransaction | ||||
| where | ||||
| import Utils | ||||
| import Types | ||||
| import AccountName | ||||
| import Amount | ||||
| 
 | ||||
| 
 | ||||
| instance Show LedgerTransaction where show = showTransaction | ||||
| 
 | ||||
| showTransaction :: LedgerTransaction -> String | ||||
| showTransaction t = (showaccountname $ taccount t) ++ "  " ++ (showamount $ tamount t)  | ||||
|     where | ||||
|       showaccountname = printf "%-22s" . elideRight 22 | ||||
|       showamount = printf "%11s" . showAmountRoundedOrZero | ||||
| 
 | ||||
| elideRight width s = | ||||
|     case length s > width of | ||||
|       True -> take (width - 2) s ++ ".." | ||||
|       False -> s | ||||
| 
 | ||||
| autofillTransactions :: [LedgerTransaction] -> [LedgerTransaction] | ||||
| autofillTransactions ts = | ||||
|     let (ns, as) = partition isNormal ts | ||||
|             where isNormal t = (symbol $ currency $ tamount t) /= "AUTO" in | ||||
|     case (length as) of | ||||
|       0 -> ns | ||||
|       1 -> ns ++ [balanceTransaction $ head as] | ||||
|           where balanceTransaction t = t{tamount = -(sumTransactions ns)} | ||||
|       otherwise -> error "too many blank transactions in this entry" | ||||
| 
 | ||||
| sumTransactions :: [LedgerTransaction] -> Amount | ||||
| sumTransactions = sum . map tamount | ||||
| 
 | ||||
| transactionSetPrecision :: Int -> LedgerTransaction -> LedgerTransaction | ||||
| transactionSetPrecision p (LedgerTransaction a amt) = LedgerTransaction a amt{precision=p} | ||||
							
								
								
									
										16
									
								
								Models.hs
									
									
									
									
									
								
							
							
						
						
									
										16
									
								
								Models.hs
									
									
									
									
									
								
							| @ -4,11 +4,11 @@ module Models ( | ||||
|                module Currency, | ||||
|                module Amount, | ||||
|                module AccountName, | ||||
|                module Transaction, | ||||
|                module Entry, | ||||
|                module LedgerTransaction, | ||||
|                module LedgerEntry, | ||||
|                module TimeLog, | ||||
|                module EntryTransaction, | ||||
|                module RawLedger, | ||||
|                module Transaction, | ||||
|                module LedgerFile, | ||||
|                module Account, | ||||
|                module Ledger, | ||||
|               ) | ||||
| @ -19,11 +19,11 @@ import Types | ||||
| import Currency | ||||
| import Amount | ||||
| import AccountName | ||||
| import Transaction | ||||
| import Entry | ||||
| import LedgerTransaction | ||||
| import LedgerEntry | ||||
| import TimeLog | ||||
| import EntryTransaction | ||||
| import RawLedger | ||||
| import Transaction | ||||
| import LedgerFile | ||||
| import Account | ||||
| import Ledger | ||||
| 
 | ||||
|  | ||||
							
								
								
									
										20
									
								
								Parse.hs
									
									
									
									
									
								
							
							
						
						
									
										20
									
								
								Parse.hs
									
									
									
									
									
								
							| @ -137,10 +137,10 @@ i, o, b, h | ||||
| -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs | ||||
| -- sample data in Tests.hs  | ||||
| 
 | ||||
| ledgerfile :: Parser RawLedger | ||||
| ledgerfile :: Parser LedgerFile | ||||
| ledgerfile = ledger <|> ledgerfromtimelog | ||||
| 
 | ||||
| ledger :: Parser RawLedger | ||||
| ledger :: Parser LedgerFile | ||||
| ledger = do | ||||
|   ledgernondatalines | ||||
|   -- for now these must come first, unlike ledger | ||||
| @ -149,7 +149,7 @@ ledger = do | ||||
|   -- | ||||
|   entries <- (many ledgerentry) <?> "entry" | ||||
|   eof | ||||
|   return $ RawLedger modifier_entries periodic_entries entries | ||||
|   return $ LedgerFile modifier_entries periodic_entries entries | ||||
| 
 | ||||
| ledgernondatalines :: Parser [String] | ||||
| ledgernondatalines = many (ledgerdirective <|> ledgercomment <|> do {whiteSpace1; return []}) | ||||
| @ -178,7 +178,7 @@ ledgerperiodicentry = do | ||||
|   ledgernondatalines | ||||
|   return (PeriodicEntry periodexpr transactions) | ||||
| 
 | ||||
| ledgerentry :: Parser Entry | ||||
| ledgerentry :: Parser LedgerEntry | ||||
| ledgerentry = do | ||||
|   date <- ledgerdate | ||||
|   status <- ledgerstatus | ||||
| @ -186,7 +186,7 @@ ledgerentry = do | ||||
|   description <- anyChar `manyTill` ledgereol | ||||
|   transactions <- ledgertransactions | ||||
|   ledgernondatalines | ||||
|   return $ autofillEntry $ Entry date status code description transactions | ||||
|   return $ autofillEntry $ LedgerEntry date status code description transactions | ||||
| 
 | ||||
| ledgerdate :: Parser String | ||||
| ledgerdate = do  | ||||
| @ -204,10 +204,10 @@ ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> ret | ||||
| ledgercode :: Parser String | ||||
| ledgercode = try (do { char '('; code <- anyChar `manyTill` char ')'; many1 spacenonewline; return code } ) <|> return "" | ||||
| 
 | ||||
| ledgertransactions :: Parser [Transaction] | ||||
| ledgertransactions :: Parser [LedgerTransaction] | ||||
| ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (do {newline <?> "blank line"; return ()} <|> eof) | ||||
| 
 | ||||
| ledgertransaction :: Parser Transaction | ||||
| ledgertransaction :: Parser LedgerTransaction | ||||
| ledgertransaction = do | ||||
|   many1 spacenonewline | ||||
|   account <- ledgeraccount | ||||
| @ -215,7 +215,7 @@ ledgertransaction = do | ||||
|   many spacenonewline | ||||
|   ledgereol | ||||
|   many ledgercomment | ||||
|   return (Transaction account amount) | ||||
|   return (LedgerTransaction account amount) | ||||
| 
 | ||||
| -- account names may have single spaces in them, and are terminated by two or more spaces | ||||
| ledgeraccount :: Parser String | ||||
| @ -289,7 +289,7 @@ o 2007/03/10 17:26:02 | ||||
| 
 | ||||
| -} | ||||
| 
 | ||||
| ledgerfromtimelog :: Parser RawLedger | ||||
| ledgerfromtimelog :: Parser LedgerFile | ||||
| ledgerfromtimelog = do  | ||||
|   tl <- timelog | ||||
|   return $ ledgerFromTimeLog tl | ||||
| @ -322,7 +322,7 @@ printParseResult :: Show v => Either ParseError v -> IO () | ||||
| printParseResult r = case r of Left e -> parseError e | ||||
|                                Right v -> print v | ||||
| 
 | ||||
| parseLedgerFile :: String -> IO (Either ParseError RawLedger) | ||||
| parseLedgerFile :: String -> IO (Either ParseError LedgerFile) | ||||
| parseLedgerFile "-" = fmap (parse ledgerfile "-") $ hGetContents stdin | ||||
| parseLedgerFile f   = parseFromFile ledgerfile f | ||||
|      | ||||
|  | ||||
							
								
								
									
										46
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										46
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -65,7 +65,7 @@ parseEqual parsed other = | ||||
| 
 | ||||
| transaction1_str  = "  expenses:food:dining  $10.00\n" | ||||
| 
 | ||||
| transaction1 = Transaction "expenses:food:dining" (dollars 10) | ||||
| transaction1 = LedgerTransaction "expenses:food:dining" (dollars 10) | ||||
| 
 | ||||
| entry1_str = "\ | ||||
| \2007/01/28 coopportunity\n\ | ||||
| @ -74,9 +74,9 @@ entry1_str = "\ | ||||
| \\n" --" | ||||
| 
 | ||||
| entry1 = | ||||
|     (Entry "2007/01/28" False "" "coopportunity"  | ||||
|                [Transaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2),  | ||||
|                 Transaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2)]) | ||||
|     (LedgerEntry "2007/01/28" False "" "coopportunity"  | ||||
|                [LedgerTransaction "expenses:food:groceries" (Amount (getcurrency "$") 47.18 2),  | ||||
|                 LedgerTransaction "assets:checking" (Amount (getcurrency "$") (-47.18) 2)]) | ||||
| 
 | ||||
| entry2_str = "\ | ||||
| \2007/01/27 * joes diner\n\ | ||||
| @ -206,66 +206,66 @@ ledger7_str = "\ | ||||
| \    assets:checking                                 \n\ | ||||
| \\n" --" | ||||
| 
 | ||||
| ledger7 = RawLedger | ||||
| ledger7 = LedgerFile | ||||
|           []  | ||||
|           []  | ||||
|           [ | ||||
|            Entry { | ||||
|            LedgerEntry { | ||||
|                   edate="2007/01/01", estatus=False, ecode="*", edescription="opening balance", | ||||
|                   etransactions=[ | ||||
|                                 Transaction {taccount="assets:cash",  | ||||
|                                 LedgerTransaction {taccount="assets:cash",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}}, | ||||
|                                 Transaction {taccount="equity:opening balances",  | ||||
|                                 LedgerTransaction {taccount="equity:opening balances",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}} | ||||
|                                ] | ||||
|                  } | ||||
|           , | ||||
|            Entry { | ||||
|            LedgerEntry { | ||||
|                   edate="2007/02/01", estatus=False, ecode="*", edescription="ayres suites", | ||||
|                   etransactions=[ | ||||
|                                 Transaction {taccount="expenses:vacation",  | ||||
|                                 LedgerTransaction {taccount="expenses:vacation",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=179.92, precision=2}}, | ||||
|                                 Transaction {taccount="assets:checking",  | ||||
|                                 LedgerTransaction {taccount="assets:checking",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=(-179.92), precision=2}} | ||||
|                                ] | ||||
|                  } | ||||
|           , | ||||
|            Entry { | ||||
|            LedgerEntry { | ||||
|                   edate="2007/01/02", estatus=False, ecode="*", edescription="auto transfer to savings", | ||||
|                   etransactions=[ | ||||
|                                 Transaction {taccount="assets:saving",  | ||||
|                                 LedgerTransaction {taccount="assets:saving",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=200, precision=2}}, | ||||
|                                 Transaction {taccount="assets:checking",  | ||||
|                                 LedgerTransaction {taccount="assets:checking",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=(-200), precision=2}} | ||||
|                                ] | ||||
|                  } | ||||
|           , | ||||
|            Entry { | ||||
|            LedgerEntry { | ||||
|                   edate="2007/01/03", estatus=False, ecode="*", edescription="poquito mas", | ||||
|                   etransactions=[ | ||||
|                                 Transaction {taccount="expenses:food:dining",  | ||||
|                                 LedgerTransaction {taccount="expenses:food:dining",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=4.82, precision=2}}, | ||||
|                                 Transaction {taccount="assets:cash",  | ||||
|                                 LedgerTransaction {taccount="assets:cash",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=(-4.82), precision=2}} | ||||
|                                ] | ||||
|                  } | ||||
|           , | ||||
|            Entry { | ||||
|            LedgerEntry { | ||||
|                   edate="2007/01/03", estatus=False, ecode="*", edescription="verizon", | ||||
|                   etransactions=[ | ||||
|                                 Transaction {taccount="expenses:phone",  | ||||
|                                 LedgerTransaction {taccount="expenses:phone",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=95.11, precision=2}}, | ||||
|                                 Transaction {taccount="assets:checking",  | ||||
|                                 LedgerTransaction {taccount="assets:checking",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=(-95.11), precision=2}} | ||||
|                                ] | ||||
|                  } | ||||
|           , | ||||
|            Entry { | ||||
|            LedgerEntry { | ||||
|                   edate="2007/01/03", estatus=False, ecode="*", edescription="discover", | ||||
|                   etransactions=[ | ||||
|                                 Transaction {taccount="liabilities:credit cards:discover",  | ||||
|                                 LedgerTransaction {taccount="liabilities:credit cards:discover",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=80, precision=2}}, | ||||
|                                 Transaction {taccount="assets:checking",  | ||||
|                                 LedgerTransaction {taccount="assets:checking",  | ||||
|                                              tamount=Amount {currency=(getcurrency "$"), quantity=(-80), precision=2}} | ||||
|                                ] | ||||
|                  } | ||||
|  | ||||
							
								
								
									
										18
									
								
								TimeLog.hs
									
									
									
									
									
								
							
							
						
						
									
										18
									
								
								TimeLog.hs
									
									
									
									
									
								
							| @ -4,9 +4,9 @@ import Utils | ||||
| import Types | ||||
| import Currency | ||||
| import Amount | ||||
| import Transaction | ||||
| import Entry | ||||
| import RawLedger | ||||
| import LedgerTransaction | ||||
| import LedgerEntry | ||||
| import LedgerFile | ||||
| 
 | ||||
| instance Show TimeLogEntry where  | ||||
|     show t = printf "%s %s %s" (show $ tcode t) (tdatetime t) (tcomment t) | ||||
| @ -14,25 +14,25 @@ instance Show TimeLogEntry where | ||||
| instance Show TimeLog where | ||||
|     show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl | ||||
| 
 | ||||
| ledgerFromTimeLog :: TimeLog -> RawLedger | ||||
| ledgerFromTimeLog :: TimeLog -> LedgerFile | ||||
| ledgerFromTimeLog tl =  | ||||
|     RawLedger [] [] (entriesFromTimeLogEntries $ timelog_entries tl) | ||||
|     LedgerFile [] [] (entriesFromTimeLogEntries $ timelog_entries tl) | ||||
| 
 | ||||
| entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry] | ||||
| entriesFromTimeLogEntries :: [TimeLogEntry] -> [LedgerEntry] | ||||
| 
 | ||||
| entriesFromTimeLogEntries [clockin] =  | ||||
|     entriesFromTimeLogEntries [clockin, clockoutNowEntry] | ||||
| 
 | ||||
| entriesFromTimeLogEntries [clockin,clockout] = | ||||
|     [ | ||||
|      Entry { | ||||
|      LedgerEntry { | ||||
|        edate         = indate, | ||||
|        estatus       = True, | ||||
|        ecode         = "", | ||||
|        edescription  = accountname, | ||||
|        etransactions = [ | ||||
|         Transaction accountname amount, | ||||
|         Transaction "TIME" (-amount) | ||||
|         LedgerTransaction accountname amount, | ||||
|         LedgerTransaction "TIME" (-amount) | ||||
|        ]} | ||||
|     ] | ||||
|     where | ||||
|  | ||||
| @ -1,37 +1,81 @@ | ||||
| 
 | ||||
| module Transaction | ||||
| where | ||||
| import Utils | ||||
| import Types | ||||
| import AccountName | ||||
| import LedgerEntry | ||||
| import LedgerTransaction | ||||
| import Amount | ||||
| import Currency | ||||
| 
 | ||||
| 
 | ||||
| instance Show Transaction where show = showTransaction | ||||
| entry       (e,t) = e | ||||
| transaction (e,t) = t | ||||
| date        (e,t) = edate e | ||||
| status      (e,t) = estatus e | ||||
| code        (e,t) = ecode e | ||||
| description (e,t) = edescription e | ||||
| account     (e,t) = taccount t | ||||
| amount      (e,t) = tamount t | ||||
|                                           | ||||
| showTransaction :: Transaction -> String | ||||
| showTransaction t = (showaccountname $ taccount t) ++ "  " ++ (showamount $ tamount t)  | ||||
|     where | ||||
|       showaccountname = printf "%-22s" . elideRight 22 | ||||
|       showamount = printf "%11s" . showAmountRoundedOrZero | ||||
| flattenEntry :: LedgerEntry -> [Transaction] | ||||
| flattenEntry e = [(e,t) | t <- etransactions e] | ||||
| 
 | ||||
| elideRight width s = | ||||
|     case length s > width of | ||||
|       True -> take (width - 2) s ++ ".." | ||||
|       False -> s | ||||
| entryTransactionSetPrecision :: Int -> Transaction -> Transaction | ||||
| entryTransactionSetPrecision p (e, LedgerTransaction a amt) = (e, LedgerTransaction a amt{precision=p}) | ||||
| 
 | ||||
| autofillTransactions :: [Transaction] -> [Transaction] | ||||
| autofillTransactions ts = | ||||
|     let (ns, as) = partition isNormal ts | ||||
|             where isNormal t = (symbol $ currency $ tamount t) /= "AUTO" in | ||||
|     case (length as) of | ||||
|       0 -> ns | ||||
|       1 -> ns ++ [balanceTransaction $ head as] | ||||
|           where balanceTransaction t = t{tamount = -(sumTransactions ns)} | ||||
|       otherwise -> error "too many blank transactions in this entry" | ||||
| accountNamesFromTransactions :: [Transaction] -> [AccountName] | ||||
| accountNamesFromTransactions ts = nub $ map account ts | ||||
| 
 | ||||
| sumTransactions :: [Transaction] -> Amount | ||||
| sumTransactions = sum . map tamount | ||||
| entryTransactionsFrom :: [LedgerEntry] -> [Transaction] | ||||
| entryTransactionsFrom es = concat $ map flattenEntry es | ||||
| 
 | ||||
| transactionSetPrecision :: Int -> Transaction -> Transaction | ||||
| transactionSetPrecision p (Transaction a amt) = Transaction a amt{precision=p} | ||||
| sumEntryTransactions :: [Transaction] -> Amount | ||||
| sumEntryTransactions ets =  | ||||
|     sumTransactions $ map transaction ets | ||||
| 
 | ||||
| matchTransactionAccount :: Regex -> Transaction -> Bool | ||||
| matchTransactionAccount r t = | ||||
|     case matchRegex r (account t) of | ||||
|       Nothing -> False | ||||
|       otherwise -> True | ||||
| 
 | ||||
| matchTransactionDescription :: Regex -> Transaction -> Bool | ||||
| matchTransactionDescription r t = | ||||
|     case matchRegex r (description t) of | ||||
|       Nothing -> False | ||||
|       otherwise -> True | ||||
| 
 | ||||
| -- for register command  | ||||
| 
 | ||||
| showTransactionsWithBalances :: [Transaction] -> Amount -> String | ||||
| showTransactionsWithBalances [] _ = [] | ||||
| showTransactionsWithBalances ts b = | ||||
|     unlines $ showTransactionsWithBalances' ts dummyt b | ||||
|         where | ||||
|           dummyt = (LedgerEntry "" False "" "" [], LedgerTransaction "" (dollars 0)) | ||||
|           showTransactionsWithBalances' [] _ _ = [] | ||||
|           showTransactionsWithBalances' (t:ts) tprev b = | ||||
|               (if (entry t /= (entry tprev)) | ||||
|                then [showTransactionDescriptionAndBalance t b'] | ||||
|                else [showTransactionAndBalance t b']) | ||||
|               ++ (showTransactionsWithBalances' ts t b') | ||||
|                   where b' = b + (amount t) | ||||
| 
 | ||||
| showTransactionDescriptionAndBalance :: Transaction -> Amount -> String | ||||
| showTransactionDescriptionAndBalance t b = | ||||
|     (showEntryDescription $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) | ||||
| 
 | ||||
| showTransactionAndBalance :: Transaction -> Amount -> String | ||||
| showTransactionAndBalance t b = | ||||
|     (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b) | ||||
| 
 | ||||
| showBalance :: Amount -> String | ||||
| showBalance b = printf " %12s" (showAmountRoundedOrZero b) | ||||
| 
 | ||||
| transactionsWithAccountName :: AccountName -> [Transaction] -> [Transaction] | ||||
| transactionsWithAccountName a ts = [t | t <- ts, account t == a] | ||||
|      | ||||
| transactionsWithOrBelowAccountName :: AccountName -> [Transaction] -> [Transaction] | ||||
| transactionsWithOrBelowAccountName a ts =  | ||||
|     [t | t <- ts, account t == a || a `isAccountNamePrefixOf` (account t)] | ||||
|  | ||||
							
								
								
									
										34
									
								
								Types.hs
									
									
									
									
									
								
							
							
						
						
									
										34
									
								
								Types.hs
									
									
									
									
									
								
							| @ -18,10 +18,10 @@ hledger | ||||
|      TimeLogEntry | ||||
|     Ledger | ||||
|      Account | ||||
|       EntryTransaction | ||||
|      RawLedger | ||||
|       Entry | ||||
|        Transaction | ||||
|       Transaction | ||||
|      LedgerFile | ||||
|       LedgerEntry | ||||
|        LedgerTransaction | ||||
|         AccountName | ||||
|         Amount | ||||
|          Currency | ||||
| @ -50,19 +50,19 @@ data Amount = Amount { | ||||
| -- out the chart of accounts | ||||
| type AccountName = String | ||||
| 
 | ||||
| -- a flow of some amount to some account (see also EntryTransaction) | ||||
| data Transaction = Transaction { | ||||
| -- a flow of some amount to some account (see also Transaction) | ||||
| data LedgerTransaction = LedgerTransaction { | ||||
|       taccount :: AccountName, | ||||
|       tamount :: Amount | ||||
|     } deriving (Eq) | ||||
| 
 | ||||
| -- a ledger entry, with two or more balanced transactions | ||||
| data Entry = Entry { | ||||
| data LedgerEntry = LedgerEntry { | ||||
|       edate :: Date, | ||||
|       estatus :: EntryStatus, | ||||
|       ecode :: String, | ||||
|       edescription :: String, | ||||
|       etransactions :: [Transaction] | ||||
|       etransactions :: [LedgerTransaction] | ||||
|     } deriving (Eq) | ||||
| 
 | ||||
| type EntryStatus = Bool | ||||
| @ -70,13 +70,13 @@ type EntryStatus = Bool | ||||
| -- an "=" automated entry (ignored) | ||||
| data ModifierEntry = ModifierEntry { | ||||
|       valueexpr :: String, | ||||
|       m_transactions :: [Transaction] | ||||
|       m_transactions :: [LedgerTransaction] | ||||
|     } deriving (Eq) | ||||
| 
 | ||||
| -- a "~" periodic entry (ignored) | ||||
| data PeriodicEntry = PeriodicEntry { | ||||
|       periodexpr :: String, | ||||
|       p_transactions :: [Transaction] | ||||
|       p_transactions :: [LedgerTransaction] | ||||
|     } deriving (Eq) | ||||
| 
 | ||||
| -- we also parse timeclock.el timelogs | ||||
| @ -91,28 +91,28 @@ data TimeLog = TimeLog { | ||||
|     } deriving (Eq) | ||||
| 
 | ||||
| -- a parsed ledger file | ||||
| data RawLedger = RawLedger { | ||||
| data LedgerFile = LedgerFile { | ||||
|       modifier_entries :: [ModifierEntry], | ||||
|       periodic_entries :: [PeriodicEntry], | ||||
|       entries :: [Entry] | ||||
|       entries :: [LedgerEntry] | ||||
|     } deriving (Eq) | ||||
| 
 | ||||
| -- We convert Transactions into EntryTransactions, which are (entry, | ||||
| -- transaction) pairs, since I couldn't see how to have transactions | ||||
| -- reference their entry like in OO.  These are referred to as just | ||||
| -- "transactions" in modules above EntryTransaction. | ||||
| type EntryTransaction = (Entry,Transaction) | ||||
| -- "transactions" in modules above Transaction. | ||||
| type Transaction = (LedgerEntry,LedgerTransaction) | ||||
| 
 | ||||
| -- all information for a particular account, derived from a RawLedger | ||||
| -- all information for a particular account, derived from a LedgerFile | ||||
| data Account = Account { | ||||
|       aname :: AccountName,  | ||||
|       atransactions :: [EntryTransaction], -- excludes sub-accounts | ||||
|       atransactions :: [Transaction], -- excludes sub-accounts | ||||
|       abalance :: Amount                   -- includes sub-accounts | ||||
|     } | ||||
| 
 | ||||
| -- a ledger with account info cached for faster queries | ||||
| data Ledger = Ledger { | ||||
|       rawledger :: RawLedger,  | ||||
|       rawledger :: LedgerFile,  | ||||
|       accountnametree :: Tree AccountName, | ||||
|       accounts :: Map.Map AccountName Account, | ||||
|       lprecision :: Int | ||||
|  | ||||
| @ -75,7 +75,7 @@ doWithLedger :: [Flag] -> (Ledger -> IO ()) -> IO () | ||||
| doWithLedger opts cmd = do | ||||
|     ledgerFilePath opts >>= parseLedgerFile >>= doWithParsed cmd | ||||
| 
 | ||||
| doWithParsed :: (Ledger -> IO ()) -> (Either ParseError RawLedger) -> IO () | ||||
| doWithParsed :: (Ledger -> IO ()) -> (Either ParseError LedgerFile) -> IO () | ||||
| doWithParsed cmd parsed = do | ||||
|   case parsed of Left e -> parseError e | ||||
|                  Right l -> cmd $ cacheLedger l | ||||
| @ -85,7 +85,7 @@ doWithParsed cmd parsed = do | ||||
| interactive testing: | ||||
| 
 | ||||
| *Main> p <- ledgerFilePath [File "./test.dat"] >>= parseLedgerFile | ||||
| *Main> let r = either (\_ -> RawLedger [] [] []) id p | ||||
| *Main> let r = either (\_ -> LedgerFile [] [] []) id p | ||||
| *Main> let l = cacheLedger r | ||||
| *Main> let ant = accountnametree l | ||||
| *Main> let at = accounts l | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user