-- <PRE>
{-  From the prelude, so we can't redefine
class Eq a where
    (==), (/=) :: a -> a -> Bool
    x /= y      = not (x==y)


class (Eq a) => Ord a where
    compare    :: a -> a -> Ordering
    (<), (<=), (>=), (>)  :: a -> a -> Bool
    max, min              :: a -> a -> a
-}


-------- Equality over Arithmetic Expressions

data Aop = Add | Sub | Mult | Div
data Aexp = Num Int | Exp (Aexp, Aop, Aexp)

int_eq :: Int -> Int -> Bool
int_eq x y = x==y

aop_eq Add Add = True
aop_eq Sub Sub = True
aop_eq Mult Mult = True
aop_eq Div Div = True
aop_eq _ _ = False

aexp_eq (Num x) (Num y) = int_eq x y
aexp_eq (Exp(e1,x,e2))(Exp(f1,y,f2))
  = (aexp_eq e1 f1) &&
    (aop_eq x y) &&
    (aexp_eq e2 f2)
aexp_eq _ _ = False


instance Eq(Aop) where
  x == y = aop_eq x y
  x /= y = not(aop_eq x y )

instance Eq(Aexp) where
  x == y = aexp_eq x y
  x /= y = not(aexp_eq x y )

------The Complex Example

data Complex = C Float Float

complex_add (C x y) (C a b) = C (x+a) (y+b)

complex_sub (C x y) (C a b) = C (x-a) (y-b)

complex_mult (C x y) (C a b)
     = C (x*a - y*b) (x*b + a*y)


instance Eq(Complex) where
    (C x y) == (C a b) = x==a && y==b

instance Show(Complex)  where
    showsPrec = error "No show for complex"
    showList = error "No show for complex"

instance Num(Complex) where
  x + y = complex_add x y
  x - y = complex_sub x y
  x * y = complex_mult x y

 {- The full Num class from the prelude so it can't be redefined. Use comment
 class (Eq a, Show a) => Num a where
     (+), (-), (*)  :: a -> a -> a
     negate         :: a -> a
     abs, signum    :: a -> a
     fromInteger    :: Integer -> a
     fromInt        :: Int -> a

     x - y           = x + negate y
     fromInt         = fromIntegral
-}


---------- Ordering of trees
data Tree a = Leaf a | Branch (Tree a) (Tree a)

instance Eq a => Eq (Tree a) where
  (Leaf x) == (Leaf y) = x==y
  (Branch x y) == (Branch a b) = x==a && y==b
  _ == _ = False


instance (Ord a,Eq a) => Ord(Tree a) where
  (Leaf _) < (Branch _ _) = True
  (Leaf x) < (Leaf y)     = x < y
  (Branch _ _) < (Leaf _) = False
  (Branch l1 r1) < (Branch l2 r2)
       = if l1==l2
            then r1 < r2
            else l1 < l2

  t1 <= t2 = t1 < t2 || t1 == t2

-------- Classes for type constuctors - Motivation
data Mylist a = Nil | Cons a (Mylist a)

int_list_eq(Nil, Nil) = True
int_list_eq(Cons x xs, Cons y ys) =
   (int_eq x y) && (int_list_eq(xs,ys))
int_list_eq (_, _) = False

list_eq :: (a -> b -> Bool) -> (Mylist a,Mylist b) -> Bool
list_eq f (Nil, Nil) = True
list_eq f (Cons x xs, Cons y ys) =
    (f x y) && (list_eq f (xs, ys))
list_eq f (_, _) = False


instance Eq a => Eq(Mylist a) where
   Nil == Nil                 = True
   (Cons x xs) == (Cons y ys) = (x == y) && (xs == ys)
   _ == _                    = False

--------------- The Bush type. Soemthing to think about

data Bush a = One a
            | Two (Bush a) (Bush a)
            | Many [Bush a]

instance (Eq a) => Eq(Bush a)  where
  (One x) == (One y) = (x == y)
  (Two x1 x2) == (Two y1 y2) = (x1 == y1) && (x2 == y2)
  (Many xs) == (Many ys) = (xs == ys)
  _ == _ = False


------ The class MyShow a simplification of the Class Shoe

class MyShow a where
    myshow :: a -> String
    myshows :: a -> String -> String

name = "Tim"
age = 9

test = "My name is" ++ show name ++ "I am" ++ show age ++ "years old"

instance MyShow a => MyShow (Tree a) where
  myshow (Leaf x) = "(Leaf " ++ myshow x ++ ")"
  myshow (Branch x y) =
    "(Branch" ++ myshow x ++ myshow y ++ ")"

showsTree :: MyShow a => Tree a -> String -> String
showsTree (Leaf x) s = "(Leaf " ++ myshow x ++ ")" ++ s
showsTree (Branch x y) s =
  "(Branch" ++ (showsTree x (showsTree y (")" ++ s)))


showsList [] s     = s
showsList (x:xs) s = shows x (showsList xs s)


-------- Derived Instances

data Color = Red | Orange | Yellow | Green
           | Blue |Indigo | Violet
  deriving Show

data Exp = Int Int | Plus Exp Exp | Minus Exp Exp
  deriving (Eq,Show)

-------- Propogating qualified types

member x [] = False
member x (z:zs) =
    if x==z then True else member x zs

-- </PRE>