data Exp = Plus  Exp Exp
         | Minus Exp Exp
         | Times Exp Exp
         | Div   Exp Exp
         | Const Int
         deriving Show

answer = (Div (Div (Const 1972) (Const 2)) (Const 23))
err    = (Div (Const 1) (Const 0))

eval :: Exp -> Int
eval (Plus  e1 e2) = (eval e1) + (eval e2)
eval (Minus e1 e2) = (eval e1) - (eval e2)
eval (Times e1 e2) = (eval e1) * (eval e2)
eval (Div   e1 e2) = (eval e1) `div` (eval e2)
eval (Const i)     = i

-- VAR 1: Error handling

data M1 a = Raise Exception | Return a deriving Show
type Exception = String

evalE :: Exp -> M1 Int
-- Plus, Minus, Times cases omitted.
evalE (Div e1 e2) = 
   case evalE e1 of
      Return a -> 
        case evalE e2 of
          Return b -> if b == 0 then Raise "division by 0"
                   else Return (a `div` b)
          Raise s -> Raise s
      Raise s -> Raise s
evalE (Const i)  = Return i

-- VAR 2: State

type M2 a   = State -> (a, State)
type State = Int

evalS :: Exp -> M2 Int
-- Plus, Minus, Times cases omitted.
evalS (Div e1 e2) x = let (a, y) = evalS e1 x in
                      let (b, z) = evalS e2 y in
                      (a `div` b, z+1)
evalS (Const i)   x = (i, x)

-- VAR 3: Output

type M3 a    = (a, Output)
type Output = String

evalO :: Exp -> M3 Int
-- Plus, Minus, Times cases omitted.
evalO (Div e1 e2) = let (a, x) = evalO e1 in
                    let (b, y) = evalO e2 in
                    (a `div` b, 
                        x ++ y ++ line (Div e1 e2) (a `div` b))
evalO (Const i)   = (i, line (Const i) i)

line :: Exp -> Int -> Output
line e a = show e ++ "=" ++ show a ++ "\n"

----------------------------------------------------
----------------------------------------------------

-- MONADIC evaluator

data Id t = Id t deriving Show

instance Functor Id where
   fmap f (Id x) = Id (f x)

instance Applicative Id where
   pure x = Id x
   Id f <*> Id x = Id (f x)

instance Monad Id where
   (Id x) >>= f = f x


evalM0 :: Exp -> Id Int
evalM0 (Div e1 e2) = evalM0 e1 >>= (\a ->
                     evalM0 e2 >>= (\b -> 
                     return (a `div` b))) 
evalM0 (Const i)   = return i

evalM :: Exp -> Id Int
evalM (Div e1 e2) = do a <- evalM e1;
                       b <- evalM e2;
                       return (a `div` b)
evalM (Const i)   = return i


-- MONADIC VAR 1: Error handling

data ME a = Error Exception | Ok a deriving Show

instance Functor ME where
   fmap f m = m >>= pure . f

instance Applicative ME where
   pure a = Ok a
   f1 <*> f2 = f1 >>= \v1 -> f2 >>= (pure . v1)

instance Monad ME where 
   m >>= f  = case m of Error s  -> Error s
                        Ok a -> f a

raise :: Exception -> ME a
raise s = Error s

evalME :: Exp -> ME Int
evalME (Div e1 e2) = do a <- evalME e1;
                        b <- evalME e2;
                        if b == 0 then (raise "division by 0")
                                  else return (a `div` b)
evalME (Const i)   = return i

-- MONADIC VAR 2: State

newtype MS a = MS { runMS :: (State -> (a, State)) }

instance Functor MS where
   fmap f m = m >>= pure . f

instance Applicative MS where
   pure a = MS (\x -> (a, x))
   f1 <*> f2 = f1 >>= \v1 -> f2 >>= (pure . v1)

instance Monad MS where
   return a = MS (\x -> (a, x))
   m >>= f  = MS $ \x -> let (a, y) = runMS m x in
                         let (b, z) = runMS (f a) y in
                         (b, z)

tick = MS (\x -> ((),x+1))

evalMS :: Exp -> MS Int
evalMS (Div e1 e2) = do a <- evalMS e1;
                        b <- evalMS e2;
                        tick;
                        return (a `div` b)
evalMS (Const i)   = return i

-- MONADIC VAR 3: Output

newtype MO a = MO (a, Output) deriving Show

instance Functor MO where
   fmap f m = m >>= pure . f

instance Applicative MO where
   pure a = MO (a, "")
   f1 <*> f2 = f1 >>= \v1 -> f2 >>= (pure . v1)
 
instance Monad MO where
   return a  = MO (a, "")
   m >>= f   = MO $ let MO (a,x) = m in
                    let MO (b,y) = f a in
                    (b, x ++ y)

out :: Output -> MO ()
out s = MO((), s)

evalMO :: Exp -> MO Int
evalMO (Div e1 e2) = do a <- evalMO e1;
                        b <- evalMO e2;
                        out (line (Div e1 e2) (a `div` b));
                        return (a `div` b)
evalMO (Const i)   = do out (line (Const i) i);
                        return i

-- MONADIC VAR 1+2: State and Error Handling
data Res a = Bad Exception State | Good a State
    deriving Show 

newtype MES a = MES { runMES :: State -> Res a }

instance Functor MES where
   fmap f m = m >>= pure . f

instance Applicative MES where
   pure a = MES (\x -> Good a x)
   f1 <*> f2 = f1 >>= \v1 -> f2 >>= (pure . v1)
 
instance Monad MES where 
   return a = MES (\x -> Good a x)
   m >>= f  = MES $ \x ->
                 case runMES m x of 
                     Good a s -> case runMES (f a) s of
                                     Good b s' -> Good b s'
                                     Bad  e s' -> Bad  e s'
                     Bad  e s -> Bad e s

raise_ES e = MES (\x -> Bad e x)
tick_ES    = MES (\s -> Good () (s+1))

evalMES (Div e1 e2) = do a <- evalMES e1;
                         b <- evalMES e2;
                         tick_ES;
                         if b == 0 then (raise_ES "division by 0")
                                   else return (a `div` b)
evalMES (Const i)   = return i