module TypeClassExamples where
import List;
-- A function with a type class constraint in its type
member :: Eq a => a -> [a] -> Bool
member _ [] = False
member x (y:ys) | x == y = True
| otherwise = member x ys
-- Shorter version
member' :: Eq a => a -> [a] -> Bool
member' _ [] = False
member' x (y:ys) = x == y || member' x ys
-- Natural numbers as an algebraic data type
data Nat = Zero | Suc Nat
instance Eq Nat where
Zero == Zero = True
(Suc n) == (Suc m) = n == m
_ == _ = False
instance Ord Nat where
Zero <= Zero = True
Zero <= (Suc _) = True
(Suc n) <= (Suc m) = n <= m
_ <= _ = False
-- Last case equivalent to these two:
-- (Suc n) <= Zero = False
-- (Suc n) <= (Suc m) = not (n <= m)
-- Alternative definition using compare:
-- instance Ord Nat where
-- compare Zero Zero = EQ
-- compare Zero (Suc _) = LT
-- compare (Suc n) (Suc m) = compare n m
-- compare _ _ = GT
-- This is what the compiler would derive with "deriving Show":
-- instance Show Nat where
-- show Zero = "Zero"
-- show (Suc n) = "Suc" ++ show n
-- But we can do better:
toInt :: Nat -> Int
toInt Zero = 0
toInt (Suc n) = 1 + toInt n
instance Show Nat where
show n = show (toInt n)
-- More elegant definition using composition:
-- show = show . toInt
-- A rough algebraic data type for dates
data Date = Date Int Int Int deriving Show
-- We define equality for dates
instance Eq Date where
(Date x y z) == (Date r s t) = x == r && y == s && z == t
-- Now with parametric trees
data TreeExp a b = Leaf a | Node b (TreeExp a b) (TreeExp a b)
instance (Eq a, Eq b) => Eq (TreeExp a b) where
Leaf x == Leaf y = x == y
(Node x l1 r1) == (Node y l2 r2) = x == y && l1 == l2 && r1 == r2
_ == _ = False
treeFuns :: TreeExp Int (Int -> Int -> Int)
treeFuns = Node (+) (Node (-) (Leaf 1) (Leaf 2))
(Node (*) (Leaf 3) (Leaf 4))
-- This does not compile:
-- testFun :: Bool
-- testFun = treeFuns == treeFuns
data Operation = Add | Sub | Mul deriving (Eq,Show)
-- instance Eq Operation where
-- Add == Add = True
-- Sub == Sub = True
-- Mul == Mul = True
-- _ == _ = False
treeOps :: TreeExp Int Operation
treeOps = Node Add (Node Sub (Leaf 1) (Leaf 2))
(Node Mul (Leaf 3) (Leaf 4))
-- But this compiles:
testOps :: Bool
testOps = treeOps == treeOps
-- Let's remember evaluation:
evalTreeExpFuns :: TreeExp Int (Int -> Int -> Int) -> Int
evalTreeExpFuns (Leaf i) = i
evalTreeExpFuns (Node f l r) = f (evalTreeExpFuns l) (evalTreeExpFuns r)
-- Some more work for trees with Operation tags:
dispatch :: Operation -> (Int -> Int -> Int)
dispatch Add = (+)
dispatch Sub = (-)
dispatch Mul = (*)
evalTreeExpOps :: TreeExp Int Operation -> Int
evalTreeExpOps (Leaf i) = i
evalTreeExpOps (Node op l r) =
(dispatch op) (evalTreeExpOps l) (evalTreeExpOps r)
-- Take a look again at "dispatch": higher order!
valueFun :: Int
valueFun = evalTreeExpFuns treeFuns
valueOps :: Int
valueOps = evalTreeExpOps treeOps
-- Fold for TreeExp
foldTreeExp :: (a -> c) -> (b -> c -> c -> c) -> TreeExp a b -> c
foldTreeExp l n (Leaf x) = l x
foldTreeExp l n (Node x lt rt) = n x (foldTreeExp l n lt) (foldTreeExp l n rt)
-- Exercise: write evalTreeExpOps in terms of foldTreeExp
-- Complete example with classes Show, Eq, Ord and Enum.
-- Compare this code with that produced by compiler using "deriving" clause.
data Day = Mon | Tue | Wed | Thu | Fri | Sat | Sun
instance Show Day where
show Mon = "Monday"
show Tue = "Tuesday"
show Wed = "Wednesday"
show Thu = "Thursday"
show Fri = "Friday"
show Sat = "Saturday"
show Sun = "Sunday"
instance Eq Day where
x == y = show x == show y
-- instance Eq Day where
-- Mon == Mon = True
-- Tue == Tue = True
-- Wed == Wed = True
-- Thu == Thu = True
-- Fri == Fri = True
-- Sat == Sat = True
-- Sun == Sun = True
-- _ == _ = False
instance Ord Day where
x <= y = fromEnum x <= fromEnum y
instance Enum Day where
toEnum n | n < 0 = error "toEnum: negative integer"
| n == 0 = Mon
| n == 1 = Tue
| n == 2 = Wed
| n == 3 = Thu
| n == 4 = Fri
| n == 5 = Sat
| n == 6 = Sun
| otherwise = toEnum (n `mod` 7)
fromEnum Mon = 0
fromEnum Tue = 1
fromEnum Wed = 2
fromEnum Thu = 3
fromEnum Fri = 4
fromEnum Sat = 5
fromEnum Sun = 6