-- Task: write an evaluator for arithmetic expression (desk calculator)

-- Arithmetic expressions:
data Exp = Num Int
         | Add Exp Exp
         | Sub Exp Exp
         | Mul Exp Exp
         | Div Exp Exp
 deriving Show

-- 3 + (4 * 5)
exp1 = Add (Num 3) (Mul (Num 4) (Num 5))

-- 3 + (4 / (3 - 3))
exp2 = Add (Num 3) (Div (Num 4) (Sub (Num 3) (Num 3)))

-- The safe evaluator:
evalA :: Exp -> Maybe Int
evalA (Num n)     = Just n
evalA (Add e1 e2) = (+) <$> evalA e1 <*> evalA e2
evalA (Sub e1 e2) = (-) <$> evalA e1 <*> evalA e2
evalA (Mul e1 e2) = (*) <$> evalA e1 <*> evalA e2
evalA (Div e1 e2) = mdiv (evalA e1) (evalA e2)
 where
  mdiv Nothing  _        = Nothing
  mdiv (Just _) Nothing  = Nothing
  mdiv (Just x) (Just y) = safeDiv x y


safeDiv :: Int -> Int -> Maybe Int
safeDiv x y = if y == 0 then Nothing
                        else Just (x `div` y)

processMaybe :: Maybe a -> (a -> Maybe b) -> Maybe b
processMaybe Nothing  _ = Nothing
processMaybe (Just x) f = f x

-- (>>=) :: IO a -> (a -> IO b) -> IO b

-- A more structured evaluator:
evalM :: Exp -> Maybe Int
evalM (Num n)     = pure n
evalM (Add e1 e2) = (+) <$> evalM e1 <*> evalM e2
evalM (Sub e1 e2) = (-) <$> evalM e1 <*> evalM e2
evalM (Mul e1 e2) = (*) <$> evalM e1 <*> evalM e2
evalM (Div e1 e2) = processMaybe (evalM e1)
                                (\x -> processMaybe (evalM e2)
                                                    (\y -> safeDiv x y))

{-
class Applicative m => Monad m where
  return :: a -> m a
  return = pure

  (>>=) :: m a -> (a -> m b) -> m b

  (>>) :: m a -> m b -> m b
  a1 >> a2 = a1 >>= (\_ -> a2)

instance Monad Maybe where
  mx >>= f = case mx of Nothing -> Nothing
                        Just x  -> f x
-}

-- A monadic evaluator:
eval :: Exp -> Maybe Int
eval (Num n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Sub e1 e2) = (-) <$> eval e1 <*> eval e2
eval (Mul e1 e2) = (*) <$> eval e1 <*> eval e2
eval (Div e1 e2) = do x <- eval e1
                      y <- eval e2
                      safeDiv x y

{-
instance Monad [] where
  --(>>=) :: [a] -> (a -> [b]) -> [b]
  xs >>= f = [ y | x <- xs, y <- f x ]
-}

-- do notation for lists
pairs :: [a] -> [b] -> [(a,b)]
pairs xs ys = do x <- xs
                 y <- ys
                 return (x,y)

{-
Monad laws:

return x >>= f            =  f x
mx >>= return             =  mx
mx >>= (\x -> f x >>= g)  =  (mx >>= f) >>= g

pure = return
m1 <*> m2 = m1 >>= (\x1 -> m2 >>= (\x2 -> return (x1 x2)))
-}