smarter handling of priced amounts. Normalising and some basic arithmetic now preserve prices.
Currently, amounts with the same commodity but different prices are kept separate. Useful ?
This commit is contained in:
		
							parent
							
								
									54ee68976b
								
							
						
					
					
						commit
						4c97ca5514
					
				| @ -55,14 +55,22 @@ instance Num Amount where | |||||||
|     (-) = amountop (-) |     (-) = amountop (-) | ||||||
|     (*) = amountop (*) |     (*) = amountop (*) | ||||||
| 
 | 
 | ||||||
|  | instance Ord Amount where | ||||||
|  |     compare (Amount ac aq ap) (Amount bc bq bp) = compare (ac,aq,ap) (bc,bq,bp) | ||||||
|  | 
 | ||||||
| instance Num MixedAmount where | instance Num MixedAmount where | ||||||
|     fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] |     fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing] | ||||||
|     negate (Mixed as) = Mixed $ map negate as |     negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as | ||||||
|     (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ filter (not . isZeroAmount) $ as ++ bs |     (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ filter (not . isZeroAmount) $ as ++ bs | ||||||
|     (*)    = error "programming error, mixed amounts do not support multiplication" |     (*)    = error "programming error, mixed amounts do not support multiplication" | ||||||
|     abs    = error "programming error, mixed amounts do not support abs" |     abs    = error "programming error, mixed amounts do not support abs" | ||||||
|     signum = error "programming error, mixed amounts do not support signum" |     signum = error "programming error, mixed amounts do not support signum" | ||||||
| 
 | 
 | ||||||
|  | instance Ord MixedAmount where | ||||||
|  |     compare (Mixed as) (Mixed bs) = compare as bs | ||||||
|  | 
 | ||||||
|  | negateAmountPreservingPrice a = (-a){price=price a} | ||||||
|  | 
 | ||||||
| -- | Apply a binary arithmetic operator to two amounts - converting to the | -- | Apply a binary arithmetic operator to two amounts - converting to the | ||||||
| -- second one's commodity, adopting the lowest precision, and discarding | -- second one's commodity, adopting the lowest precision, and discarding | ||||||
| -- any price information. (Using the second commodity is best since sum | -- any price information. (Using the second commodity is best since sum | ||||||
| @ -136,14 +144,20 @@ showMixedAmountOrZero a | |||||||
|     | isZeroMixedAmount a = "0" |     | isZeroMixedAmount a = "0" | ||||||
|     | otherwise = showMixedAmount a |     | otherwise = showMixedAmount a | ||||||
| 
 | 
 | ||||||
| -- | Simplify a mixed amount by combining any of its component amounts | -- | Simplify a mixed amount by combining any component amounts which have | ||||||
| -- which have the same commodity. | -- the same commodity and the same price. | ||||||
| normaliseMixedAmount :: MixedAmount -> MixedAmount | normaliseMixedAmount :: MixedAmount -> MixedAmount | ||||||
| normaliseMixedAmount (Mixed as) = Mixed $ map sum $ grouped | normaliseMixedAmount (Mixed as) = Mixed as' | ||||||
|     where  |     where  | ||||||
|       grouped = [filter (hassymbol s) as | s <- symbols] |       as' = map sumAmountsPreservingPrice $ group $ sort as | ||||||
|       symbols = sort $ nub $ map (symbol . commodity) as |       sort = sortBy cmpsymbolandprice | ||||||
|       hassymbol s a = s == (symbol $ commodity a) |       cmpsymbolandprice a1 a2 = compare (sym a1,price a1) (sym a2,price a2) | ||||||
|  |       group = groupBy samesymbolandprice  | ||||||
|  |       samesymbolandprice a1 a2 = (sym a1 == sym a2) && (price a1 == price a2) | ||||||
|  |       sym = symbol . commodity | ||||||
|  | 
 | ||||||
|  | sumAmountsPreservingPrice [] = nullamt | ||||||
|  | sumAmountsPreservingPrice as = (sum as){price=price $ head as} | ||||||
| 
 | 
 | ||||||
| -- | Convert a mixed amount's component amounts to the commodity of their | -- | Convert a mixed amount's component amounts to the commodity of their | ||||||
| -- saved price, if any. | -- saved price, if any. | ||||||
|  | |||||||
| @ -13,7 +13,7 @@ import qualified Data.Map as Map | |||||||
| 
 | 
 | ||||||
| type AccountName = String | type AccountName = String | ||||||
| 
 | 
 | ||||||
| data Side = L | R deriving (Eq,Show)  | data Side = L | R deriving (Eq,Show,Ord)  | ||||||
| 
 | 
 | ||||||
| data Commodity = Commodity { | data Commodity = Commodity { | ||||||
|       symbol :: String,  -- ^ the commodity's symbol |       symbol :: String,  -- ^ the commodity's symbol | ||||||
| @ -23,7 +23,7 @@ data Commodity = Commodity { | |||||||
|       spaced :: Bool,    -- ^ should there be a space between symbol and quantity |       spaced :: Bool,    -- ^ should there be a space between symbol and quantity | ||||||
|       comma :: Bool,     -- ^ should thousands be comma-separated |       comma :: Bool,     -- ^ should thousands be comma-separated | ||||||
|       precision :: Int   -- ^ number of decimal places to display |       precision :: Int   -- ^ number of decimal places to display | ||||||
|     } deriving (Eq,Show) |     } deriving (Eq,Show,Ord) | ||||||
| 
 | 
 | ||||||
| data Amount = Amount { | data Amount = Amount { | ||||||
|       commodity :: Commodity, |       commodity :: Commodity, | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user