simplify Transaction type
This commit is contained in:
		
							parent
							
								
									a1b060f4cf
								
							
						
					
					
						commit
						5763a80fda
					
				
							
								
								
									
										15
									
								
								Ledger.hs
									
									
									
									
									
								
							
							
						
						
									
										15
									
								
								Ledger.hs
									
									
									
									
									
								
							| @ -12,10 +12,13 @@ import LedgerFile | |||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| rawLedgerTransactions :: LedgerFile -> [Transaction] | rawLedgerTransactions :: LedgerFile -> [Transaction] | ||||||
| rawLedgerTransactions l = entryTransactionsFrom $ entries l | rawLedgerTransactions = txns . entries | ||||||
|  |     where | ||||||
|  |       txns :: [LedgerEntry] -> [Transaction] | ||||||
|  |       txns es = concat $ map flattenEntry es | ||||||
| 
 | 
 | ||||||
| rawLedgerAccountNamesUsed :: LedgerFile -> [AccountName] | rawLedgerAccountNamesUsed :: LedgerFile -> [AccountName] | ||||||
| rawLedgerAccountNamesUsed l = accountNamesFromTransactions $ entryTransactionsFrom $ entries l | rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions | ||||||
| 
 | 
 | ||||||
| rawLedgerAccountNames :: LedgerFile -> [AccountName] | rawLedgerAccountNames :: LedgerFile -> [AccountName] | ||||||
| rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed | rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed | ||||||
| @ -44,12 +47,12 @@ cacheLedger l = | |||||||
|         tmap = Map.union  |         tmap = Map.union  | ||||||
|                (Map.fromList [(account $ head g, g) | g <- groupedts]) |                (Map.fromList [(account $ head g, g) | g <- groupedts]) | ||||||
|                (Map.fromList [(a,[]) | a <- ans]) |                (Map.fromList [(a,[]) | a <- ans]) | ||||||
|         txns a = tmap ! a |         txns = (tmap !) | ||||||
|         subaccts a = filter (isAccountNamePrefixOf a) ans |         subaccts a = filter (isAccountNamePrefixOf a) ans | ||||||
|         subtxns a = concat [txns a | a <- [a] ++ subaccts a] |         subtxns a = concat [txns a | a <- [a] ++ subaccts a] | ||||||
|         lprecision = maximum $ map (precision . tamount . transaction) ts |         lprecision = maximum $ map (precision . amount) ts | ||||||
|         bmap = Map.union  |         bmap = Map.union  | ||||||
|                (Map.fromList [(a, (sumEntryTransactions $ subtxns a){precision=lprecision}) | a <- ans]) |                (Map.fromList [(a, (sumTransactions $ subtxns a){precision=lprecision}) | a <- ans]) | ||||||
|                (Map.fromList [(a,nullamt) | a <- ans]) |                (Map.fromList [(a,nullamt) | a <- ans]) | ||||||
|         amap = Map.fromList [(a, Account a (tmap ! a) (bmap ! a)) | a <- ans] |         amap = Map.fromList [(a, Account a (tmap ! a) (bmap ! a)) | a <- ans] | ||||||
|     in |     in | ||||||
| @ -69,7 +72,7 @@ ledgerTransactions :: Ledger -> [Transaction] | |||||||
| ledgerTransactions l =  | ledgerTransactions l =  | ||||||
|     setprecisions $ rawLedgerTransactions $ rawledger l |     setprecisions $ rawLedgerTransactions $ rawledger l | ||||||
|     where |     where | ||||||
|       setprecisions = map (entryTransactionSetPrecision (lprecision l)) |       setprecisions = map (transactionSetPrecision (lprecision l)) | ||||||
| 
 | 
 | ||||||
| ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction] | ledgerTransactionsMatching :: ([String],[String]) -> Ledger -> [Transaction] | ||||||
| ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l | ledgerTransactionsMatching ([],[]) l = ledgerTransactionsMatching ([".*"],[".*"]) l | ||||||
|  | |||||||
| @ -1,4 +1,3 @@ | |||||||
| 
 |  | ||||||
| module LedgerEntry | module LedgerEntry | ||||||
| where | where | ||||||
| import Utils | import Utils | ||||||
| @ -27,7 +26,7 @@ showDate d = printf "%-10s" d | |||||||
| showDescription s = printf "%-20s" (elideRight 20 s) | showDescription s = printf "%-20s" (elideRight 20 s) | ||||||
| 
 | 
 | ||||||
| isEntryBalanced :: LedgerEntry -> Bool | isEntryBalanced :: LedgerEntry -> Bool | ||||||
| isEntryBalanced e = (sumTransactions . etransactions) e == 0 | isEntryBalanced e = (sumLedgerTransactions . etransactions) e == 0 | ||||||
| 
 | 
 | ||||||
| autofillEntry :: LedgerEntry -> LedgerEntry | autofillEntry :: LedgerEntry -> LedgerEntry | ||||||
| autofillEntry e =  | autofillEntry e =  | ||||||
| @ -68,7 +67,7 @@ showEntries = concatMap showEntry | |||||||
| 
 | 
 | ||||||
| entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry | entrySetPrecision :: Int -> LedgerEntry -> LedgerEntry | ||||||
| entrySetPrecision p (LedgerEntry d s c desc ts) =  | entrySetPrecision p (LedgerEntry d s c desc ts) =  | ||||||
|     LedgerEntry d s c desc $ map (transactionSetPrecision p) ts |     LedgerEntry d s c desc $ map (ledgerTransactionSetPrecision p) ts | ||||||
|                  |                  | ||||||
| 
 | 
 | ||||||
| -- modifier & periodic entries | -- modifier & periodic entries | ||||||
|  | |||||||
| @ -1,4 +1,3 @@ | |||||||
| 
 |  | ||||||
| module LedgerTransaction | module LedgerTransaction | ||||||
| where | where | ||||||
| import Utils | import Utils | ||||||
| @ -7,10 +6,10 @@ import AccountName | |||||||
| import Amount | import Amount | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| instance Show LedgerTransaction where show = showTransaction | instance Show LedgerTransaction where show = showLedgerTransaction | ||||||
| 
 | 
 | ||||||
| showTransaction :: LedgerTransaction -> String | showLedgerTransaction :: LedgerTransaction -> String | ||||||
| showTransaction t = (showaccountname $ taccount t) ++ "  " ++ (showamount $ tamount t)  | showLedgerTransaction t = (showaccountname $ taccount t) ++ "  " ++ (showamount $ tamount t)  | ||||||
|     where |     where | ||||||
|       showaccountname = printf "%-22s" . elideRight 22 |       showaccountname = printf "%-22s" . elideRight 22 | ||||||
|       showamount = printf "%11s" . showAmountRoundedOrZero |       showamount = printf "%11s" . showAmountRoundedOrZero | ||||||
| @ -27,11 +26,11 @@ autofillTransactions ts = | |||||||
|     case (length as) of |     case (length as) of | ||||||
|       0 -> ns |       0 -> ns | ||||||
|       1 -> ns ++ [balanceTransaction $ head as] |       1 -> ns ++ [balanceTransaction $ head as] | ||||||
|           where balanceTransaction t = t{tamount = -(sumTransactions ns)} |           where balanceTransaction t = t{tamount = -(sumLedgerTransactions ns)} | ||||||
|       otherwise -> error "too many blank transactions in this entry" |       otherwise -> error "too many blank transactions in this entry" | ||||||
| 
 | 
 | ||||||
| sumTransactions :: [LedgerTransaction] -> Amount | sumLedgerTransactions :: [LedgerTransaction] -> Amount | ||||||
| sumTransactions = sum . map tamount | sumLedgerTransactions = sum . map tamount | ||||||
| 
 | 
 | ||||||
| transactionSetPrecision :: Int -> LedgerTransaction -> LedgerTransaction | ledgerTransactionSetPrecision :: Int -> LedgerTransaction -> LedgerTransaction | ||||||
| transactionSetPrecision p (LedgerTransaction a amt) = LedgerTransaction a amt{precision=p} | ledgerTransactionSetPrecision p (LedgerTransaction a amt) = LedgerTransaction a amt{precision=p} | ||||||
|  | |||||||
							
								
								
									
										1
									
								
								NOTES
									
									
									
									
									
								
							
							
						
						
									
										1
									
								
								NOTES
									
									
									
									
									
								
							| @ -2,7 +2,6 @@ hledger project notes | |||||||
| 
 | 
 | ||||||
| * TO DO | * TO DO | ||||||
| ** bugs/cleanup | ** bugs/cleanup | ||||||
| *** rename EntryTransaction/Transaction |  | ||||||
| ** ledger features | ** ledger features | ||||||
| *** print command | *** print command | ||||||
| **** need to save & print comments | **** need to save & print comments | ||||||
|  | |||||||
| @ -9,30 +9,17 @@ import Amount | |||||||
| import Currency | 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 :: LedgerEntry -> [Transaction] | flattenEntry :: LedgerEntry -> [Transaction] | ||||||
| flattenEntry e = [(e,t) | t <- etransactions e] | flattenEntry (LedgerEntry d _ _ desc ts) = [Transaction d desc (taccount t) (tamount t) | t <- ts] | ||||||
| 
 | 
 | ||||||
| entryTransactionSetPrecision :: Int -> Transaction -> Transaction | transactionSetPrecision :: Int -> Transaction -> Transaction | ||||||
| entryTransactionSetPrecision p (e, LedgerTransaction a amt) = (e, LedgerTransaction a amt{precision=p}) | transactionSetPrecision p (Transaction d desc a amt) = Transaction d desc a amt{precision=p} | ||||||
| 
 | 
 | ||||||
| accountNamesFromTransactions :: [Transaction] -> [AccountName] | accountNamesFromTransactions :: [Transaction] -> [AccountName] | ||||||
| accountNamesFromTransactions ts = nub $ map account ts | accountNamesFromTransactions ts = nub $ map account ts | ||||||
| 
 | 
 | ||||||
| entryTransactionsFrom :: [LedgerEntry] -> [Transaction] | sumTransactions :: [Transaction] -> Amount | ||||||
| entryTransactionsFrom es = concat $ map flattenEntry es | sumTransactions = sum . map amount | ||||||
| 
 |  | ||||||
| sumEntryTransactions :: [Transaction] -> Amount |  | ||||||
| sumEntryTransactions ets =  |  | ||||||
|     sumTransactions $ map transaction ets |  | ||||||
| 
 | 
 | ||||||
| matchTransactionAccount :: Regex -> Transaction -> Bool | matchTransactionAccount :: Regex -> Transaction -> Bool | ||||||
| matchTransactionAccount r t = | matchTransactionAccount r t = | ||||||
| @ -53,22 +40,27 @@ showTransactionsWithBalances [] _ = [] | |||||||
| showTransactionsWithBalances ts b = | showTransactionsWithBalances ts b = | ||||||
|     unlines $ showTransactionsWithBalances' ts dummyt b |     unlines $ showTransactionsWithBalances' ts dummyt b | ||||||
|         where |         where | ||||||
|           dummyt = (LedgerEntry "" False "" "" [], LedgerTransaction "" (dollars 0)) |           dummyt = Transaction "" "" "" (dollars 0) | ||||||
|           showTransactionsWithBalances' [] _ _ = [] |           showTransactionsWithBalances' [] _ _ = [] | ||||||
|           showTransactionsWithBalances' (t:ts) tprev b = |           showTransactionsWithBalances' (t:ts) tprev b = | ||||||
|               (if (entry t /= (entry tprev)) |               (if sameentry t tprev | ||||||
|                then [showTransactionDescriptionAndBalance t b'] |                then [showTransactionDescriptionAndBalance t b'] | ||||||
|                else [showTransactionAndBalance t b']) |                else [showTransactionAndBalance t b']) | ||||||
|               ++ (showTransactionsWithBalances' ts t b') |               ++ (showTransactionsWithBalances' ts t b') | ||||||
|                   where b' = b + (amount t) |                   where  | ||||||
|  |                     b' = b + (amount t) | ||||||
|  |                     sameentry (Transaction d1 desc1 _ _) (Transaction d2 desc2 _ _) =  | ||||||
|  |                         d1 == d2 && desc1 == desc2 | ||||||
|  |                         -- we forgot the entry-txn relationships.. good enough ? | ||||||
| 
 | 
 | ||||||
| showTransactionDescriptionAndBalance :: Transaction -> Amount -> String | showTransactionDescriptionAndBalance :: Transaction -> Amount -> String | ||||||
| showTransactionDescriptionAndBalance t b = | showTransactionDescriptionAndBalance t b = | ||||||
|     (showEntryDescription $ entry t) ++ (showTransaction $ transaction t) ++ (showBalance b) |     (showEntryDescription $ LedgerEntry (date t) False "" (description t) [])  | ||||||
|  |     ++ (showLedgerTransaction $ LedgerTransaction (account t) (amount t)) ++ (showBalance b) | ||||||
| 
 | 
 | ||||||
| showTransactionAndBalance :: Transaction -> Amount -> String | showTransactionAndBalance :: Transaction -> Amount -> String | ||||||
| showTransactionAndBalance t b = | showTransactionAndBalance t b = | ||||||
|     (replicate 32 ' ') ++ (showTransaction $ transaction t) ++ (showBalance b) |     (replicate 32 ' ') ++ (showLedgerTransaction $ LedgerTransaction (account t) (amount t)) ++ (showBalance b) | ||||||
| 
 | 
 | ||||||
| showBalance :: Amount -> String | showBalance :: Amount -> String | ||||||
| showBalance b = printf " %12s" (showAmountRoundedOrZero b) | showBalance b = printf " %12s" (showAmountRoundedOrZero b) | ||||||
|  | |||||||
							
								
								
									
										33
									
								
								Types.hs
									
									
									
									
									
								
							
							
						
						
									
										33
									
								
								Types.hs
									
									
									
									
									
								
							| @ -46,11 +46,11 @@ data Amount = Amount { | |||||||
|       precision :: Int -- number of significant decimal places |       precision :: Int -- number of significant decimal places | ||||||
|     } deriving (Eq) |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| -- AccountNames are strings like "assets:cash:petty"; from these we figure | -- AccountNames are strings like "assets:cash:petty", from which we derive | ||||||
| -- out the chart of accounts | -- the chart of accounts | ||||||
| type AccountName = String | type AccountName = String | ||||||
| 
 | 
 | ||||||
| -- a flow of some amount to some account (see also Transaction) | -- a line item in a ledger entry | ||||||
| data LedgerTransaction = LedgerTransaction { | data LedgerTransaction = LedgerTransaction { | ||||||
|       taccount :: AccountName, |       taccount :: AccountName, | ||||||
|       tamount :: Amount |       tamount :: Amount | ||||||
| @ -59,21 +59,19 @@ data LedgerTransaction = LedgerTransaction { | |||||||
| -- a ledger entry, with two or more balanced transactions | -- a ledger entry, with two or more balanced transactions | ||||||
| data LedgerEntry = LedgerEntry { | data LedgerEntry = LedgerEntry { | ||||||
|       edate :: Date, |       edate :: Date, | ||||||
|       estatus :: EntryStatus, |       estatus :: Bool, | ||||||
|       ecode :: String, |       ecode :: String, | ||||||
|       edescription :: String, |       edescription :: String, | ||||||
|       etransactions :: [LedgerTransaction] |       etransactions :: [LedgerTransaction] | ||||||
|     } deriving (Eq) |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| type EntryStatus = Bool | -- an automated ledger entry | ||||||
| 
 |  | ||||||
| -- an "=" automated entry (ignored) |  | ||||||
| data ModifierEntry = ModifierEntry { | data ModifierEntry = ModifierEntry { | ||||||
|       valueexpr :: String, |       valueexpr :: String, | ||||||
|       m_transactions :: [LedgerTransaction] |       m_transactions :: [LedgerTransaction] | ||||||
|     } deriving (Eq) |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| -- a "~" periodic entry (ignored) | -- a periodic ledger entry | ||||||
| data PeriodicEntry = PeriodicEntry { | data PeriodicEntry = PeriodicEntry { | ||||||
|       periodexpr :: String, |       periodexpr :: String, | ||||||
|       p_transactions :: [LedgerTransaction] |       p_transactions :: [LedgerTransaction] | ||||||
| @ -97,20 +95,23 @@ data LedgerFile = LedgerFile { | |||||||
|       entries :: [LedgerEntry] |       entries :: [LedgerEntry] | ||||||
|     } deriving (Eq) |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| -- We convert Transactions into EntryTransactions, which are (entry, | -- we flatten LedgerEntries and LedgerTransactions into Transactions, | ||||||
| -- transaction) pairs, since I couldn't see how to have transactions | -- which are simpler to query at the cost of some data duplication | ||||||
| -- reference their entry like in OO.  These are referred to as just | data Transaction = Transaction { | ||||||
| -- "transactions" in modules above Transaction. |       date :: Date, | ||||||
| type Transaction = (LedgerEntry,LedgerTransaction) |       description :: String, | ||||||
|  |       account :: AccountName, | ||||||
|  |       amount :: Amount | ||||||
|  |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| -- all information for a particular account, derived from a LedgerFile | -- cached information for a particular account | ||||||
| data Account = Account { | data Account = Account { | ||||||
|       aname :: AccountName,  |       aname :: AccountName,  | ||||||
|       atransactions :: [Transaction], -- excludes sub-accounts |       atransactions :: [Transaction], -- excludes sub-accounts | ||||||
|       abalance :: Amount                   -- includes sub-accounts |       abalance :: Amount              -- includes sub-accounts | ||||||
|     } |     } | ||||||
| 
 | 
 | ||||||
| -- a ledger with account info cached for faster queries | -- a ledger with account information cached for faster queries | ||||||
| data Ledger = Ledger { | data Ledger = Ledger { | ||||||
|       rawledger :: LedgerFile,  |       rawledger :: LedgerFile,  | ||||||
|       accountnametree :: Tree AccountName, |       accountnametree :: Tree AccountName, | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user