module Exercises.ChapterTwelve
  (
  ) where

data Tree a
  = Leaf
  | Node (Tree a)
         a
         (Tree a)
  deriving (Show)

instance Functor Tree
  -- fmap g Tree :: (a -> b) -> Tree a -> Tree b
                                                 where
  fmap _ Leaf = Leaf
  fmap g (Node l a r) = Node (fmap g l) (g a) (fmap g r)

-- instance Functor ((->) a)
--   -- fmap :: (b -> c) -> (a -> b) -> (a -> c)
--                                               where
--   fmap = (.)
-- instance Applicative ((->) a) where
--   pure = const -- K combinator
--   (<*>) f g x = f x (g x) -- S combinator
-- --  (<*>) = (a -> b -> c) -> (a -> b) -> (a -> c)
-- instance Monad ((->) a)
--   -- (>>=) :: (a -> b) -> (b -> (a -> c))) -> (a -> c)
--                                                        where
--   (>>=) f g x = g (f x) x
data Expr a
  = Var a
  | Val Int
  | Add (Expr a)
        (Expr a)
  deriving (Show)

instance Functor Expr
  -- fmap g Expr :: (a -> b) -> Expr a -> Expr b
                                                 where
  fmap g (Var a) = Var (g a)
  fmap _ (Val i) = Val i
  fmap g (Add l r) = Add (fmap g l) (fmap g r)

-- instance Applicative Expr
--   pure x = \env -> Var x
-- --  (<*>) = f (a -> b) -> f a -> f b
--   (<*>) g (Var a) = Var (g a)
--   (<*>) _ (Val i) = Val i
--   (<*>) g (Add l r) = Add ()
type State = Int

newtype ST a =
  S (State -> (a, State))

app :: ST a -> State -> (a, State)
app (S st) x = st x

instance Functor ST
  -- fmap :: (a -> b) -> ST a -> ST b
                                      where
  fmap g st = do
    x <- st
    return (g x)

instance Applicative ST
  -- pure :: a -> ST a
                       where
  pure x = S (\s -> (x, s))
  -- (<*>) :: ST (a -> b) -> ST a -> ST b
  stf <*> stx = do
    f <- stf
    x <- stx
    return (f x)

instance Monad ST
  -- (>>=) :: ST a -> (a -> ST b) -> ST b
                                          where
  st >>= f =
    S
      (\s ->
         let (x, s') = app st s
         in app (f x) s')
