adjunctions-4.4: Adjunctions and representable functors

Copyright(c) Edward Kmett & Sjoerd Visscher 2011
LicenseBSD3
Maintainerekmett@gmail.com
Stabilityexperimental
Safe HaskellSafe
LanguageHaskell98

Control.Monad.Representable.State

Description

A generalized State monad, parameterized by a Representable functor. The representation of that functor serves as the state.

Synopsis

Documentation

type State g = StateT g Identity Source #

A memoized state monad parameterized by a representable functor g, where the representatation of g, Rep g is the state to carry.

The return function leaves the state unchanged, while >>= uses the final state of the first computation as the initial state of the second.

runState Source #

Arguments

:: Representable g 
=> State g a

state-passing computation to execute

-> Rep g

initial state

-> (a, Rep g)

return value and final state

Unwrap a state monad computation as a function. (The inverse of state.)

evalState Source #

Arguments

:: Representable g 
=> State g a

state-passing computation to execute

-> Rep g

initial value

-> a

return value of the state computation

Evaluate a state computation with the given initial state and return the final value, discarding the final state.

execState Source #

Arguments

:: Representable g 
=> State g a

state-passing computation to execute

-> Rep g

initial value

-> Rep g

final state

Evaluate a state computation with the given initial state and return the final state, discarding the final value.

mapState :: Functor g => ((a, Rep g) -> (b, Rep g)) -> State g a -> State g b Source #

Map both the return value and final state of a computation using the given function.

newtype StateT g m a Source #

A state transformer monad parameterized by:

  • g - A representable functor used to memoize results for a state Rep g
  • m - The inner monad.

The return function leaves the state unchanged, while >>= uses the final state of the first computation as the initial state of the second.

Constructors

StateT 

Fields

Instances

(Functor f, Representable g, MonadFree f m) => MonadFree f (StateT g m) Source # 

Methods

wrap :: f (StateT g m a) -> StateT g m a #

(Representable g, MonadWriter w m) => MonadWriter w (StateT g m) Source # 

Methods

writer :: (a, w) -> StateT g m a #

tell :: w -> StateT g m () #

listen :: StateT g m a -> StateT g m (a, w) #

pass :: StateT g m (a, w -> w) -> StateT g m a #

(Representable g, Monad m, (~) * (Rep g) s) => MonadState s (StateT g m) Source # 

Methods

get :: StateT g m s #

put :: s -> StateT g m () #

state :: (s -> (a, s)) -> StateT g m a #

(Representable g, MonadReader e m) => MonadReader e (StateT g m) Source # 

Methods

ask :: StateT g m e #

local :: (e -> e) -> StateT g m a -> StateT g m a #

reader :: (e -> a) -> StateT g m a #

Representable f => MonadTrans (StateT f) Source # 

Methods

lift :: Monad m => m a -> StateT f m a #

Representable f => BindTrans (StateT f) Source # 

Methods

liftB :: Bind b => b a -> StateT f b a #

(Representable g, Monad m) => Monad (StateT g m) Source # 

Methods

(>>=) :: StateT g m a -> (a -> StateT g m b) -> StateT g m b #

(>>) :: StateT g m a -> StateT g m b -> StateT g m b #

return :: a -> StateT g m a #

fail :: String -> StateT g m a #

(Functor g, Functor m) => Functor (StateT g m) Source # 

Methods

fmap :: (a -> b) -> StateT g m a -> StateT g m b #

(<$) :: a -> StateT g m b -> StateT g m a #

(Representable g, Functor m, Monad m) => Applicative (StateT g m) Source # 

Methods

pure :: a -> StateT g m a #

(<*>) :: StateT g m (a -> b) -> StateT g m a -> StateT g m b #

liftA2 :: (a -> b -> c) -> StateT g m a -> StateT g m b -> StateT g m c #

(*>) :: StateT g m a -> StateT g m b -> StateT g m b #

(<*) :: StateT g m a -> StateT g m b -> StateT g m a #

(Representable g, MonadCont m) => MonadCont (StateT g m) Source # 

Methods

callCC :: ((a -> StateT g m b) -> StateT g m a) -> StateT g m a #

(Representable g, Bind m) => Apply (StateT g m) Source # 

Methods

(<.>) :: StateT g m (a -> b) -> StateT g m a -> StateT g m b #

(.>) :: StateT g m a -> StateT g m b -> StateT g m b #

(<.) :: StateT g m a -> StateT g m b -> StateT g m a #

liftF2 :: (a -> b -> c) -> StateT g m a -> StateT g m b -> StateT g m c #

(Representable g, Bind m) => Bind (StateT g m) Source # 

Methods

(>>-) :: StateT g m a -> (a -> StateT g m b) -> StateT g m b #

join :: StateT g m (StateT g m a) -> StateT g m a #

stateT :: Representable g => (Rep g -> m (a, Rep g)) -> StateT g m a Source #

runStateT :: Representable g => StateT g m a -> Rep g -> m (a, Rep g) Source #

evalStateT :: (Representable g, Monad m) => StateT g m a -> Rep g -> m a Source #

Evaluate a state computation with the given initial state and return the final value, discarding the final state.

execStateT :: (Representable g, Monad m) => StateT g m a -> Rep g -> m (Rep g) Source #

Evaluate a state computation with the given initial state and return the final state, discarding the final value.

mapStateT :: Functor g => (m (a, Rep g) -> n (b, Rep g)) -> StateT g m a -> StateT g n b Source #

liftCallCC :: Representable g => ((((a, Rep g) -> m (b, Rep g)) -> m (a, Rep g)) -> m (a, Rep g)) -> ((a -> StateT g m b) -> StateT g m a) -> StateT g m a Source #

Uniform lifting of a callCC operation to the new monad. This version rolls back to the original state on entering the continuation.

liftCallCC' :: Representable g => ((((a, Rep g) -> m (b, Rep g)) -> m (a, Rep g)) -> m (a, Rep g)) -> ((a -> StateT g m b) -> StateT g m a) -> StateT g m a Source #

In-situ lifting of a callCC operation to the new monad. This version uses the current state on entering the continuation. It does not satisfy the laws of a monad transformer.

class Monad m => MonadState s (m :: * -> *) | m -> s where #

Minimal definition is either both of get and put or just state

Minimal complete definition

state | get, put

Methods

get :: m s #

Return the state from the internals of the monad.

put :: s -> m () #

Replace the state inside the monad.

state :: (s -> (a, s)) -> m a #

Embed a simple state action into the monad.

Instances

MonadState s m => MonadState s (MaybeT m) 

Methods

get :: MaybeT m s #

put :: s -> MaybeT m () #

state :: (s -> (a, s)) -> MaybeT m a #

MonadState s m => MonadState s (ListT m) 

Methods

get :: ListT m s #

put :: s -> ListT m () #

state :: (s -> (a, s)) -> ListT m a #

(Functor m, MonadState s m) => MonadState s (Free m) 

Methods

get :: Free m s #

put :: s -> Free m () #

state :: (s -> (a, s)) -> Free m a #

(Representable g, Monad m, (~) * (Rep g) s) => MonadState s (StateT g m) # 

Methods

get :: StateT g m s #

put :: s -> StateT g m () #

state :: (s -> (a, s)) -> StateT g m a #

(Monoid w, MonadState s m) => MonadState s (WriterT w m) 

Methods

get :: WriterT w m s #

put :: s -> WriterT w m () #

state :: (s -> (a, s)) -> WriterT w m a #

(Monoid w, MonadState s m) => MonadState s (WriterT w m) 

Methods

get :: WriterT w m s #

put :: s -> WriterT w m () #

state :: (s -> (a, s)) -> WriterT w m a #

Monad m => MonadState s (StateT s m) 

Methods

get :: StateT s m s #

put :: s -> StateT s m () #

state :: (s -> (a, s)) -> StateT s m a #

Monad m => MonadState s (StateT s m) 

Methods

get :: StateT s m s #

put :: s -> StateT s m () #

state :: (s -> (a, s)) -> StateT s m a #

MonadState s m => MonadState s (IdentityT * m) 

Methods

get :: IdentityT * m s #

put :: s -> IdentityT * m () #

state :: (s -> (a, s)) -> IdentityT * m a #

MonadState s m => MonadState s (ExceptT e m) 

Methods

get :: ExceptT e m s #

put :: s -> ExceptT e m () #

state :: (s -> (a, s)) -> ExceptT e m a #

(Error e, MonadState s m) => MonadState s (ErrorT e m) 

Methods

get :: ErrorT e m s #

put :: s -> ErrorT e m () #

state :: (s -> (a, s)) -> ErrorT e m a #

MonadState s m => MonadState s (ReaderT * r m) 

Methods

get :: ReaderT * r m s #

put :: s -> ReaderT * r m () #

state :: (s -> (a, s)) -> ReaderT * r m a #

MonadState s m => MonadState s (ContT * r m) 

Methods

get :: ContT * r m s #

put :: s -> ContT * r m () #

state :: (s -> (a, s)) -> ContT * r m a #

(Monad m, Monoid w) => MonadState s (RWST r w s m) 

Methods

get :: RWST r w s m s #

put :: s -> RWST r w s m () #

state :: (s -> (a, s)) -> RWST r w s m a #

(Monad m, Monoid w) => MonadState s (RWST r w s m) 

Methods

get :: RWST r w s m s #

put :: s -> RWST r w s m () #

state :: (s -> (a, s)) -> RWST r w s m a #