make sum[Amount] preserve currency, fix a failing test
This commit is contained in:
		
							parent
							
								
									b0e8286411
								
							
						
					
					
						commit
						5ef0018001
					
				| @ -83,21 +83,22 @@ punctuatethousands s = | |||||||
| instance Num Amount where | instance Num Amount where | ||||||
|     abs (Amount c q p) = Amount c (abs q) p |     abs (Amount c q p) = Amount c (abs q) p | ||||||
|     signum (Amount c q p) = Amount c (signum q) p |     signum (Amount c q p) = Amount c (signum q) p | ||||||
|     fromInteger i = Amount (getcurrency "") (fromInteger i) amtintprecision |     fromInteger i = Amount (getcurrency "") (fromInteger i) defaultprecision | ||||||
|     (+) = amountop (+) |     (+) = amountop (+) | ||||||
|     (-) = amountop (-) |     (-) = amountop (-) | ||||||
|     (*) = amountop (*) |     (*) = amountop (*) | ||||||
| 
 | 
 | ||||||
| -- problem: when an integer is converted to an amount it must pick a | -- amounts converted from integers will have a default precision, and the | ||||||
| -- precision, which we specify here (should be infinite ?). This can | -- null currency.  | ||||||
| -- affect amount arithmetic, in particular the sum of a list of amounts. | defaultprecision = 2 | ||||||
| -- So, we may need to adjust the precision after summing amounts. |  | ||||||
| amtintprecision = 2 |  | ||||||
| 
 | 
 | ||||||
| -- | apply op to two amounts, adopting a's currency and lowest precision | -- | Apply a binary arithmetic operator to two amounts, converting to the | ||||||
|  | -- second one's currency and adopting the lowest precision. (Using the | ||||||
|  | -- second currency means that folds (like sum [Amount]) will preserve the | ||||||
|  | -- currency.) | ||||||
| amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount | amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount | ||||||
| amountop op (Amount ac aq ap) b@(Amount _ _ bp) =  | amountop op a@(Amount ac aq ap) b@(Amount bc bq bp) =  | ||||||
|     Amount ac (aq `op` (quantity $ toCurrency ac b)) (min ap bp) |     Amount bc ((quantity $ toCurrency bc a) `op` bq) (min ap bp) | ||||||
| 
 | 
 | ||||||
| toCurrency :: Currency -> Amount -> Amount | toCurrency :: Currency -> Amount -> Amount | ||||||
| toCurrency newc (Amount oldc q p) = | toCurrency newc (Amount oldc q p) = | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user