transformers-0.1.1.0: Concrete monad transformers

Portabilityportable
Stabilityexperimental
Maintainerlibraries@haskell.org

Control.Monad.Trans.State.Strict

Contents

Description

Strict state monads.

This module is inspired by the paper /Functional Programming with Overloading and Higher-Order Polymorphism/, Mark P Jones (http://web.cecs.pdx.edu/~mpj/) Advanced School of Functional Programming, 1995.

See below for examples.

Synopsis

The State monad

type State s = StateT s IdentitySource

A parameterizable state monad where s is the type of the state to carry and a is the type of the return value.

state :: (s -> (a, s)) -> State s aSource

runState :: State s a -> s -> (a, s)Source

evalStateSource

Arguments

:: State s a

The state to evaluate

-> s

An initial value

-> a

The return value of the state application

Evaluate this state monad with the given initial state,throwing away the final state. Very much like fst composed with runstate.

execStateSource

Arguments

:: State s a

The state to evaluate

-> s

An initial value

-> s

The new state

Execute this state and return the new state, throwing away the return value. Very much like snd composed with runstate.

mapState :: ((a, s) -> (b, s)) -> State s a -> State s bSource

Map a stateful computation from one (return value, state) pair to another. For instance, to convert numberTree from a function that returns a tree to a function that returns the sum of the numbered tree (see the Examples section for numberTree and sumTree) you may write:

 sumNumberedTree :: (Eq a) => Tree a -> State (Table a) Int
 sumNumberedTree = mapState (\ (t, tab) -> (sumTree t, tab))  . numberTree

withState :: (s -> s) -> State s a -> State s aSource

Apply this function to this state and return the resulting state.

The StateT monad transformer

newtype StateT s m a Source

A parameterizable state monad for encapsulating an inner monad.

The StateT Monad structure is parameterized over two things:

  • s - The state.
  • m - The inner monad.

Here are some examples of use:

(Parser from ParseLib with Hugs)

  type Parser a = StateT String [] a
     ==> StateT (String -> [(a,String)])

For example, item can be written as:

   item = do (x:xs) <- get
          put xs
          return x

   type BoringState s a = StateT s Identity a
        ==> StateT (s -> Identity (a,s))

   type StateWithIO s a = StateT s IO a
        ==> StateT (s -> IO (a,s))

   type StateWithErr s a = StateT s Maybe a
        ==> StateT (s -> Maybe (a,s))

Constructors

StateT 

Fields

runStateT :: s -> m (a, s)
 

Instances

MonadTrans (StateT s) 
Monad m => Monad (StateT s m) 
Functor m => Functor (StateT s m) 
MonadFix m => MonadFix (StateT s m) 
MonadPlus m => MonadPlus (StateT s m) 
(Functor m, Monad m) => Applicative (StateT s m) 
(Functor m, MonadPlus m) => Alternative (StateT s m) 
MonadIO m => MonadIO (StateT s m) 

evalStateT :: Monad m => StateT s m a -> s -> m aSource

Similar to evalState

execStateT :: Monad m => StateT s m a -> s -> m sSource

Similar to execState

mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n bSource

Similar to mapState

withStateT :: (s -> s) -> StateT s m a -> StateT s m aSource

Similar to withState

State operations

get :: Monad m => StateT s m sSource

put :: Monad m => s -> StateT s m ()Source

modify :: Monad m => (s -> s) -> StateT s m ()Source

Monadic state transformer.

Maps an old state to a new state inside a state monad. The old state is thrown away.

gets :: Monad m => (s -> a) -> StateT s m aSource

Gets specific component of the state, using a projection function supplied.

Lifting other operations

liftCallCC :: ((((a, s) -> m (b, s)) -> m (a, s)) -> m (a, s)) -> ((a -> StateT s m b) -> StateT s m a) -> StateT s m aSource

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

liftCallCC' :: ((((a, s) -> m (b, s)) -> m (a, s)) -> m (a, s)) -> ((a -> StateT s m b) -> StateT s m a) -> StateT s m aSource

In-situ lifting of a callCC operation to the new monad. This version uses the current state on entering the continuation.

liftCatch :: (m (a, s) -> (e -> m (a, s)) -> m (a, s)) -> StateT s m a -> (e -> StateT s m a) -> StateT s m aSource

Lift a catchError operation to the new monad.

liftListen :: Monad m => (m (a, s) -> m ((a, s), w)) -> StateT s m a -> StateT s m (a, w)Source

Lift a listen operation to the new monad.

liftPass :: Monad m => (m ((a, s), b) -> m (a, s)) -> StateT s m (a, b) -> StateT s m aSource

Lift a pass operation to the new monad.