import Prelude hiding (Applicative, pure, (<*>), (<$>))

-- Currying for standard operations:
apply :: (a -> b) -> a -> b
apply f x = f x

add :: Int -> Int -> Int
add x y = x + y

madd = apply (apply add 2) 3

-- Currying for maps on the type level
class Functor tc => Applicative tc where
  pure  :: a -> tc a
  (<*>) :: tc (a -> b) -> tc a -> tc b

instance Applicative Maybe where
  pure x = Just x

  (Just f) <*> (Just x) = Just (f x)
  _        <*> _        = Nothing

fmap0 :: Applicative tc => a -> tc a
fmap0 = pure

fmap1 :: Applicative tc => (a -> b) -> tc a -> tc b
fmap1 f x = pure f <*> x

fmap2 :: Applicative tc => (a -> b -> c) -> tc a -> tc b -> tc c
fmap2 f x y = (pure f <*> x) <*> y

fmap3 :: Applicative tc => (a -> b -> c -> d) -> tc a -> tc b -> tc c -> tc d
fmap3 f x y z = pure f <*> x <*> y <*> z
-- ...

----------------------------------------------------------------------------
-- Example: an evaluator for arithmetic expressions

-- Representation of arithmetic expressions in Haskell:
data Exp = Num Int
         | Add Exp Exp
         | Sub Exp Exp
         | Mul Exp Exp
         | Div Exp Exp
 deriving Show

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

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

-- Evaluator with explicit testing:
evalBad :: Exp -> Maybe Int
evalBad (Num x)   = Just x
evalBad (Add x y) = madd (evalBad x) (evalBad y)
 where madd (Just x) (Just y) = Just (x + y)
       madd Nothing  _        = Nothing
       madd _        Nothing  = Nothing
evalBad (Sub x y) = msub (evalBad x) (evalBad y)
 where msub (Just x) (Just y) = Just (x - y)
       msub Nothing  _        = Nothing
       msub _        Nothing  = Nothing
evalBad (Mul x y) = mmul (evalBad x) (evalBad y)
 where mmul (Just x) (Just y) = Just (x * y)
       mmul Nothing  _        = Nothing
       mmul _        Nothing  = Nothing
evalBad (Div x y) = mdiv (evalBad x) (evalBad y)
 where mdiv (Just x) (Just y) = if y==0 then Nothing
                                        else Just (x `div` y)
       mdiv Nothing  _        = Nothing
       mdiv _        Nothing  = Nothing

-- Evaluator with use of Applicative:
eval' :: Exp -> Maybe Int
eval' (Num x)   = pure x
eval' (Add x y) = pure (+) <*> eval' x <*> eval' y
eval' (Sub x y) = pure (-) <*> eval' x <*> eval' y
eval' (Mul x y) = pure (*) <*> eval' x <*> eval' y
eval' (Div x y) = mdiv (eval' x) (eval' y)
 where mdiv (Just x) (Just y) = if y==0 then Nothing
                                        else Just (x `div` y)
       mdiv Nothing  _        = Nothing
       mdiv _        Nothing  = Nothing

-- Application of pure functions to Applicative arguments:
(<$>) :: Applicative tc => (a -> b) -> tc a -> tc b
f <$> x = pure f <*> x

-- Evaluator with use of Applicative and previous operation:
eval :: Exp -> Maybe Int
eval (Num x)   = pure x
eval (Add x y) = (+) <$> eval x <*> eval y
eval (Sub x y) = (-) <$> eval x <*> eval y
eval (Mul x y) = (*) <$> eval x <*> eval y
eval (Div x y) = mdiv (eval x) (eval y)
 where mdiv (Just x) (Just y) = if y==0 then Nothing
                                        else Just (x `div` y)
       mdiv Nothing  _        = Nothing
       mdiv _        Nothing  = Nothing

------------------------------
-- List instance of Applicative:
instance Applicative [] where
  --pure  :: a -> [a]
  pure x = [x]

  --(<*>) :: [(a -> b)] -> [a] -> [b]
  fs <*> xs = [ f x | f <- fs, x <- xs ]


-- IO instance of Applicative:
instance Applicative IO where
  --pure  :: a -> IO a
  pure x = return x

  --(<*>) :: IO (a -> b) -> IO a -> IO b
  mf <*> mx = do f <- mf
                 x <- mx
                 return (f x)