[Haskell-cafe] Re: money type ?
Adde
adde at trialcode.com
Thu Jul 12 10:27:52 EDT 2007
Simon Michael <simon <at> joyful.com> writes:
>
> Good day all,
>
> my budding ledger program could not balance transactions exactly because of
> rounding error with Double. I *think* I got it working better with Rational
> (it was late). Another suggestion from #haskell was to multiply all money
> by 100. I'm tracking multiple currencies/commodities with varying precision
> so this gets a bit more complicated.
>
> Is there a type or library out there that's good for representing money and
> other quantities while avoiding rounding errors ?
>
> Best - Simon
Disclaimer: I'm pretty much a beginner at Haskell.
Hacked something together a while ago for handling amounts and currencies. It
let's you specify the precision of each currency and stores the value as a
scaled Integer value. Haven't gotten around to implementing arithmetics yet but
by using the Integer values for calculations you sidestep the issues you run
into with Reals.
module Currency where
type Value = Integer
data (Currency c) => Amount c = Amount Value c
toAmount :: (Real a, Currency c) => a -> c -> (Amount c)
toAmount v c = Amount (round $ realToFrac $ v * (10 ^ (currencyPrecision c))) c
class Currency c where
currencyFormat :: (Num a) => c -> a -> String
currencyRoundingUnit :: (Fractional a) => (Amount c) -> a
currencyPrecision :: (Num a) => c -> a
instance (Currency c) => Show (Amount c) where
show a@(Amount _ c) = currencyFormat c $ amountRound a
fromAmount :: (Fractional a, Currency c) => (Amount c) -> a
fromAmount (Amount v c) = (fromInteger v) / (10 ^ (currencyPrecision c))
amountRound :: (Fractional a, Real a, Currency c) => (Amount c) -> a
amountRound a@(Amount _ c) = realToFrac $ integer + (steps * unit)
where
total = fromAmount a
integer = fromInteger $ truncate $ realToFrac total
fraction = total - integer
unit = currencyRoundingUnit a
steps = fromInteger $ round $ fraction / unit
data SEK = SEK
instance Currency SEK where
currencyFormat _ v = show v ++ "kr"
currencyRoundingUnit _ = 0.5
currencyPrecision _ = 4
data USD = USD
instance Currency USD where
currencyFormat _ v = "$" ++ show v
currencyRoundingUnit _ = 0.001
currencyPrecision _ = 4
class ExchangeRate c1 c2 where
exchangeRate :: (Fractional a) => c1 -> c2 -> a
amountConvert :: (Currency c1, Currency c2, ExchangeRate c1 c2) => Amount c1 ->
c2 -> Amount c2
amountConvert (Amount v c1) c2 = Amount (round $ (fromInteger v) * (exchangeRate
c1 c2)) c2
instance ExchangeRate SEK USD where
exchangeRate _ _ = 0.14285
/Adde
More information about the Haskell-Cafe
mailing list