{-# LANGUAGE InstanceSigs, KindSignatures #-}

class Functor' (f :: * -> *) where
  fmap' :: (a -> b) -> f a -> f b

class (Functor' m) => Monad' m where
  join' :: m (m a) -> m a
  return' :: a -> m a


join'' :: (Monad' m) => m (m c) -> m c
join'' x = bind' x (\ y -> y)
-- bind' (c1 :: m (m c))  (f :: m c -> m c) :: m c
-- we are instantiating a to m c and b to c in the type of bind'

bind' :: (Monad' m) => m a -> (a -> m b) -> m b
bind' c1 f = join' (fmap' f c1)
-- fmap' f :: m a -> m (m b)
-- fmap' f c1 :: m (m b)

-- Kleisli composition 
kcomp :: (Monad' m) => (a -> m b) -> (b -> m c) -> (a -> m c)
kcomp f g = \ x -> (f x) `bind'` g

-- e :: a
-- e' :: () -> a

-- e = e' ()
-- e' = \ x -> e 

bind2 :: (Monad' m) => m a -> (a -> m b) -> m b
bind2 x f = (kcomp (\ y -> x) f) ()
  -- :: () -> m b

class (Functor' m) => Monad'' m where
  bind'' ::  m a -> (a -> m b) -> m b
  return'' :: a -> m a

instance Functor' Maybe where
  fmap' :: (a -> b) -> Maybe a -> Maybe b
  fmap' f Nothing = Nothing
  fmap' f (Just x) = Just (f x)



data Exp =
  Base Integer
  | Add Exp Exp
  | Mul Exp Exp
  | Div Exp Exp
  deriving (Show, Eq)

eval :: Exp -> Integer
eval (Base n) = n
eval (Add e e') = eval e + eval e'
eval (Mul e e') = eval e * eval e'
eval (Div e e') = eval e `div` eval e'


eval' :: Exp -> Maybe Integer
eval' (Base n) = Just n
eval' (Add e e') =
  case eval' e of
    Nothing -> Nothing
    Just r1 -> case eval' e' of
                 Nothing -> Nothing
                 Just r2 -> Just (r1 + r2)

eval' (Mul e e') =
  case eval' e of
    Nothing -> Nothing
    Just r1 -> case eval' e' of
                 Nothing -> Nothing
                 Just r2 -> Just (r1 * r2)

eval' (Div e e') =
  case eval' e of
    Nothing -> Nothing
    Just r1 -> case eval' e' of
                 Nothing -> Nothing
                 Just r2 ->
                   if r2 == 0 then Nothing
                   else Just (r1 `div` r2)

instance Monad'' Maybe where
  bind'' :: Maybe a -> (a -> Maybe b) -> Maybe b
  bind'' Nothing f = Nothing
  bind'' (Just x) f = f x

  return'' :: a -> Maybe a
  return'' x = Just x

eval'' :: Exp -> Maybe Integer
eval'' (Base n) = return n
eval'' (Add e e') =
  eval'' e >>= 
  (\ x ->
      eval'' e' >>= 
      (\ y ->
          return (x + y)
      )
  )

eval'' (Mul e e') =
  eval'' e >>= 
  (\ x ->
      eval'' e' >>=
      (\ y ->
          return (x * y)
      )
  )

eval'' (Div e e') =
  eval'' e >>=
  (\ x ->
      eval'' e' >>=
      (\ y ->
          if y == 0 then Nothing
          else return (x `div` y)
      )
  )

-- using Do-notation   
eval''' :: Exp -> Maybe Integer
eval''' (Base n) = return n
eval''' (Add e e') = do
  x <- eval''' e
  y <- eval''' e'
  return (x+y)

eval''' (Mul e e') = do
  x <- eval''' e
  y <- eval''' e'
  return (x*y)

eval''' (Div e e') = do
  x <- eval''' e
  y <- eval''' e'
  if y == 0 then Nothing
    else return (x `div` y)




-- >
-- eval''' (Add e e') = do
--   eval''' e >>= \ x -> 
--     translate do y <- eval''' e'
--                  return (x+y)

-- > 
-- eval''' (Add e e') = 
--   eval''' e >>= \ x -> 
--            eval''' e' >>= \ y -> 
--                             return (x+y)


-- List comprehension

instance Functor' [] where
  fmap' = map

instance Monad'' [] where
  return'' :: a -> [a]
  return'' x = [x]

  bind'' :: [a] -> (a -> [b]) -> [b]
  bind'' [] f = []
  bind'' (x:xs) f = f x ++ bind'' xs f


l1 = [(i,j) | i <- [1,2], j <- [1..4]]

l1' :: [(Int, Int)]
l1' = do
  i <- [1,2]
  j <- [1..4]
  return (i, j)

l1'' :: [(Int, Int)]
l1'' =
  [1, 2] >>= (\ i ->
     [1..4] >>= (\ j -> return (i, j)))

-- ([1..4] >>= \ j -> [(1, j)]) ++ ([1..4] >>= \ j -> [(2, j)])
-- [(1, 1)] ++ [(1, 2)] ++ [(1, 3)] ++ [(1, 4)] ++ [(2, 1)] ++ [(2, 2)] ++ [(2, 3)]
-- ++ [(2, 4)]


l2 = [ x | x <- [1..10], odd x]

l2' = do
  x <- [1..10]
  if odd x then
    return x else []

l2'' =
  [1..10] >>= \ x -> if odd x then [x] else []

l3 = [x | x <- [1,5,12,3,23,11,7,2], x>10]

l4 = [(x,y) | x <- [1,3,5], y <- [2,4,6], let z = 2 * x ,  z<y] 

l4' = do
  x <- [1,3,5]
  y <- [2,4,6]
  let z = 2 * x
  if z<y then return (x, y) else []


type Id = Int

-- type State s a = s -> (a, s)

data State s a = S (s -> (a, s))

instance Functor (State s) where
  fmap :: (a -> b) -> State s a -> State s b
  fmap f (S g) =
    S (\ x -> let (y, x') = g x in (f y, x'))
    -- S (\ x ->  (f (fst (g x)), snd (g x)))
  -- f :: a -> b
  -- x :: s
  -- g :: s -> (a, s)
  -- g x :: (a , s)
  -- let (y1, y2) = g x in (f y1, y2) 

instance Applicative (State s) where
  
  

instance Monad (State s) where  
  return :: a -> State s a
  return x = S (\ y -> (x, y))

  (>>=) :: State s a -> (a -> State s b) -> State s b
  (>>=) (S g) f = S (\ y -> let (x , y') = g y 
                                S h = f x   -- h :: s -> (b, s)
                            in h y' -- :: (b , s) 
                        )
  -- g :: s -> (a, s)
  -- f :: a -> State s b
  -- y' :: s
  -- x :: a
  -- f x :: State s b


putState :: s -> State s ()
putState x = S (\ y -> ((), x))

getState :: State s s
getState = S (\ y -> (y, y))

runState :: State s a -> s -> (a, s)
runState (S f) y = f y

assignId :: [String] -> State Int [(Int, String)]
assignId [] = return []
assignId (x:xs) = do
  s <- getState
  putState (s+1)
  r <- assignId xs
  return ((s, x):r)