USD: monitary representation as a data type

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
module Data.Monetary.USD where

-- Spraken dollars, mang! ... or, a type-classical way of uniformly treating
-- monetary values.

import Control.Scan.CSV              -- http://lpaste.net/109651

class Price a where value :: a -> Rational

data USD = USD Rational deriving Eq

instance Ord USD where USD x <= USD y = x <= y
instance Show USD where show (USD x) = '$':laxmi x
instance Raw USD where rep (USD x) = laxmi x

instance Price USD where
   value (USD x) = x     -- so Price-types are copointed ...

instance Num USD where
   d1 - d2 = USD $ value d1 - value d2
   negate dollar = USD $ 0.0 - value dollar
   d1 + d2 = USD $ value d1 + value d2
   d1 * d2 = USD $ value d1 * value d2
   abs dollar = USD $ abs (value dollar)
   signum dollar = USD $ signum (value dollar)
   fromInteger x = USD (fromInteger x)

instance Fractional USD where
   d1 / d2 = USD $ value d1 / value d2
   fromRational = USD

-- converts a number to a stringified-USD representation

laxmi :: Rational -> String
laxmi x = let dollars = floor x
              cents   = floor (x * 100) - dollars * 100
          in  show dollars ++ ('.':showAllDa cents)
              where showAllDa x | x > 9     = show x
                                | otherwise = '0':show x

mknMoney :: String -> USD
mknMoney str = let dd = read str :: Double in USD (toRational dd)

{-- but look at this!

*Analytics.Trading.Web.ETL Data.Monetary.USD> mknMoney "15.51" ~> $15.50
*Analytics.Trading.Web.ETL Data.Monetary.USD> mknMoney "15.52" ~> $15.51
*Analytics.Trading.Web.ETL Data.Monetary.USD> mknMoney "15.53" ~> $15.52

... why is this? --}