{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric #-}
#endif
#if __GLASGOW_HASKELL__ >= 710 && __GLASGOW_HASKELL__ < 802
{-# LANGUAGE AutoDeriveTypeable #-}
#endif
module Control.Monad.Trans.State.Strict (
State,
state,
runState,
evalState,
execState,
mapState,
withState,
StateT(..),
evalStateT,
execStateT,
mapStateT,
withStateT,
get,
put,
modify,
modify',
gets,
liftCallCC,
liftCallCC',
liftCatch,
liftListen,
liftPass,
) where
import Control.Monad.IO.Class
import Control.Monad.Signatures
import Control.Monad.Trans.Class
#if MIN_VERSION_base(4,12,0)
import Data.Functor.Contravariant
#endif
import Data.Functor.Identity
import Control.Applicative
import Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import Control.Monad.Fix
#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics
#endif
type State s = StateT s Identity
state :: (Monad m)
=> (s -> (a, s))
-> StateT s m a
state :: (s -> (a, s)) -> StateT s m a
state s -> (a, s)
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((a, s) -> m (a, s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, s) -> m (a, s)) -> (s -> (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> (a, s)
f)
{-# INLINE state #-}
runState :: State s a
-> s
-> (a, s)
runState :: State s a -> s -> (a, s)
runState State s a
m = Identity (a, s) -> (a, s)
forall a. Identity a -> a
runIdentity (Identity (a, s) -> (a, s))
-> (s -> Identity (a, s)) -> s -> (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State s a -> s -> Identity (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT State s a
m
{-# INLINE runState #-}
evalState :: State s a
-> s
-> a
evalState :: State s a -> s -> a
evalState State s a
m s
s = (a, s) -> a
forall a b. (a, b) -> a
fst (State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState State s a
m s
s)
{-# INLINE evalState #-}
execState :: State s a
-> s
-> s
execState :: State s a -> s -> s
execState State s a
m s
s = (a, s) -> s
forall a b. (a, b) -> b
snd (State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState State s a
m s
s)
{-# INLINE execState #-}
mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState (a, s) -> (b, s)
f = (Identity (a, s) -> Identity (b, s)) -> State s a -> State s b
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((b, s) -> Identity (b, s)
forall a. a -> Identity a
Identity ((b, s) -> Identity (b, s))
-> (Identity (a, s) -> (b, s))
-> Identity (a, s)
-> Identity (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, s) -> (b, s)
f ((a, s) -> (b, s))
-> (Identity (a, s) -> (a, s)) -> Identity (a, s) -> (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (a, s) -> (a, s)
forall a. Identity a -> a
runIdentity)
{-# INLINE mapState #-}
withState :: (s -> s) -> State s a -> State s a
withState :: (s -> s) -> State s a -> State s a
withState = (s -> s) -> State s a -> State s a
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT
{-# INLINE withState #-}
newtype StateT s m a = StateT { StateT s m a -> s -> m (a, s)
runStateT :: s -> m (a,s) }
#if __GLASGOW_HASKELL__ >= 702
deriving ((forall x. StateT s m a -> Rep (StateT s m a) x)
-> (forall x. Rep (StateT s m a) x -> StateT s m a)
-> Generic (StateT s m a)
forall x. Rep (StateT s m a) x -> StateT s m a
forall x. StateT s m a -> Rep (StateT s m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s (m :: * -> *) a x. Rep (StateT s m a) x -> StateT s m a
forall s (m :: * -> *) a x. StateT s m a -> Rep (StateT s m a) x
$cto :: forall s (m :: * -> *) a x. Rep (StateT s m a) x -> StateT s m a
$cfrom :: forall s (m :: * -> *) a x. StateT s m a -> Rep (StateT s m a) x
Generic)
#endif
evalStateT :: (Monad m) => StateT s m a -> s -> m a
evalStateT :: StateT s m a -> s -> m a
evalStateT StateT s m a
m s
s = do
(a
a, s
_) <- StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE evalStateT #-}
execStateT :: (Monad m) => StateT s m a -> s -> m s
execStateT :: StateT s m a -> s -> m s
execStateT StateT s m a
m s
s = do
(a
_, s
s') <- StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
s'
{-# INLINE execStateT #-}
mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (a, s) -> n (b, s)
f StateT s m a
m = (s -> n (b, s)) -> StateT s n b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> n (b, s)) -> StateT s n b)
-> (s -> n (b, s)) -> StateT s n b
forall a b. (a -> b) -> a -> b
$ m (a, s) -> n (b, s)
f (m (a, s) -> n (b, s)) -> (s -> m (a, s)) -> s -> n (b, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m
{-# INLINE mapStateT #-}
withStateT :: (s -> s) -> StateT s m a -> StateT s m a
withStateT :: (s -> s) -> StateT s m a -> StateT s m a
withStateT s -> s
f StateT s m a
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m (s -> m (a, s)) -> (s -> s) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
f
{-# INLINE withStateT #-}
instance (Functor m) => Functor (StateT s m) where
fmap :: (a -> b) -> StateT s m a -> StateT s m b
fmap a -> b
f StateT s m a
m = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \ s
s ->
((a, s) -> (b, s)) -> m (a, s) -> m (b, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (a
a, s
s') -> (a -> b
f a
a, s
s')) (m (a, s) -> m (b, s)) -> m (a, s) -> m (b, s)
forall a b. (a -> b) -> a -> b
$ StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
{-# INLINE fmap #-}
instance (Functor m, Monad m) => Applicative (StateT s m) where
pure :: a -> StateT s m a
pure a
a = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> (a, s) -> m (a, s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, s
s)
{-# INLINE pure #-}
StateT s -> m (a -> b, s)
mf <*> :: StateT s m (a -> b) -> StateT s m a -> StateT s m b
<*> StateT s -> m (a, s)
mx = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \ s
s -> do
(a -> b
f, s
s') <- s -> m (a -> b, s)
mf s
s
(a
x, s
s'') <- s -> m (a, s)
mx s
s'
(b, s) -> m (b, s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x, s
s'')
{-# INLINE (<*>) #-}
StateT s m a
m *> :: StateT s m a -> StateT s m b -> StateT s m b
*> StateT s m b
k = StateT s m a
m StateT s m a -> (a -> StateT s m b) -> StateT s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
_ -> StateT s m b
k
{-# INLINE (*>) #-}
instance (Functor m, MonadPlus m) => Alternative (StateT s m) where
empty :: StateT s m a
empty = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
_ -> m (a, s)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE empty #-}
StateT s -> m (a, s)
m <|> :: StateT s m a -> StateT s m a -> StateT s m a
<|> StateT s -> m (a, s)
n = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> s -> m (a, s)
m s
s m (a, s) -> m (a, s) -> m (a, s)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` s -> m (a, s)
n s
s
{-# INLINE (<|>) #-}
instance (Monad m) => Monad (StateT s m) where
#if !(MIN_VERSION_base(4,8,0))
return a = StateT $ \ s -> return (a, s)
{-# INLINE return #-}
#endif
StateT s m a
m >>= :: StateT s m a -> (a -> StateT s m b) -> StateT s m b
>>= a -> StateT s m b
k = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \ s
s -> do
(a
a, s
s') <- StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT s m b
k a
a) s
s'
{-# INLINE (>>=) #-}
#if !(MIN_VERSION_base(4,13,0))
fail str = StateT $ \ _ -> fail str
{-# INLINE fail #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where
fail :: String -> StateT s m a
fail String
str = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
_ -> String -> m (a, s)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
str
{-# INLINE fail #-}
#endif
instance (MonadPlus m) => MonadPlus (StateT s m) where
mzero :: StateT s m a
mzero = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
_ -> m (a, s)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE mzero #-}
StateT s -> m (a, s)
m mplus :: StateT s m a -> StateT s m a -> StateT s m a
`mplus` StateT s -> m (a, s)
n = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> s -> m (a, s)
m s
s m (a, s) -> m (a, s) -> m (a, s)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` s -> m (a, s)
n s
s
{-# INLINE mplus #-}
instance (MonadFix m) => MonadFix (StateT s m) where
mfix :: (a -> StateT s m a) -> StateT s m a
mfix a -> StateT s m a
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> ((a, s) -> m (a, s)) -> m (a, s)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (((a, s) -> m (a, s)) -> m (a, s))
-> ((a, s) -> m (a, s)) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ \ ~(a
a, s
_) -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT s m a
f a
a) s
s
{-# INLINE mfix #-}
instance MonadTrans (StateT s) where
lift :: m a -> StateT s m a
lift m a
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> do
a
a <- m a
m
(a, s) -> m (a, s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, s
s)
{-# INLINE lift #-}
instance (MonadIO m) => MonadIO (StateT s m) where
liftIO :: IO a -> StateT s m a
liftIO = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (IO a -> m a) -> IO a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# INLINE liftIO #-}
#if MIN_VERSION_base(4,12,0)
instance Contravariant m => Contravariant (StateT s m) where
contramap :: (a -> b) -> StateT s m b -> StateT s m a
contramap a -> b
f StateT s m b
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s ->
((a, s) -> (b, s)) -> m (b, s) -> m (a, s)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (\ (a
a, s
s') -> (a -> b
f a
a, s
s')) (m (b, s) -> m (a, s)) -> m (b, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m b
m s
s
{-# INLINE contramap #-}
#endif
get :: (Monad m) => StateT s m s
get :: StateT s m s
get = (s -> (s, s)) -> StateT s m s
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((s -> (s, s)) -> StateT s m s) -> (s -> (s, s)) -> StateT s m s
forall a b. (a -> b) -> a -> b
$ \ s
s -> (s
s, s
s)
{-# INLINE get #-}
put :: (Monad m) => s -> StateT s m ()
put :: s -> StateT s m ()
put s
s = (s -> ((), s)) -> StateT s m ()
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((s -> ((), s)) -> StateT s m ())
-> (s -> ((), s)) -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ \ s
_ -> ((), s
s)
{-# INLINE put #-}
modify :: (Monad m) => (s -> s) -> StateT s m ()
modify :: (s -> s) -> StateT s m ()
modify s -> s
f = (s -> ((), s)) -> StateT s m ()
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((s -> ((), s)) -> StateT s m ())
-> (s -> ((), s)) -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ \ s
s -> ((), s -> s
f s
s)
{-# INLINE modify #-}
modify' :: (Monad m) => (s -> s) -> StateT s m ()
modify' :: (s -> s) -> StateT s m ()
modify' s -> s
f = do
s
s <- StateT s m s
forall (m :: * -> *) s. Monad m => StateT s m s
get
s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (s -> StateT s m ()) -> s -> StateT s m ()
forall a b. (a -> b) -> a -> b
$! s -> s
f s
s
{-# INLINE modify' #-}
gets :: (Monad m) => (s -> a) -> StateT s m a
gets :: (s -> a) -> StateT s m a
gets s -> a
f = (s -> (a, s)) -> StateT s m a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((s -> (a, s)) -> StateT s m a) -> (s -> (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> (s -> a
f s
s, s
s)
{-# INLINE gets #-}
liftCallCC :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
liftCallCC :: CallCC m (a, s) (b, s) -> CallCC (StateT s m) a b
liftCallCC CallCC m (a, s) (b, s)
callCC (a -> StateT s m b) -> StateT s m a
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s ->
CallCC m (a, s) (b, s)
callCC CallCC m (a, s) (b, s) -> CallCC m (a, s) (b, s)
forall a b. (a -> b) -> a -> b
$ \ (a, s) -> m (b, s)
c ->
StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((a -> StateT s m b) -> StateT s m a
f (\ a
a -> (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \ s
_ -> (a, s) -> m (b, s)
c (a
a, s
s))) s
s
{-# INLINE liftCallCC #-}
liftCallCC' :: CallCC m (a,s) (b,s) -> CallCC (StateT s m) a b
liftCallCC' :: CallCC m (a, s) (b, s) -> CallCC (StateT s m) a b
liftCallCC' CallCC m (a, s) (b, s)
callCC (a -> StateT s m b) -> StateT s m a
f = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s ->
CallCC m (a, s) (b, s)
callCC CallCC m (a, s) (b, s) -> CallCC m (a, s) (b, s)
forall a b. (a -> b) -> a -> b
$ \ (a, s) -> m (b, s)
c ->
StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((a -> StateT s m b) -> StateT s m a
f (\ a
a -> (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \ s
s' -> (a, s) -> m (b, s)
c (a
a, s
s'))) s
s
{-# INLINE liftCallCC' #-}
liftCatch :: Catch e m (a,s) -> Catch e (StateT s m) a
liftCatch :: Catch e m (a, s) -> Catch e (StateT s m) a
liftCatch Catch e m (a, s)
catchE StateT s m a
m e -> StateT s m a
h =
(s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s Catch e m (a, s)
`catchE` \ e
e -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (e -> StateT s m a
h e
e) s
s
{-# INLINE liftCatch #-}
liftListen :: (Monad m) => Listen w m (a,s) -> Listen w (StateT s m) a
liftListen :: Listen w m (a, s) -> Listen w (StateT s m) a
liftListen Listen w m (a, s)
listen StateT s m a
m = (s -> m ((a, w), s)) -> StateT s m (a, w)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m ((a, w), s)) -> StateT s m (a, w))
-> (s -> m ((a, w), s)) -> StateT s m (a, w)
forall a b. (a -> b) -> a -> b
$ \ s
s -> do
((a
a, s
s'), w
w) <- Listen w m (a, s)
listen (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s)
((a, w), s) -> m ((a, w), s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a, w
w), s
s')
{-# INLINE liftListen #-}
liftPass :: (Monad m) => Pass w m (a,s) -> Pass w (StateT s m) a
liftPass :: Pass w m (a, s) -> Pass w (StateT s m) a
liftPass Pass w m (a, s)
pass StateT s m (a, w -> w)
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> Pass w m (a, s)
pass Pass w m (a, s) -> Pass w m (a, s)
forall a b. (a -> b) -> a -> b
$ do
((a
a, w -> w
f), s
s') <- StateT s m (a, w -> w) -> s -> m ((a, w -> w), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m (a, w -> w)
m s
s
((a, s), w -> w) -> m ((a, s), w -> w)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a, s
s'), w -> w
f)
{-# INLINE liftPass #-}