module Control.Monad.State.Prim where
import Control.Exception.Safe
import HPrelude hiding (StateT (..), evalStateT, execStateT)
type StateT :: Type -> (Type -> Type) -> Type -> Type
newtype StateT s m a = StateT (IORef s -> m a)
deriving
((forall a b. (a -> b) -> StateT s m a -> StateT s m b)
-> (forall a b. a -> StateT s m b -> StateT s m a)
-> Functor (StateT s m)
forall a b. a -> StateT s m b -> StateT s m a
forall a b. (a -> b) -> StateT s m a -> StateT s m b
forall s (m :: * -> *) a b.
Functor m =>
a -> StateT s m b -> StateT s m a
forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> StateT s m a -> StateT s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> StateT s m a -> StateT s m b
fmap :: forall a b. (a -> b) -> StateT s m a -> StateT s m b
$c<$ :: forall s (m :: * -> *) a b.
Functor m =>
a -> StateT s m b -> StateT s m a
<$ :: forall a b. a -> StateT s m b -> StateT s m a
Functor, Functor (StateT s m)
Functor (StateT s m) =>
(forall a. a -> StateT s m a)
-> (forall a b.
StateT s m (a -> b) -> StateT s m a -> StateT s m b)
-> (forall a b c.
(a -> b -> c) -> StateT s m a -> StateT s m b -> StateT s m c)
-> (forall a b. StateT s m a -> StateT s m b -> StateT s m b)
-> (forall a b. StateT s m a -> StateT s m b -> StateT s m a)
-> Applicative (StateT s m)
forall a. a -> StateT s m a
forall a b. StateT s m a -> StateT s m b -> StateT s m a
forall a b. StateT s m a -> StateT s m b -> StateT s m b
forall a b. StateT s m (a -> b) -> StateT s m a -> StateT s m b
forall a b c.
(a -> b -> c) -> StateT s m a -> StateT s m b -> StateT s m c
forall s (m :: * -> *). Applicative m => Functor (StateT s m)
forall s (m :: * -> *) a. Applicative m => a -> StateT s m a
forall s (m :: * -> *) a b.
Applicative m =>
StateT s m a -> StateT s m b -> StateT s m a
forall s (m :: * -> *) a b.
Applicative m =>
StateT s m a -> StateT s m b -> StateT s m b
forall s (m :: * -> *) a b.
Applicative m =>
StateT s m (a -> b) -> StateT s m a -> StateT s m b
forall s (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> StateT s m a -> StateT s m b -> StateT s m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall s (m :: * -> *) a. Applicative m => a -> StateT s m a
pure :: forall a. a -> StateT s m a
$c<*> :: forall s (m :: * -> *) a b.
Applicative m =>
StateT s m (a -> b) -> StateT s m a -> StateT s m b
<*> :: forall a b. StateT s m (a -> b) -> StateT s m a -> StateT s m b
$cliftA2 :: forall s (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> StateT s m a -> StateT s m b -> StateT s m c
liftA2 :: forall a b c.
(a -> b -> c) -> StateT s m a -> StateT s m b -> StateT s m c
$c*> :: forall s (m :: * -> *) a b.
Applicative m =>
StateT s m a -> StateT s m b -> StateT s m b
*> :: forall a b. StateT s m a -> StateT s m b -> StateT s m b
$c<* :: forall s (m :: * -> *) a b.
Applicative m =>
StateT s m a -> StateT s m b -> StateT s m a
<* :: forall a b. StateT s m a -> StateT s m b -> StateT s m a
Applicative, Applicative (StateT s m)
Applicative (StateT s m) =>
(forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b)
-> (forall a b. StateT s m a -> StateT s m b -> StateT s m b)
-> (forall a. a -> StateT s m a)
-> Monad (StateT s m)
forall a. a -> StateT s m a
forall a b. StateT s m a -> StateT s m b -> StateT s m b
forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b
forall s (m :: * -> *). Monad m => Applicative (StateT s m)
forall s (m :: * -> *) a. Monad m => a -> StateT s m a
forall s (m :: * -> *) a b.
Monad m =>
StateT s m a -> StateT s m b -> StateT s m b
forall s (m :: * -> *) a b.
Monad m =>
StateT s m a -> (a -> StateT s m b) -> StateT s m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall s (m :: * -> *) a b.
Monad m =>
StateT s m a -> (a -> StateT s m b) -> StateT s m b
>>= :: forall a b. StateT s m a -> (a -> StateT s m b) -> StateT s m b
$c>> :: forall s (m :: * -> *) a b.
Monad m =>
StateT s m a -> StateT s m b -> StateT s m b
>> :: forall a b. StateT s m a -> StateT s m b -> StateT s m b
$creturn :: forall s (m :: * -> *) a. Monad m => a -> StateT s m a
return :: forall a. a -> StateT s m a
Monad, Monad (StateT s m)
Monad (StateT s m) =>
(forall e a. (HasCallStack, Exception e) => e -> StateT s m a)
-> MonadThrow (StateT s m)
forall e a. (HasCallStack, Exception e) => e -> StateT s m a
forall s (m :: * -> *). MonadThrow m => Monad (StateT s m)
forall s (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> StateT s m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall s (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> StateT s m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> StateT s m a
MonadThrow, MonadThrow (StateT s m)
MonadThrow (StateT s m) =>
(forall e a.
(HasCallStack, Exception e) =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a)
-> MonadCatch (StateT s m)
forall e a.
(HasCallStack, Exception e) =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
forall s (m :: * -> *). MonadCatch m => MonadThrow (StateT s m)
forall s (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
(HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall s (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
catch :: forall e a.
(HasCallStack, Exception e) =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
MonadCatch, Monad (StateT s m)
Monad (StateT s m) =>
(forall a. IO a -> StateT s m a) -> MonadIO (StateT s m)
forall a. IO a -> StateT s m a
forall s (m :: * -> *). MonadIO m => Monad (StateT s m)
forall s (m :: * -> *) a. MonadIO m => IO a -> StateT s m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall s (m :: * -> *) a. MonadIO m => IO a -> StateT s m a
liftIO :: forall a. IO a -> StateT s m a
MonadIO, MonadIO (StateT s m)
MonadIO (StateT s m) =>
(forall b.
((forall a. StateT s m a -> IO a) -> IO b) -> StateT s m b)
-> MonadUnliftIO (StateT s m)
forall b.
((forall a. StateT s m a -> IO a) -> IO b) -> StateT s m b
forall s (m :: * -> *). MonadUnliftIO m => MonadIO (StateT s m)
forall s (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. StateT s m a -> IO a) -> IO b) -> StateT s m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall s (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. StateT s m a -> IO a) -> IO b) -> StateT s m b
withRunInIO :: forall b.
((forall a. StateT s m a -> IO a) -> IO b) -> StateT s m b
MonadUnliftIO, MonadError e, Monad (StateT s m)
Monad (StateT s m) =>
(forall a. String -> StateT s m a) -> MonadFail (StateT s m)
forall a. String -> StateT s m a
forall s (m :: * -> *). MonadFail m => Monad (StateT s m)
forall s (m :: * -> *) a. MonadFail m => String -> StateT s m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall s (m :: * -> *) a. MonadFail m => String -> StateT s m a
fail :: forall a. String -> StateT s m a
MonadFail)
via ReaderT (IORef s) m
instance MonadTrans (StateT s) where
lift :: forall (m :: * -> *) a. Monad m => m a -> StateT s m a
lift = (IORef s -> m a) -> StateT s m a
forall s (m :: * -> *) a. (IORef s -> m a) -> StateT s m a
StateT ((IORef s -> m a) -> StateT s m a)
-> (m a -> IORef s -> m a) -> m a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IORef s -> m a
forall a b. a -> b -> a
const
instance (MonadIO m) => MonadState s (StateT s m) where
state :: forall a. (s -> (a, s)) -> StateT s m a
state s -> (a, s)
f = (IORef s -> m a) -> StateT s m a
forall s (m :: * -> *) a. (IORef s -> m a) -> StateT s m a
StateT ((IORef s -> m a) -> StateT s m a)
-> (IORef s -> m a) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ (IORef s -> (s -> (s, a)) -> m a)
-> (s -> (s, a)) -> IORef s -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef s -> (s -> (s, a)) -> m a
forall (m :: * -> *) a b.
MonadIO m =>
IORef a -> (a -> (a, b)) -> m b
atomicModifyIORef' s -> (s, a)
f'
where
f' :: s -> (s, a)
f' s
x = let (!a
x', !s
v') = s -> (a, s)
f s
x in (s
v', a
x')
instance (MonadReader r m) => MonadReader r (StateT s m) where
ask :: StateT s m r
ask = m r -> StateT s m r
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (r -> r) -> StateT s m a -> StateT s m a
local r -> r
f (StateT IORef s -> m a
m) = (IORef s -> m a) -> StateT s m a
forall s (m :: * -> *) a. (IORef s -> m a) -> StateT s m a
StateT ((IORef s -> m a) -> StateT s m a)
-> (IORef s -> m a) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m a -> m a) -> (IORef s -> m a) -> IORef s -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef s -> m a
m
runStateT :: (MonadIO m) => StateT s m a -> s -> m (a, s)
runStateT :: forall (m :: * -> *) s a.
MonadIO m =>
StateT s m a -> s -> m (a, s)
runStateT (StateT IORef s -> m a
f) s
s = do
var <- s -> m (IORef s)
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef s
s
val <- f var
(val,) <$> readIORef var
evalStateT :: (MonadIO m) => StateT s m a -> s -> m a
evalStateT :: forall (m :: * -> *) s a. MonadIO m => StateT s m a -> s -> m a
evalStateT StateT s m a
m s
s = (a, s) -> a
forall a b. (a, b) -> a
fst ((a, s) -> a) -> m (a, s) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT s m a -> s -> m (a, s)
forall (m :: * -> *) s a.
MonadIO m =>
StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
execStateT :: (MonadIO m) => StateT s m a -> s -> m s
execStateT :: forall (m :: * -> *) s a. MonadIO m => StateT s m a -> s -> m s
execStateT StateT s m a
m s
s = (a, s) -> s
forall a b. (a, b) -> b
snd ((a, s) -> s) -> m (a, s) -> m s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT s m a -> s -> m (a, s)
forall (m :: * -> *) s a.
MonadIO m =>
StateT s m a -> s -> m (a, s)
runStateT StateT s m a
m s
s
stateM :: (MonadIO m) => (s -> m (a, s)) -> StateT s m a
stateM :: forall (m :: * -> *) s a.
MonadIO m =>
(s -> m (a, s)) -> StateT s m a
stateM s -> m (a, s)
f = do
s <- StateT s m s
forall s (m :: * -> *). MonadState s m => m s
get
(a, s') <- lift $ f s
put s'
pure a