module Control.Monad.Trans.Memo.StateCache
(
StateCache(..),
container,
setContainer,
evalStateCache
) where
import Data.Function
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Trans
newtype StateCache c m a = StateCache { runStateCache :: c -> m (a, c) }
evalStateCache :: Monad m => StateCache c m a -> c -> m a
evalStateCache m !c = do
(a, _) <- runStateCache m c
return a
container :: Monad m => StateCache c m c
container = StateCache $ \ !c -> return (c, c)
setContainer :: Monad m => c -> StateCache c m ()
setContainer c = StateCache $ \_ -> return ((), c)
instance (Functor m) => Functor (StateCache c m) where
fmap f m = StateCache $ \ !c ->
fmap (\ (a, c') -> (f a, c')) (runStateCache m c)
instance (Functor m, Monad m) => Applicative (StateCache c m) where
pure = return
fa <*> aa = StateCache $ \ !c -> do
(f, c') <- runStateCache fa c
(a, c'') <- runStateCache aa c'
return (f a, c'')
instance (Functor m, MonadPlus m) => Alternative (StateCache c m) where
empty = mzero
(<|>) = mplus
instance (Monad m) => Monad (StateCache c m) where
return a = StateCache $ \ !c -> return (a, c)
m >>= k = StateCache $ \ !c -> do
(a, !c') <- runStateCache m c
runStateCache (k a) c'
m >> n = StateCache $ \ !c -> do
(_, !c') <- runStateCache m c
runStateCache n c'
fail str = StateCache $ \_ -> fail str
instance (MonadPlus m) => MonadPlus (StateCache c m) where
mzero = StateCache $ const mzero
m `mplus` n = StateCache $ \ !c -> runStateCache m c `mplus` runStateCache n c
instance (MonadFix m) => MonadFix (StateCache c m) where
mfix f = StateCache $ \ !c -> mfix $ \ ~(a, _) -> runStateCache (f a) c
instance MonadTrans (StateCache c) where
lift m = StateCache $ \ !c -> do
a <- m
return (a, c)
instance (MonadIO m) => MonadIO (StateCache c m) where
liftIO = lift . liftIO