make mixed amount adding and showing more robust

This commit is contained in:
Simon Michael 2008-12-05 04:36:32 +00:00
parent 3c90a41ffa
commit fdb45b8d9c

View File

@ -62,7 +62,7 @@ instance Ord Amount where
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 negateAmountPreservingPrice 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 $ 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"
@ -142,7 +142,8 @@ mixedAmountEquals a b = amounts a' == amounts b' || (isZeroMixedAmount a' && isZ
b' = normaliseMixedAmount b b' = normaliseMixedAmount b
-- | Get the string representation of a mixed amount, showing each of -- | Get the string representation of a mixed amount, showing each of
-- its component amounts. -- its component amounts. NB a mixed amount can have an empty amounts
-- list in which case it shows as "".
showMixedAmount :: MixedAmount -> String showMixedAmount :: MixedAmount -> String
showMixedAmount m = concat $ intersperse "\n" $ map showfixedwidth as showMixedAmount m = concat $ intersperse "\n" $ map showfixedwidth as
where where
@ -158,16 +159,20 @@ showMixedAmountOrZero a
| otherwise = showMixedAmount a | otherwise = showMixedAmount a
-- | Simplify a mixed amount by combining any component amounts which have -- | Simplify a mixed amount by combining any component amounts which have
-- the same commodity and the same price. -- the same commodity and the same price. Also removes redundant zero amounts
-- and adds a single zero amount if there are no amounts at all.
normaliseMixedAmount :: MixedAmount -> MixedAmount normaliseMixedAmount :: MixedAmount -> MixedAmount
normaliseMixedAmount (Mixed as) = Mixed as' normaliseMixedAmount (Mixed as) = Mixed as''
where where
as' = map sumAmountsPreservingPrice $ group $ sort as as'' = map sumAmountsPreservingPrice $ group $ sort as'
sort = sortBy cmpsymbolandprice sort = sortBy cmpsymbolandprice
cmpsymbolandprice a1 a2 = compare (sym a1,price a1) (sym a2,price a2) cmpsymbolandprice a1 a2 = compare (sym a1,price a1) (sym a2,price a2)
group = groupBy samesymbolandprice group = groupBy samesymbolandprice
samesymbolandprice a1 a2 = (sym a1 == sym a2) && (price a1 == price a2) samesymbolandprice a1 a2 = (sym a1 == sym a2) && (price a1 == price a2)
sym = symbol . commodity sym = symbol . commodity
as' | null nonzeros = [head $ zeros ++ [nullamt]]
| otherwise = nonzeros
(zeros,nonzeros) = partition isZeroAmount as
sumAmountsPreservingPrice [] = nullamt sumAmountsPreservingPrice [] = nullamt
sumAmountsPreservingPrice as = (sum as){price=price $ head as} sumAmountsPreservingPrice as = (sum as){price=price $ head as}