rename and unify the autofill stuff
This commit is contained in:
		
							parent
							
								
									a304ad3ca6
								
							
						
					
					
						commit
						d31ba41703
					
				| @ -15,6 +15,12 @@ import Ledger.Amount | |||||||
| 
 | 
 | ||||||
| instance Show Entry where show = showEntry | instance Show Entry where show = showEntry | ||||||
| 
 | 
 | ||||||
|  | instance Show ModifierEntry where  | ||||||
|  |     show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e)) | ||||||
|  | 
 | ||||||
|  | instance Show PeriodicEntry where  | ||||||
|  |     show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e)) | ||||||
|  | 
 | ||||||
| {-| | {-| | ||||||
| Show a ledger entry, formatted for the print command. ledger 2.x's | Show a ledger entry, formatted for the print command. ledger 2.x's | ||||||
| standard format looks like this: | standard format looks like this: | ||||||
| @ -53,31 +59,27 @@ showEntry e = | |||||||
| 
 | 
 | ||||||
| showDate = printf "%-10s" | showDate = printf "%-10s" | ||||||
| 
 | 
 | ||||||
| -- | Raise an error if this entry is not balanced. |  | ||||||
| assertBalancedEntry :: Entry -> Entry |  | ||||||
| assertBalancedEntry e |  | ||||||
|     | isEntryBalanced e = e |  | ||||||
|     | otherwise = error $ "transactions don't balance in:\n" ++ show e |  | ||||||
| 
 |  | ||||||
| isEntryBalanced :: Entry -> Bool | isEntryBalanced :: Entry -> Bool | ||||||
| isEntryBalanced (Entry {etransactions=ts}) = isZeroMixedAmount sum | isEntryBalanced (Entry {etransactions=ts}) = isZeroMixedAmount sum | ||||||
|     where |     where | ||||||
|       sum = sumRawTransactions realts |       sum = sumRawTransactions realts | ||||||
|       realts = filter isReal ts |       realts = filter isReal ts | ||||||
| 
 | 
 | ||||||
| -- | Fill in a missing balance in this entry, if there is one,  | -- | Fill in a missing balance in this entry, if we have enough | ||||||
| -- or raise an error if there is more than one. | -- information to do that. Excluding virtual transactions, there should be | ||||||
| autofillEntry :: Entry -> Entry | -- at most one missing balance. Otherwise, raise an error. | ||||||
| autofillEntry e@(Entry {etransactions=ts}) = e{etransactions=ts'} | balanceEntry :: Entry -> Entry | ||||||
|     where ts' = fromMaybe  | balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'} | ||||||
|                 (error $ "too many missing amounts in this entry, could not auto-balance:\n" ++ show e) |     where  | ||||||
|                 (autofillTransactions ts) |       (withamounts, missingamounts) = partition hasAmount $ filter isReal ts | ||||||
| 
 |       ts' = case (length missingamounts) of | ||||||
| -- modifier & periodic entries |               0 -> ts | ||||||
| 
 |               1 -> map balance ts | ||||||
| instance Show ModifierEntry where  |               otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e | ||||||
|     show e = "= " ++ (valueexpr e) ++ "\n" ++ unlines (map show (m_transactions e)) |       otherstotal = sumRawTransactions withamounts | ||||||
| 
 |       simpleotherstotal | ||||||
| instance Show PeriodicEntry where  |           | length otherstotal == 1 = head otherstotal | ||||||
|     show e = "~ " ++ (periodexpr e) ++ "\n" ++ unlines (map show (p_transactions e)) |           | otherwise = error $ "sorry, can't balance a mixed-commodity entry yet:\n" ++ show e | ||||||
| 
 |       balance t | ||||||
|  |           | isReal t && not (hasAmount t) = t{tamount = -simpleotherstotal} | ||||||
|  |           | otherwise = t | ||||||
|  | |||||||
| @ -231,7 +231,7 @@ ledgerentry = do | |||||||
|   comment <- ledgercomment |   comment <- ledgercomment | ||||||
|   restofline |   restofline | ||||||
|   transactions <- ledgertransactions |   transactions <- ledgertransactions | ||||||
|   return $ assertBalancedEntry $ autofillEntry $ Entry date status code description comment transactions (unlines preceding) |   return $ balanceEntry $ Entry date status code description comment transactions (unlines preceding) | ||||||
| 
 | 
 | ||||||
| ledgerdate :: Parser String | ledgerdate :: Parser String | ||||||
| ledgerdate = do  | ledgerdate = do  | ||||||
|  | |||||||
| @ -21,26 +21,6 @@ showRawTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ ta | |||||||
|       showaccountname = printf "%-22s" . elideAccountName 22 |       showaccountname = printf "%-22s" . elideAccountName 22 | ||||||
|       showamount = printf "%12s" . showAmountOrZero |       showamount = printf "%12s" . showAmountOrZero | ||||||
| 
 | 
 | ||||||
| -- | Fill in the missing balance in an entry's transactions. Excluding |  | ||||||
| -- virtual transactions, there should be at most one missing balance, |  | ||||||
| -- otherwise return Nothing. |  | ||||||
| autofillTransactions :: [RawTransaction] -> Maybe [RawTransaction] |  | ||||||
| autofillTransactions ts = |  | ||||||
|     case (length withmissingamounts) of |  | ||||||
|       0 -> Just ts |  | ||||||
|       1 -> Just $ map balance ts |  | ||||||
|       otherwise -> Nothing |  | ||||||
|     where  |  | ||||||
|       (reals, _) = partition isReal ts |  | ||||||
|       (withrealamounts, withmissingamounts) = partition hasAmount reals |  | ||||||
|       balance t = if (isReal t) && (not $ hasAmount t)  |  | ||||||
|                   then t{tamount = -otherssimpletotal} |  | ||||||
|                   else t |  | ||||||
|       otherstotal = sumRawTransactions withrealamounts |  | ||||||
|       otherssimpletotal |  | ||||||
|           | length otherstotal == 1 = head otherstotal |  | ||||||
|           | otherwise = error "sorry, can't balance a mixed-commodity entry yet" |  | ||||||
| 
 |  | ||||||
| isReal :: RawTransaction -> Bool | isReal :: RawTransaction -> Bool | ||||||
| isReal t = rttype t == RegularTransaction | isReal t = rttype t == RegularTransaction | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -76,10 +76,10 @@ unittests = TestList [ | |||||||
|   "ledgerentry"        ~: do |   "ledgerentry"        ~: do | ||||||
|     assertparseequal entry1 (parsewith ledgerentry entry1_str) |     assertparseequal entry1 (parsewith ledgerentry entry1_str) | ||||||
|   , |   , | ||||||
|   "autofillEntry"      ~: do |   "balanceEntry"      ~: do | ||||||
|     assertequal |     assertequal | ||||||
|       (dollars (-47.18)) |       (dollars (-47.18)) | ||||||
|       (tamount $ last $ etransactions $ autofillEntry entry1) |       (tamount $ last $ etransactions $ balanceEntry entry1) | ||||||
|   , |   , | ||||||
|   "punctuatethousands"      ~: punctuatethousands "" @?= "" |   "punctuatethousands"      ~: punctuatethousands "" @?= "" | ||||||
|   , |   , | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user