Permalink
Browse files

added typeclasses to access currency code

  • Loading branch information...
SKoschnicke committed May 4, 2012
1 parent 47ad189 commit 1289c36b9ab585c21821f1de979ea985d00fa14f
Showing with 45 additions and 37 deletions.
  1. +34 −28 PriceList.hs
  2. +11 −9 tests.hs
View
@@ -1,41 +1,47 @@
module PriceList (
- makeEuro, makeYen, Product(..)
+ makeEuro, makeYen, Product(..), Currency(..)
) where
- -- currencies
- data Euro
- data US_Dollar
- data Yen
- data Bitcoin
+-- currencies
+data Euro
+data US_Dollar
+data Yen
+data Bitcoin
- -- phantom type
- -- NOTE: the currency string is only added to have the currency at runtime,
- -- correctness is ensured at compile-time even without the string
- data Money currency = Money {
- amount :: Double,
- currency :: String
- } deriving (Show)
+-- phantom type
+-- NOTE: the currency string is only added to have the currency at runtime,
+-- correctness is ensured at compile-time even without the string
+data Money currency = Money {
+ amount :: Double
+} deriving (Show)
- -- this should be exported, not the type itself
- makeEuro :: Double -> Money Euro
- makeEuro a = (Money a "Euro")
+-- this should be exported, not the type itself
+makeEuro :: Double -> Money Euro
+makeEuro a = (Money a)
- makeYen :: Double -> Money Yen
- makeYen a = (Money a "Yen")
+makeYen :: Double -> Money Yen
+makeYen a = (Money a)
- instance Eq (Money a) where
- (==) (Money amount_a currency_a) (Money amount_b currency_b) = currency_a == currency_b && amount_a == amount_b
+class Currency a where currencyCode :: Money a -> String
- (+) :: Money a -> Money a -> Money a
- (+) x y = (Money (amount x Prelude.+ amount y) (currency x))
+instance Currency Euro where currencyCode _ = "EUR"
+instance Currency US_Dollar where currencyCode _ = "USD"
+instance Currency Yen where currencyCode _ = "YEN"
+instance Currency Bitcoin where currencyCode _ = "BC"
- -- a product should not have a price or an amount
- data Product = Product {
- name :: String
- } deriving (Show)
+instance Eq (Money a) where
+ (==) (Money amount_a) (Money amount_b) = amount_a == amount_b
- -- price definition is a product, a money instance and an matcher or something for the amount
- -- amount is a number and a unit
+(+) :: Money a -> Money a -> Money a
+(+) x y = (Money (amount x Prelude.+ amount y))
+
+-- a product should not have a price or an amount
+data Product = Product {
+ name :: String
+ } deriving (Show)
+
+-- price definition is a product, a money instance and an matcher or something for the amount
+-- amount is a number and a unit
-- sameCurrency :: Money -> Money -> Bool
-- sameCurrency (Money _ currency_a) (Money _ currency_b) = currency_a == currency_b
View
@@ -1,15 +1,17 @@
import Test.QuickCheck
import PriceList
-instance Arbitrary Currency where
- arbitrary = elements [Euro, US_Dollar, Yen, Bitcoin]
-
-instance Arbitrary Money where
+instance Arbitrary (Money a) where
arbitrary = do
- amount <- arbitrary
- currency <- arbitrary
- return (Money amount currency)
+ amount <- arbitrary
+ return (createFun amount)
+ where
+ createFun =
+ oneof [
+ makeEuro
+ , makeYen
+ ]
-prop_commutative a b = addMoney a b == addMoney b a
+prop_commutative a b = a + b == b + a
-main = quickCheck (prop_commutative :: Money -> Money -> Bool)
+main = quickCheck (prop_commutative :: Money a -> Money a -> Bool)

0 comments on commit 1289c36

Please sign in to comment.