slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

fix a tricky mixedamount arithmetic bug

Browse Source
This commit is contained in:
Simon Michael 2009-11-25 19:42:13 +00:00
parent ef3b5ab98d
commit 5cfc8cf630
2 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Ledger/Amount.hs
View File

@ -73,14 +73,19 @@ instance Ord MixedAmount where
negateAmountPreservingPrice a = (-a){price=price a} 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 (and display precision), discarding any price
-- any price information. (Using the second commodity is best since sum -- information. (Using the second commodity is best since sum and other
-- and other folds start with a no-commodity amount.) -- folds start with a no-commodity amount.)
amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount amountop :: (Double -> Double -> Double) -> Amount -> Amount -> Amount
amountop op a@(Amount _ _ _) (Amount bc bq _) = amountop op a@(Amount _ _ _) (Amount bc bq _) =
Amount bc (quantity (convertAmountTo bc a) `op` bq) Nothing Amount bc (quantity (convertAmountTo bc a) `op` bq) Nothing
-- | Convert an amount to the specified commodity using the appropriate
-- exchange rate (which is currently always 1).
convertAmountTo :: Commodity -> Amount -> Amount
convertAmountTo c2 (Amount c1 q _) = Amount c2 (q * conversionRate c1 c2) Nothing
-- | Convert an amount to the commodity of its saved price, if any. -- | Convert an amount to the commodity of its saved price, if any.
costOfAmount :: Amount -> Amount costOfAmount :: Amount -> Amount
costOfAmount a@(Amount _ _ Nothing) = a costOfAmount a@(Amount _ _ Nothing) = a
@ -89,11 +94,6 @@ costOfAmount (Amount _ q (Just price))
| otherwise = Amount pc (pq*q) Nothing | otherwise = Amount pc (pq*q) Nothing
where (Amount pc pq _) = head $ amounts price where (Amount pc pq _) = head $ amounts price
-- | Convert an amount to the specified commodity using the appropriate
-- exchange rate (which is currently always 1).
convertAmountTo :: Commodity -> Amount -> Amount
convertAmountTo c2 (Amount c1 q _) = Amount c2 (q * conversionRate c1 c2) Nothing
-- | Get the string representation of an amount, based on its commodity's -- | Get the string representation of an amount, based on its commodity's
-- display settings. -- display settings.
showAmount :: Amount -> String showAmount :: Amount -> String
@ -208,7 +208,7 @@ normaliseMixedAmount (Mixed as) = Mixed as''
sym = symbol . commodity sym = symbol . commodity
as' | null nonzeros = [head $ zeros ++ [nullamt]] as' | null nonzeros = [head $ zeros ++ [nullamt]]
| otherwise = nonzeros | otherwise = nonzeros
(zeros,nonzeros) = partition isZeroAmount as (zeros,nonzeros) = partition isReallyZeroAmount as
sumSamePricedAmountsPreservingPrice [] = nullamt sumSamePricedAmountsPreservingPrice [] = nullamt
sumSamePricedAmountsPreservingPrice as = (sum as){price=price $ head as} sumSamePricedAmountsPreservingPrice as = (sum as){price=price $ head as}

11
Tests.hs
View File

@ -309,6 +309,17 @@ tests = [
sum [a2,a3] `is` Amount (comm "$") (-2.46) Nothing sum [a2,a3] `is` Amount (comm "$") (-2.46) Nothing
sum [a3,a3] `is` Amount (comm "$") (-2.46) Nothing sum [a3,a3] `is` Amount (comm "$") (-2.46) Nothing
sum [a1,a2,a3,-a3] `is` Amount (comm "$") 0 Nothing sum [a1,a2,a3,-a3] `is` Amount (comm "$") 0 Nothing
let dollar0 = dollar{precision=0}
(sum [Amount dollar 1.25 Nothing, Amount dollar0 (-1) Nothing, Amount dollar (-0.25) Nothing])
`is` (Amount dollar 0 Nothing)
,"mixed amount arithmetic" ~: do
let dollar0 = dollar{precision=0}
(sum $ map (Mixed . (\a -> [a]))
[Amount dollar 1.25 Nothing,
Amount dollar0 (-1) Nothing,
Amount dollar (-0.25) Nothing])
`is` Mixed [Amount dollar 0 Nothing]
,"balance report tests" ~: ,"balance report tests" ~:
let (opts,args) `gives` es = do let (opts,args) `gives` es = do