{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}
  
import Control.Monad
import GHC.Base hiding ((<|>))

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

-- | monada identidad

newtype Id a = Id {runId :: a}

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

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

instance Monad Id where
  return a = Id a

  (Id a) >>= f = f a

-- | caracterizacion de las monadas de estado

class Monad m => MonadState s m | m -> s where
  get :: m s
  put :: s -> m ()

modify :: MonadState s m => (s -> s) -> m ()
modify f = do  s <- get
               put (f s)

-- | definicion de transformador de monadas

class MonadTrans t where
  lift :: Monad m => m a -> t m a

-- | state transformer               

newtype StateT s m a = StateT {runStateT :: s -> m (a, s)}

instance Monad m => Functor (StateT s m) where
  fmap f (StateT g) = StateT $ \s -> do {(a,s') <- g s; return (f a,s')}  

instance Monad m => Applicative (StateT s m) where
  pure a = StateT $ \s -> return (a, s)
  (StateT g) <*> (StateT k) = StateT $ \s -> do (f,s') <- g s
                                                (a,s'')<- k s'
                                                return (f a,s'')

instance Monad m => Monad (StateT s m) where
  return a = StateT $ \s -> return (a, s)

  m >>= f  = StateT $ \s ->  do (a, s') <- runStateT m s
                                runStateT (f a) s'

evalStateT :: Monad m => StateT s m a -> s -> m a
evalStateT m s = do (a,s') <- runStateT m s
                    return a

instance Monad m => MonadState s (StateT s m) where
  get = StateT $ \s -> return (s, s)
  
  put s  = StateT $ \_ -> return ((), s) 

instance MonadTrans (StateT s) where
  lift m = StateT $ \s -> do a <- m
                             return (a,s)

-- | contar sumas y listar numeros contenidos en una expresion
-- | usaremos dos estados, uno para la suam y otro para la lista

data Exp = Num Int | Add Exp Exp
     deriving Show

ej1 = Add (Add (Num 1) (Num 2)) (Num 3)
ej2 = Add ej1 ej1
ej3 = Num 4
ej4 = Add ej2 ej3

tick :: (Num a,MonadState a m) => m ()
tick = modify (+1)

-- | La monada m sobre la que vamos a computar va a ser el resultado
-- | de aplicar dos veces el transformador StateT:

--     m a = StateT Int (StateT [Int] Id Int)

-- | donde Id es la monada identidad.

evalSL :: Exp -> StateT Int (StateT [Int] Id) Int
evalSL (Num n)     = do lift (modify (n:))
                        return n
evalSL (Add e e')  = do a <- evalSL e
                        b <- evalSL e'
                        tick
                        return (a + b)

nroSumas :: Exp -> Int
nroSumas e = runId $ evalStateT (evalStateT nroS 0) []
  where
    nroS = do evalSL e
              s <- get
              return s

listaNums :: Exp -> [Int]
listaNums e = runId $ evalStateT (evalStateT listaN 0) []
  where
    listaN = do evalSL e
                vs <- lift get
                return vs

-- | La accion de retornar uno u otro estado se puede abstraer
-- | en una funcion g que toma el estado del nivel que se elija

evalExp e g = runId $ evalStateT (evalStateT eval 0) []
  where
    eval = do evalSL e
              st <- g
              return st

nroSumas' e  = evalExp e get
listaNums' e = evalExp e (lift get)