-- <PRE>

{- Defined in Prelude, so must be commented out here

class Functor f where
    map :: (a -> b) -> (f a -> f b)

-- Functor Laws
map id = id
map (f.g) = map f . map g
-}


-- Examples

data BinTree a = Leaf a | Branch (BinTree a) (BinTree a)

instance Functor BinTree where
   fmap f (Leaf x) = Leaf (f x)
   fmap f (Branch x y) = Branch (fmap f x) (fmap f y)

instance Functor ((,) a) where
   fmap f (x,y) = (x, f y)

{- Prelude defined instances

instance Functor [] where
    fmap f []     = []
    fmap f (x:xs) = f x : fmap f xs

instance Functor Maybe where
    fmap f Nothing  = Nothing
    fmap f (Just x) = Just (f x)

-}

-- Other uses of higher order type constructors

data Tree t a = Tip a | Node (t (Tree t a))

t1 = Node [Tip 3, Tip 0]

data Bin x = Two x x

t2 = Node (Two(Tip 5) (Tip 21))



{- Class Monad - predefined in prelude

class Monad m where
    (>>=)  :: m a -> (a -> m b) -> m b
    (>>)   :: m a -> m b -> m b
    return :: a -> m a
    fail   :: String -> m a

    p >> q  = p >>= \ _ -> q
    fail s  = error s
-}

{- Predefined instances

instance Monad [ ] where
    (x:xs) >>= f  =  f x ++ (xs >>= f)
    []     >>= f  =  []
    return x      =  [x]

instance Monad Maybe where
    Just x  >>= k  =  k x
    Nothing >>= k  =  Nothing
    return         =  Just

-}

find :: Eq a => a -> [(a,b)] -> Maybe b
find x [] = Nothing
find x ((y,a):ys) = if x == y then Just a else find x ys

test a c x =
  do { b <- find a x; return (c+b) }


{- Class MonadZero and MonadPlus

class Monad m => MonadZero m where
    zero   :: m a

class MonadZero m => MonadPlus m where
    (++)   :: m a -> m a -> m a

-}

{- Predefined Instances of MonadZero and MonadPluss

instance MonadZero [ ] where
    zero = []

instance MonadPlus [ ] where
    []     ++ ys = ys
    (x:xs) ++ ys = x : (xs ++ ys)

instance MonadZero Maybe where
    zero           = Nothing

instance MonadPlus Maybe where
    Nothing ++ ys  = ys
    xs      ++ ys  = xs

-}

-- Generic Monad operations
{-
sequence       :: Monad m => [m a] -> m [a]
sequence       =  foldr mcons (return [])
                    where mcons p q = do x  <- p
                                         xs <- q
                                         return (x:xs)

sequence_      :: Monad m => [m a] -> m ()
sequence_      =  foldr (>>) (return ())

mapM             :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f as        =  sequence (map f as)

mapM_            :: Monad m => (a -> m b) -> [a] -> m ()
mapM_ f as       =  sequence_ (map f as)

(=<<)            :: Monad m => (a -> m b) -> m a -> m b
f =<< x          =  x >>= f
-}

data Op = Plus | Minus | Times | Div
data Exp = Const Float | Var String | Oper Op Exp Exp

eval :: Exp -> [(String , Float)] -> Maybe Float
eval (Const n) env = Just n
eval (Var s) env = do { x <- find s env; Just x }
eval (Oper Div x y) env =
    do { a <- eval x env
       ; b <- eval y env
       ; if b==0.0 then Nothing else Just(a+b)
       }

eval2 :: Exp -> (String -> [Float]) -> [Float]
eval2 (Const n) env = [ n ]
eval2 (Var s) env = env s
eval2 (Oper Div x y) env =
    do { a <- eval2 x env
       ; b <- eval2 y env
       ; if b==0.0 then [] else return (a+b)
       }
--</PRE>