{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-- | Version on StateT which evaluates the state strictly at every step
module IdeSession.Strict.StateT (
    -- * Transformer
    StrictStateT(..)
  , modify
  , evalStateT
  , execStateT
    -- * As base monad
  , StrictState
  , runState
  , evalState
  , execState
  ) where

import Control.Applicative
import Control.Monad.State.Class
import Control.Monad.Trans.Class
import Data.Functor.Identity

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

instance Monad m => Applicative (StrictStateT s m) where
  pure    = return
  f <*> x = do f' <- f ; x' <- x ; return (f' x')

instance Monad m => Monad (StrictStateT s m) where
  return a = StrictStateT $ \s -> return (a, s)
  x >>= f  = StrictStateT $ \s -> do (a, s')  <- runStateT x s
                                     (b, s'') <- runStateT (f a) s'
                                     return (b, s'')

instance Monad m => Functor (StrictStateT s m) where
  f `fmap` m = m >>= return . f

instance Monad m => MonadState s (StrictStateT s m) where
  get     = StrictStateT $ \s -> return (s, s)
  put s   = StrictStateT $ \_ -> s `seq` return ((), s)
  state f = StrictStateT $ \s -> do let (a, s') = f s
                                    s' `seq` return (a, s')

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

evalStateT :: Monad m => StrictStateT s m a -> s -> m a
evalStateT m s = do (a, _) <- runStateT m s ; return a

execStateT :: Monad m => StrictStateT s m a -> s -> m s
execStateT m s = do (_, s') <- runStateT m s ; return s'

{------------------------------------------------------------------------------
  As base monad
------------------------------------------------------------------------------}

type StrictState s = StrictStateT s Identity

runState :: StrictState s a -> s -> (a, s)
runState m s = runIdentity $ runStateT m s

evalState :: StrictState s a -> s -> a
evalState m = fst . runState m

execState :: StrictState s a -> s -> s
execState m = snd . runState m