module Control.Monad.StateX.Lazy (
module Control.Monad.StateX.Class,
StateX(..),
runStateX,
evalStatex,
execStatex,
mapStatex,
withStatex,
StateTX(..),
runStateTX,
evalStateTX,
execStateTX,
mapStateTX,
withStateTX,
module Control.Monad,
module Control.Monad.Fix,
module Control.Monad.Trans,
) where
import Control.Monad
import Control.Monad.Cont.Class
import Control.Monad.Error.Class
import Control.Monad.Fix
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Trans
import Control.Monad.Writer
import Control.Monad.Index
import Control.Monad.ReaderX.Class
import Control.Monad.StateX.Class
import Control.Monad.WriterX.Class
data (Index ix) => StateX ix s a = StateX ix (s -> (a,s))
runStateX :: (Index ix) => ix -> StateX ix s a -> (s -> (a,s))
runStateX (_::ix) (StateX (_::ix) f) s = f s
evalStatex :: (Index ix) => ix -> StateX ix s a -> s -> a
evalStatex (ixv::ix) m s = fst (runStateX ixv m s)
execStatex :: (Index ix) => ix -> StateX ix s a -> s -> s
execStatex (ixv::ix) m s = snd (runStateX ixv m s)
mapStatex :: (Index ix) => ix -> ((a, s) -> (b, s)) -> StateX ix s a -> StateX ix s b
mapStatex (ixv::ix) f m = StateX ixv $ f . runStateX ixv m
withStatex :: (Index ix) => ix -> (s -> s) -> StateX ix s a -> StateX ix s a
withStatex (ixv::ix) f m = StateX ixv $ runStateX ixv m . f
instance (Index ix) => Functor (StateX ix s) where
fmap f m = StateX (getVal::ix) $ \s -> let
(a, s') = runStateX (getVal::ix) m s
in (f a, s')
instance (Index ix) => Monad (StateX ix s) where
return a = StateX (getVal::ix) $ \s -> (a, s)
(StateX (ixv::ix) x) >>= f = StateX ixv $ \s ->
case (x s) of (v,s') -> runStateX ixv (f v) s'
instance (Index ix) => MonadFix (StateX ix s) where
mfix f = StateX (getVal::ix) $ \s -> let (a, s') = runStateX (getVal::ix) (f a) s in (a, s')
instance (Index ix) => MonadStateX ix s (StateX ix s) where
getx (ixv::ix) = StateX ixv $ \s -> (s, s)
putx (ixv::ix) s = StateX ixv $ \_ -> ((), s)
data (Index ix) => StateTX ix s m a = StateTX ix (s -> (m (a,s)))
runStateTX :: (Index ix) => ix -> StateTX ix s m a -> (s -> (m (a,s)))
runStateTX (_::ix) (StateTX (_::ix) f) s = f s
evalStateTX :: (Monad m, Index ix) => ix -> StateTX ix s m a -> s -> m a
evalStateTX (ixv::ix) m s = do
~(a, _) <- runStateTX ixv m s
return a
execStateTX :: (Monad m, Index ix) => ix -> StateTX ix s m a -> s -> m s
execStateTX (ixv::ix) m s = do
~(_, s') <- runStateTX ixv m s
return s'
mapStateTX :: (Index ix) => ix -> (m (a, s) -> n (b, s)) -> StateTX ix s m a -> StateTX ix s n b
mapStateTX (ixv::ix) f m = StateTX ixv $ f . runStateTX ixv m
withStateTX :: (Index ix) => ix -> (s -> s) -> StateTX ix s m a -> StateTX ix s m a
withStateTX (ixv::ix) f m = StateTX ixv $ runStateTX ixv m . f
instance (Monad m,Index ix) => Functor (StateTX ix s m) where
fmap f m = StateTX (getVal::ix) $ \s -> do
~(x, s') <- runStateTX (getVal::ix) m s
return (f x, s')
instance (Monad m, Index ix) => Monad (StateTX ix s m) where
return a = StateTX (getVal::ix) $ \s -> return (a, s)
(StateTX (ixv::ix) x) >>= f = StateTX ixv $ \s -> do
~(a, s') <- x s
runStateTX ixv (f a) s'
fail str = StateTX (getVal::ix) $ \_ -> fail str
instance (MonadPlus m, Index ix) => MonadPlus (StateTX ix s m) where
mzero = StateTX (getVal::ix) $ \_ -> mzero
m `mplus` n = StateTX (getVal::ix) $ \s -> runStateTX (getVal::ix) m s `mplus` runStateTX (getVal::ix) n s
instance (MonadFix m, Index ix) => MonadFix (StateTX ix s m) where
mfix f = StateTX (getVal::ix) $ \s -> mfix $ \ ~(a, _) -> runStateTX (getVal::ix) (f a) s
instance (Monad m, Index ix) => MonadStateX ix s (StateTX ix s m) where
getx (ixv::ix) = StateTX ixv $ \s -> return (s, s)
putx (ixv::ix) s = StateTX ixv $ \_ -> return ((), s)
instance (Index ix) => MonadTrans (StateTX ix s) where
lift m = StateTX (getVal::ix) $ \s -> do
a <- m
return (a, s)
instance (MonadIO m, Index ix) => MonadIO (StateTX ix s m) where
liftIO = lift . liftIO
instance (MonadCont m, Index ix) => MonadCont (StateTX ix s m) where
callCC f = StateTX (getVal::ix) $ \s ->
callCC $ \c ->
runStateTX (getVal::ix) (f (\a -> StateTX (getVal::ix) $ \s' -> c (a, s'))) s
instance (MonadError e m, Index ix) => MonadError e (StateTX ix s m) where
throwError = lift . throwError
m `catchError` h = StateTX (getVal::ix) $ \s -> runStateTX (getVal::ix) m s
`catchError` \e -> runStateTX (getVal::ix) (h e) s
instance (MonadState s1 m,Index ix) => MonadState s1 (StateTX ix s2 m) where
get = StateTX (getVal::ix) $ \s -> do
n <- get
return (n,s)
put (v::s1) = StateTX (getVal::ix) $ \s -> do
put v
return ((),s)
instance (Index ix1, Index ix2, MonadStateX ix1 s1 m )
=> MonadStateX ix1 s1 (StateTX ix2 s2 m) where
getx (ixv::ix1) = StateTX (getVal::ix2) $
\(s::s2)-> getx (ixv::ix1) >>= (\v1 -> return (v1,s))
putx (ixv::ix1) v1 = StateTX (getVal::ix2) $
\(s::s2)-> putx (ixv::ix1) (v1) >> return ((),s)
instance (Index ix, MonadReader r m) => MonadReader r (StateTX ix st m) where
ask = lift ask
local f m = StateTX (getVal::ix) $ \(s::st) -> local f (runStateTX (getVal::ix) m s)
instance (Index ixs, MonadReaderX ixr r m) => MonadReaderX ixr r (StateTX ixs st m) where
askx (ixv::ixr) = lift $ askx ixv
localx (ixv::ixr) f m = StateTX (getVal::ixs) $ \(s::st) -> localx ixv f (runStateTX (getVal::ixs) m s)
--Writer
instance (Index ix, MonadWriter w m) => MonadWriter w (StateTX ix s m) where
tell = lift . tell
listen m = StateTX (getVal::ix) $ \s -> do
~((a,s'),w) <- listen (runStateTX (getVal::ix) m s)
return ((a,w),s')
pass m = StateTX (getVal::ix) $ \s -> pass $ do
~((a,f),s') <- runStateTX (getVal::ix) m s
return ((a,s'),f)
instance (Index ixs, MonadWriterX ixw w m) => MonadWriterX ixw w (StateTX ixs s m) where
tellx (ixv::ixw) = lift . tellx ixv
listenx (ixv::ixw) m = StateTX (getVal::ixs) $ \s -> do
~((a,s'),w) <- listenx ixv (runStateTX (getVal::ixs) m s)
return ((a,w),s')
passx (ixv::ixw) m = StateTX (getVal::ixs) $ \s -> passx ixv $ do
~((a,f),s') <- runStateTX (getVal::ixs) m s
return ((a,s'),f)