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 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 | ||||
| standard format looks like this: | ||||
| @ -53,31 +59,27 @@ showEntry e = | ||||
| 
 | ||||
| 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 {etransactions=ts}) = isZeroMixedAmount sum | ||||
|     where | ||||
|       sum = sumRawTransactions realts | ||||
|       realts = filter isReal ts | ||||
| 
 | ||||
| -- | Fill in a missing balance in this entry, if there is one,  | ||||
| -- or raise an error if there is more than one. | ||||
| autofillEntry :: Entry -> Entry | ||||
| autofillEntry e@(Entry {etransactions=ts}) = e{etransactions=ts'} | ||||
|     where ts' = fromMaybe  | ||||
|                 (error $ "too many missing amounts in this entry, could not auto-balance:\n" ++ show e) | ||||
|                 (autofillTransactions ts) | ||||
| 
 | ||||
| -- modifier & periodic entries | ||||
| 
 | ||||
| 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)) | ||||
| 
 | ||||
| -- | Fill in a missing balance in this entry, if we have enough | ||||
| -- information to do that. Excluding virtual transactions, there should be | ||||
| -- at most one missing balance. Otherwise, raise an error. | ||||
| balanceEntry :: Entry -> Entry | ||||
| balanceEntry e@(Entry{etransactions=ts}) = e{etransactions=ts'} | ||||
|     where  | ||||
|       (withamounts, missingamounts) = partition hasAmount $ filter isReal ts | ||||
|       ts' = case (length missingamounts) of | ||||
|               0 -> ts | ||||
|               1 -> map balance ts | ||||
|               otherwise -> error $ "could not balance this entry, too many missing amounts:\n" ++ show e | ||||
|       otherstotal = sumRawTransactions withamounts | ||||
|       simpleotherstotal | ||||
|           | length otherstotal == 1 = head otherstotal | ||||
|           | 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 | ||||
|   restofline | ||||
|   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 = do  | ||||
|  | ||||
| @ -21,26 +21,6 @@ showRawTransaction t = (showaccountname $ taccount t) ++ " " ++ (showamount $ ta | ||||
|       showaccountname = printf "%-22s" . elideAccountName 22 | ||||
|       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 t = rttype t == RegularTransaction | ||||
| 
 | ||||
|  | ||||
							
								
								
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -76,10 +76,10 @@ unittests = TestList [ | ||||
|   "ledgerentry"        ~: do | ||||
|     assertparseequal entry1 (parsewith ledgerentry entry1_str) | ||||
|   , | ||||
|   "autofillEntry"      ~: do | ||||
|   "balanceEntry"      ~: do | ||||
|     assertequal | ||||
|       (dollars (-47.18)) | ||||
|       (tamount $ last $ etransactions $ autofillEntry entry1) | ||||
|       (tamount $ last $ etransactions $ balanceEntry entry1) | ||||
|   , | ||||
|   "punctuatethousands"      ~: punctuatethousands "" @?= "" | ||||
|   , | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user