<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>Control/Monad/Trans/State/Strict.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-2"></a><span class='hs-comment'>-- |</span>
<a name="line-3"></a><span class='hs-comment'>-- Module : Control.Monad.Trans.State.Strict</span>
<a name="line-4"></a><span class='hs-comment'>-- Copyright : (c) Andy Gill 2001,</span>
<a name="line-5"></a><span class='hs-comment'>-- (c) Oregon Graduate Institute of Science and Technology, 2001</span>
<a name="line-6"></a><span class='hs-comment'>-- License : BSD-style (see the file LICENSE)</span>
<a name="line-7"></a><span class='hs-comment'>--</span>
<a name="line-8"></a><span class='hs-comment'>-- Maintainer : ross@soi.city.ac.uk</span>
<a name="line-9"></a><span class='hs-comment'>-- Stability : experimental</span>
<a name="line-10"></a><span class='hs-comment'>-- Portability : portable</span>
<a name="line-11"></a><span class='hs-comment'>--</span>
<a name="line-12"></a><span class='hs-comment'>-- Strict state monads, passing an updateable state through a computation.</span>
<a name="line-13"></a><span class='hs-comment'>-- See below for examples.</span>
<a name="line-14"></a><span class='hs-comment'>--</span>
<a name="line-15"></a><span class='hs-comment'>-- In this version, sequencing of computations is strict in the state.</span>
<a name="line-16"></a><span class='hs-comment'>-- For a lazy version, see "Control.Monad.Trans.Writer.Lazy", which</span>
<a name="line-17"></a><span class='hs-comment'>-- has the same interface.</span>
<a name="line-18"></a><span class='hs-comment'>--</span>
<a name="line-19"></a><span class='hs-comment'>-- Some computations may not require the full power of state transformers:</span>
<a name="line-20"></a><span class='hs-comment'>--</span>
<a name="line-21"></a><span class='hs-comment'>-- * For a read-only state, see "Control.Monad.Trans.Reader".</span>
<a name="line-22"></a><span class='hs-comment'>--</span>
<a name="line-23"></a><span class='hs-comment'>-- * To accumulate a value without using it on the way, see</span>
<a name="line-24"></a><span class='hs-comment'>-- "Control.Monad.Trans.Writer".</span>
<a name="line-25"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-26"></a>
<a name="line-27"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Trans</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span><span class='hs-varop'>.</span><span class='hs-conid'>Strict</span> <span class='hs-layout'>(</span>
<a name="line-28"></a> <span class='hs-comment'>-- * The State monad</span>
<a name="line-29"></a> <span class='hs-conid'>State</span><span class='hs-layout'>,</span>
<a name="line-30"></a> <span class='hs-varid'>state</span><span class='hs-layout'>,</span>
<a name="line-31"></a> <span class='hs-varid'>runState</span><span class='hs-layout'>,</span>
<a name="line-32"></a> <span class='hs-varid'>evalState</span><span class='hs-layout'>,</span>
<a name="line-33"></a> <span class='hs-varid'>execState</span><span class='hs-layout'>,</span>
<a name="line-34"></a> <span class='hs-varid'>mapState</span><span class='hs-layout'>,</span>
<a name="line-35"></a> <span class='hs-varid'>withState</span><span class='hs-layout'>,</span>
<a name="line-36"></a> <span class='hs-comment'>-- * The StateT monad transformer</span>
<a name="line-37"></a> <span class='hs-conid'>StateT</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-38"></a> <span class='hs-varid'>evalStateT</span><span class='hs-layout'>,</span>
<a name="line-39"></a> <span class='hs-varid'>execStateT</span><span class='hs-layout'>,</span>
<a name="line-40"></a> <span class='hs-varid'>mapStateT</span><span class='hs-layout'>,</span>
<a name="line-41"></a> <span class='hs-varid'>withStateT</span><span class='hs-layout'>,</span>
<a name="line-42"></a> <span class='hs-comment'>-- * State operations</span>
<a name="line-43"></a> <span class='hs-varid'>get</span><span class='hs-layout'>,</span>
<a name="line-44"></a> <span class='hs-varid'>put</span><span class='hs-layout'>,</span>
<a name="line-45"></a> <span class='hs-varid'>modify</span><span class='hs-layout'>,</span>
<a name="line-46"></a> <span class='hs-varid'>gets</span><span class='hs-layout'>,</span>
<a name="line-47"></a> <span class='hs-comment'>-- * Lifting other operations</span>
<a name="line-48"></a> <span class='hs-varid'>liftCallCC</span><span class='hs-layout'>,</span>
<a name="line-49"></a> <span class='hs-varid'>liftCallCC'</span><span class='hs-layout'>,</span>
<a name="line-50"></a> <span class='hs-varid'>liftCatch</span><span class='hs-layout'>,</span>
<a name="line-51"></a> <span class='hs-varid'>liftListen</span><span class='hs-layout'>,</span>
<a name="line-52"></a> <span class='hs-varid'>liftPass</span><span class='hs-layout'>,</span>
<a name="line-53"></a> <span class='hs-comment'>-- * Examples</span>
<a name="line-54"></a> <span class='hs-comment'>-- ** State monads</span>
<a name="line-55"></a> <span class='hs-comment'>-- $examples</span>
<a name="line-56"></a>
<a name="line-57"></a> <span class='hs-comment'>-- ** Counting</span>
<a name="line-58"></a> <span class='hs-comment'>-- $counting</span>
<a name="line-59"></a>
<a name="line-60"></a> <span class='hs-comment'>-- ** Labelling trees</span>
<a name="line-61"></a> <span class='hs-comment'>-- $labelling</span>
<a name="line-62"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-63"></a>
<a name="line-64"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>IO</span><span class='hs-varop'>.</span><span class='hs-conid'>Class</span>
<a name="line-65"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Trans</span><span class='hs-varop'>.</span><span class='hs-conid'>Class</span>
<a name="line-66"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Functor</span><span class='hs-varop'>.</span><span class='hs-conid'>Identity</span>
<a name="line-67"></a>
<a name="line-68"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span>
<a name="line-69"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-70"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Fix</span>
<a name="line-71"></a>
<a name="line-72"></a><a name="State"></a><span class='hs-comment'>-- ---------------------------------------------------------------------------</span>
<a name="line-73"></a><a name="State"></a><span class='hs-comment'>-- | A state monad parameterized by the type @s@ of the state to carry.</span>
<a name="line-74"></a><a name="State"></a><span class='hs-comment'>--</span>
<a name="line-75"></a><a name="State"></a><span class='hs-comment'>-- The 'return' function leaves the state unchanged, while @>>=@ uses</span>
<a name="line-76"></a><a name="State"></a><span class='hs-comment'>-- the final state of the first computation as the initial state of</span>
<a name="line-77"></a><a name="State"></a><span class='hs-comment'>-- the second.</span>
<a name="line-78"></a><a name="State"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-conid'>Identity</span>
<a name="line-79"></a>
<a name="line-80"></a><a name="state"></a><span class='hs-comment'>-- | Construct a state monad computation from a function.</span>
<a name="line-81"></a><span class='hs-comment'>-- (The inverse of 'runState'.)</span>
<a name="line-82"></a><span class='hs-definition'>state</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^pure state transformer</span>
<a name="line-83"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^equivalent state-passing computation</span>
<a name="line-84"></a><span class='hs-definition'>state</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-layout'>(</span><span class='hs-conid'>Identity</span> <span class='hs-varop'>.</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span>
<a name="line-85"></a>
<a name="line-86"></a><a name="runState"></a><span class='hs-comment'>-- | Unwrap a state monad computation as a function.</span>
<a name="line-87"></a><span class='hs-comment'>-- (The inverse of 'state'.)</span>
<a name="line-88"></a><span class='hs-definition'>runState</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^state-passing computation to execute</span>
<a name="line-89"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-comment'>-- ^initial state</span>
<a name="line-90"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^return value and final state</span>
<a name="line-91"></a><span class='hs-definition'>runState</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runIdentity</span> <span class='hs-varop'>.</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span>
<a name="line-92"></a>
<a name="line-93"></a><a name="evalState"></a><span class='hs-comment'>-- | Evaluate a state computation with the given initial state</span>
<a name="line-94"></a><span class='hs-comment'>-- and return the final value, discarding the final state.</span>
<a name="line-95"></a><span class='hs-comment'>--</span>
<a name="line-96"></a><span class='hs-comment'>-- * @'evalState' m s = 'fst' ('runState' m s)@</span>
<a name="line-97"></a><span class='hs-definition'>evalState</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^state-passing computation to execute</span>
<a name="line-98"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-comment'>-- ^initial value</span>
<a name="line-99"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^return value of the state computation</span>
<a name="line-100"></a><span class='hs-definition'>evalState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-varid'>runState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-101"></a>
<a name="line-102"></a><a name="execState"></a><span class='hs-comment'>-- | Evaluate a state computation with the given initial state</span>
<a name="line-103"></a><span class='hs-comment'>-- and return the final state, discarding the final value.</span>
<a name="line-104"></a><span class='hs-comment'>--</span>
<a name="line-105"></a><span class='hs-comment'>-- * @'execState' m s = 'snd' ('runState' m s)@</span>
<a name="line-106"></a><span class='hs-definition'>execState</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^state-passing computation to execute</span>
<a name="line-107"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-comment'>-- ^initial value</span>
<a name="line-108"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-comment'>-- ^final state</span>
<a name="line-109"></a><span class='hs-definition'>execState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>snd</span> <span class='hs-layout'>(</span><span class='hs-varid'>runState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-110"></a>
<a name="line-111"></a><a name="mapState"></a><span class='hs-comment'>-- | Map both the return value and final state of a computation using</span>
<a name="line-112"></a><span class='hs-comment'>-- the given function.</span>
<a name="line-113"></a><span class='hs-comment'>--</span>
<a name="line-114"></a><span class='hs-comment'>-- * @'runState' ('mapState' f m) = f . 'runState' m@</span>
<a name="line-115"></a><span class='hs-definition'>mapState</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>b</span>
<a name="line-116"></a><span class='hs-definition'>mapState</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mapStateT</span> <span class='hs-layout'>(</span><span class='hs-conid'>Identity</span> <span class='hs-varop'>.</span> <span class='hs-varid'>f</span> <span class='hs-varop'>.</span> <span class='hs-varid'>runIdentity</span><span class='hs-layout'>)</span>
<a name="line-117"></a>
<a name="line-118"></a><a name="withState"></a><span class='hs-comment'>-- | @'withState' f m@ executes action @m@ on a state modified by</span>
<a name="line-119"></a><span class='hs-comment'>-- applying @f@.</span>
<a name="line-120"></a><span class='hs-comment'>--</span>
<a name="line-121"></a><span class='hs-comment'>-- * @'withState' f m = 'modify' f >> m@</span>
<a name="line-122"></a><span class='hs-definition'>withState</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>State</span> <span class='hs-varid'>s</span> <span class='hs-varid'>a</span>
<a name="line-123"></a><span class='hs-definition'>withState</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>withStateT</span>
<a name="line-124"></a>
<a name="line-125"></a><a name="StateT"></a><span class='hs-comment'>-- ---------------------------------------------------------------------------</span>
<a name="line-126"></a><a name="StateT"></a><span class='hs-comment'>-- | A state transformer monad parameterized by:</span>
<a name="line-127"></a><a name="StateT"></a><span class='hs-comment'>--</span>
<a name="line-128"></a><a name="StateT"></a><span class='hs-comment'>-- * @s@ - The state.</span>
<a name="line-129"></a><a name="StateT"></a><span class='hs-comment'>--</span>
<a name="line-130"></a><a name="StateT"></a><span class='hs-comment'>-- * @m@ - The inner monad.</span>
<a name="line-131"></a><a name="StateT"></a><span class='hs-comment'>--</span>
<a name="line-132"></a><a name="StateT"></a><span class='hs-comment'>-- The 'return' function leaves the state unchanged, while @>>=@ uses</span>
<a name="line-133"></a><a name="StateT"></a><span class='hs-comment'>-- the final state of the first computation as the initial state of</span>
<a name="line-134"></a><a name="StateT"></a><span class='hs-comment'>-- the second.</span>
<a name="line-135"></a><a name="StateT"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-layout'>{</span> <span class='hs-varid'>runStateT</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-136"></a>
<a name="line-137"></a><a name="evalStateT"></a><span class='hs-comment'>-- | Evaluate a state computation with the given initial state</span>
<a name="line-138"></a><span class='hs-comment'>-- and return the final value, discarding the final state.</span>
<a name="line-139"></a><span class='hs-comment'>--</span>
<a name="line-140"></a><span class='hs-comment'>-- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@</span>
<a name="line-141"></a><span class='hs-definition'>evalStateT</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-142"></a><span class='hs-definition'>evalStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-143"></a> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span>
<a name="line-144"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>a</span>
<a name="line-145"></a>
<a name="line-146"></a><a name="execStateT"></a><span class='hs-comment'>-- | Evaluate a state computation with the given initial state</span>
<a name="line-147"></a><span class='hs-comment'>-- and return the final state, discarding the final value.</span>
<a name="line-148"></a><span class='hs-comment'>--</span>
<a name="line-149"></a><span class='hs-comment'>-- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@</span>
<a name="line-150"></a><span class='hs-definition'>execStateT</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span>
<a name="line-151"></a><span class='hs-definition'>execStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-152"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span>
<a name="line-153"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>s'</span>
<a name="line-154"></a>
<a name="line-155"></a><a name="mapStateT"></a><span class='hs-comment'>-- | Map both the return value and final state of a computation using</span>
<a name="line-156"></a><span class='hs-comment'>-- the given function.</span>
<a name="line-157"></a><span class='hs-comment'>--</span>
<a name="line-158"></a><span class='hs-comment'>-- * @'runStateT' ('mapStateT' f m) = f . 'runStateT' m@</span>
<a name="line-159"></a><span class='hs-definition'>mapStateT</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>n</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>n</span> <span class='hs-varid'>b</span>
<a name="line-160"></a><span class='hs-definition'>mapStateT</span> <span class='hs-varid'>f</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-varid'>f</span> <span class='hs-varop'>.</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span>
<a name="line-161"></a>
<a name="line-162"></a><a name="withStateT"></a><span class='hs-comment'>-- | @'withStateT' f m@ executes action @m@ on a state modified by</span>
<a name="line-163"></a><span class='hs-comment'>-- applying @f@.</span>
<a name="line-164"></a><span class='hs-comment'>--</span>
<a name="line-165"></a><span class='hs-comment'>-- * @'withStateT' f m = 'modify' f >> m@</span>
<a name="line-166"></a><span class='hs-definition'>withStateT</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-167"></a><span class='hs-definition'>withStateT</span> <span class='hs-varid'>f</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varop'>.</span> <span class='hs-varid'>f</span>
<a name="line-168"></a>
<a name="line-169"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Functor</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Functor</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-170"></a> <span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span>
<a name="line-171"></a> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span>
<a name="line-172"></a>
<a name="line-173"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Functor</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Applicative</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-174"></a> <span class='hs-varid'>pure</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span>
<a name="line-175"></a> <span class='hs-layout'>(</span><span class='hs-varop'><*></span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>ap</span>
<a name="line-176"></a>
<a name="line-177"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Functor</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>MonadPlus</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Alternative</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-178"></a> <span class='hs-varid'>empty</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mzero</span>
<a name="line-179"></a> <span class='hs-layout'>(</span><span class='hs-varop'><|></span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mplus</span>
<a name="line-180"></a>
<a name="line-181"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Monad</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-182"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-183"></a> <span class='hs-varid'>m</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-184"></a> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span>
<a name="line-185"></a> <span class='hs-varid'>runStateT</span> <span class='hs-layout'>(</span><span class='hs-varid'>k</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-varid'>s'</span>
<a name="line-186"></a> <span class='hs-varid'>fail</span> <span class='hs-varid'>str</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>fail</span> <span class='hs-varid'>str</span>
<a name="line-187"></a>
<a name="line-188"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadPlus</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>MonadPlus</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-189"></a> <span class='hs-varid'>mzero</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mzero</span>
<a name="line-190"></a> <span class='hs-varid'>m</span> <span class='hs-varop'>`mplus`</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span> <span class='hs-varop'>`mplus`</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>n</span> <span class='hs-varid'>s</span>
<a name="line-191"></a>
<a name="line-192"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadFix</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>MonadFix</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-193"></a> <span class='hs-varid'>mfix</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>mfix</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-keyglyph'>~</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>runStateT</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>
<a name="line-194"></a>
<a name="line-195"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>MonadTrans</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-196"></a> <span class='hs-varid'>lift</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-197"></a> <span class='hs-varid'>a</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>m</span>
<a name="line-198"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-199"></a>
<a name="line-200"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadIO</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>MonadIO</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-201"></a> <span class='hs-varid'>liftIO</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>.</span> <span class='hs-varid'>liftIO</span>
<a name="line-202"></a>
<a name="line-203"></a><a name="get"></a><span class='hs-comment'>-- | Fetch the current value of the state within the monad.</span>
<a name="line-204"></a><span class='hs-definition'>get</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span>
<a name="line-205"></a><span class='hs-definition'>get</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-206"></a>
<a name="line-207"></a><a name="put"></a><span class='hs-comment'>-- | @'put' s@ sets the state within the monad to @s@.</span>
<a name="line-208"></a><span class='hs-definition'>put</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-conid'>()</span>
<a name="line-209"></a><span class='hs-definition'>put</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>()</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-210"></a>
<a name="line-211"></a><a name="modify"></a><span class='hs-comment'>-- | @'modify' f@ is an action that updates the state to the result of</span>
<a name="line-212"></a><span class='hs-comment'>-- applying @f@ to the current state.</span>
<a name="line-213"></a><span class='hs-definition'>modify</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-conid'>()</span>
<a name="line-214"></a><span class='hs-definition'>modify</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-215"></a> <span class='hs-varid'>s</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-216"></a> <span class='hs-varid'>put</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-217"></a>
<a name="line-218"></a><a name="gets"></a><span class='hs-comment'>-- | Get a specific component of the state, using a projection function</span>
<a name="line-219"></a><span class='hs-comment'>-- supplied.</span>
<a name="line-220"></a><span class='hs-comment'>--</span>
<a name="line-221"></a><span class='hs-comment'>-- * @'gets' f = 'liftM' f 'get'@</span>
<a name="line-222"></a><span class='hs-definition'>gets</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-223"></a><span class='hs-definition'>gets</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-224"></a> <span class='hs-varid'>s</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-225"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-226"></a>
<a name="line-227"></a><a name="liftCallCC"></a><span class='hs-comment'>-- | Uniform lifting of a @callCC@ operation to the new monad.</span>
<a name="line-228"></a><span class='hs-comment'>-- This version rolls back to the original state on entering the</span>
<a name="line-229"></a><span class='hs-comment'>-- continuation.</span>
<a name="line-230"></a><span class='hs-definition'>liftCallCC</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-231"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-232"></a><span class='hs-definition'>liftCallCC</span> <span class='hs-varid'>callCC</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span>
<a name="line-233"></a> <span class='hs-varid'>callCC</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>-></span>
<a name="line-234"></a> <span class='hs-varid'>runStateT</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>c</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>
<a name="line-235"></a>
<a name="line-236"></a><a name="liftCallCC'"></a><span class='hs-comment'>-- | In-situ lifting of a @callCC@ operation to the new monad.</span>
<a name="line-237"></a><span class='hs-comment'>-- This version uses the current state on entering the continuation.</span>
<a name="line-238"></a><span class='hs-comment'>-- It does not satisfy the laws of a monad transformer.</span>
<a name="line-239"></a><span class='hs-definition'>liftCallCC'</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-240"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-241"></a><span class='hs-definition'>liftCallCC'</span> <span class='hs-varid'>callCC</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span>
<a name="line-242"></a> <span class='hs-varid'>callCC</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>-></span>
<a name="line-243"></a> <span class='hs-varid'>runStateT</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s'</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>c</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>
<a name="line-244"></a>
<a name="line-245"></a><a name="liftCatch"></a><span class='hs-comment'>-- | Lift a @catchError@ operation to the new monad.</span>
<a name="line-246"></a><span class='hs-definition'>liftCatch</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-247"></a> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-248"></a><span class='hs-definition'>liftCatch</span> <span class='hs-varid'>catchError</span> <span class='hs-varid'>m</span> <span class='hs-varid'>h</span> <span class='hs-keyglyph'>=</span>
<a name="line-249"></a> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span> <span class='hs-varop'>`catchError`</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>runStateT</span> <span class='hs-layout'>(</span><span class='hs-varid'>h</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-varid'>s</span>
<a name="line-250"></a>
<a name="line-251"></a><a name="liftListen"></a><span class='hs-comment'>-- | Lift a @listen@ operation to the new monad.</span>
<a name="line-252"></a><span class='hs-definition'>liftListen</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span>
<a name="line-253"></a> <span class='hs-layout'>(</span><span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>w</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>w</span><span class='hs-layout'>)</span>
<a name="line-254"></a><span class='hs-definition'>liftListen</span> <span class='hs-varid'>listen</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>do</span>
<a name="line-255"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>w</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>listen</span> <span class='hs-layout'>(</span><span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span><span class='hs-layout'>)</span>
<a name="line-256"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>w</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span>
<a name="line-257"></a>
<a name="line-258"></a><a name="liftPass"></a><span class='hs-comment'>-- | Lift a @pass@ operation to the new monad.</span>
<a name="line-259"></a><span class='hs-definition'>liftPass</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span>
<a name="line-260"></a> <span class='hs-layout'>(</span><span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span><span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>s</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>StateT</span> <span class='hs-varid'>s</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-261"></a><span class='hs-definition'>liftPass</span> <span class='hs-varid'>pass</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>StateT</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>s</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>pass</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-262"></a> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runStateT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>s</span>
<a name="line-263"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span><span class='hs-layout'>,</span> <span class='hs-varid'>s'</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span>
<a name="line-264"></a>
<a name="line-265"></a><span class='hs-comment'>{- $examples
<a name="line-266"></a>
<a name="line-267"></a>Parser from ParseLib with Hugs:
<a name="line-268"></a>
<a name="line-269"></a>> type Parser a = StateT String [] a
<a name="line-270"></a>> ==> StateT (String -> [(a,String)])
<a name="line-271"></a>
<a name="line-272"></a>For example, item can be written as:
<a name="line-273"></a>
<a name="line-274"></a>> item = do (x:xs) <- get
<a name="line-275"></a>> put xs
<a name="line-276"></a>> return x
<a name="line-277"></a>>
<a name="line-278"></a>> type BoringState s a = StateT s Identity a
<a name="line-279"></a>> ==> StateT (s -> Identity (a,s))
<a name="line-280"></a>>
<a name="line-281"></a>> type StateWithIO s a = StateT s IO a
<a name="line-282"></a>> ==> StateT (s -> IO (a,s))
<a name="line-283"></a>>
<a name="line-284"></a>> type StateWithErr s a = StateT s Maybe a
<a name="line-285"></a>> ==> StateT (s -> Maybe (a,s))
<a name="line-286"></a>
<a name="line-287"></a>-}</span>
<a name="line-288"></a>
<a name="line-289"></a><span class='hs-comment'>{- $counting
<a name="line-290"></a>
<a name="line-291"></a>A function to increment a counter. Taken from the paper
<a name="line-292"></a>/Generalising Monads to Arrows/, John
<a name="line-293"></a>Hughes (<<a href="http://www.math.chalmers.se/~rjmh/">http://www.math.chalmers.se/~rjmh/</a>>), November 1998:
<a name="line-294"></a>
<a name="line-295"></a>> tick :: State Int Int
<a name="line-296"></a>> tick = do n <- get
<a name="line-297"></a>> put (n+1)
<a name="line-298"></a>> return n
<a name="line-299"></a>
<a name="line-300"></a>Add one to the given number using the state monad:
<a name="line-301"></a>
<a name="line-302"></a>> plusOne :: Int -> Int
<a name="line-303"></a>> plusOne n = execState tick n
<a name="line-304"></a>
<a name="line-305"></a>A contrived addition example. Works only with positive numbers:
<a name="line-306"></a>
<a name="line-307"></a>> plus :: Int -> Int -> Int
<a name="line-308"></a>> plus n x = execState (sequence $ replicate n tick) x
<a name="line-309"></a>
<a name="line-310"></a>-}</span>
<a name="line-311"></a>
<a name="line-312"></a><span class='hs-comment'>{- $labelling
<a name="line-313"></a>
<a name="line-314"></a>An example from /The Craft of Functional Programming/, Simon
<a name="line-315"></a>Thompson (<<a href="http://www.cs.kent.ac.uk/people/staff/sjt/">http://www.cs.kent.ac.uk/people/staff/sjt/</a>>),
<a name="line-316"></a>Addison-Wesley 1999: \"Given an arbitrary tree, transform it to a
<a name="line-317"></a>tree of integers in which the original elements are replaced by
<a name="line-318"></a>natural numbers, starting from 0. The same element has to be
<a name="line-319"></a>replaced by the same number at every occurrence, and when we meet
<a name="line-320"></a>an as-yet-unvisited element we have to find a \'new\' number to match
<a name="line-321"></a>it with:\"
<a name="line-322"></a>
<a name="line-323"></a>> data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show, Eq)
<a name="line-324"></a>> type Table a = [a]
<a name="line-325"></a>
<a name="line-326"></a>> numberTree :: Eq a => Tree a -> State (Table a) (Tree Int)
<a name="line-327"></a>> numberTree Nil = return Nil
<a name="line-328"></a>> numberTree (Node x t1 t2)
<a name="line-329"></a>> = do num <- numberNode x
<a name="line-330"></a>> nt1 <- numberTree t1
<a name="line-331"></a>> nt2 <- numberTree t2
<a name="line-332"></a>> return (Node num nt1 nt2)
<a name="line-333"></a>> where
<a name="line-334"></a>> numberNode :: Eq a => a -> State (Table a) Int
<a name="line-335"></a>> numberNode x
<a name="line-336"></a>> = do table <- get
<a name="line-337"></a>> (newTable, newPos) <- return (nNode x table)
<a name="line-338"></a>> put newTable
<a name="line-339"></a>> return newPos
<a name="line-340"></a>> nNode:: (Eq a) => a -> Table a -> (Table a, Int)
<a name="line-341"></a>> nNode x table
<a name="line-342"></a>> = case (findIndexInList (== x) table) of
<a name="line-343"></a>> Nothing -> (table ++ [x], length table)
<a name="line-344"></a>> Just i -> (table, i)
<a name="line-345"></a>> findIndexInList :: (a -> Bool) -> [a] -> Maybe Int
<a name="line-346"></a>> findIndexInList = findIndexInListHelp 0
<a name="line-347"></a>> findIndexInListHelp _ _ [] = Nothing
<a name="line-348"></a>> findIndexInListHelp count f (h:t)
<a name="line-349"></a>> = if (f h)
<a name="line-350"></a>> then Just count
<a name="line-351"></a>> else findIndexInListHelp (count+1) f t
<a name="line-352"></a>
<a name="line-353"></a>numTree applies numberTree with an initial state:
<a name="line-354"></a>
<a name="line-355"></a>> numTree :: (Eq a) => Tree a -> Tree Int
<a name="line-356"></a>> numTree t = evalState (numberTree t) []
<a name="line-357"></a>
<a name="line-358"></a>> testTree = Node "Zero" (Node "One" (Node "Two" Nil Nil) (Node "One" (Node "Zero" Nil Nil) Nil)) Nil
<a name="line-359"></a>> numTree testTree => Node 0 (Node 1 (Node 2 Nil Nil) (Node 1 (Node 0 Nil Nil) Nil)) Nil
<a name="line-360"></a>
<a name="line-361"></a>sumTree is a little helper function that does not use the State monad:
<a name="line-362"></a>
<a name="line-363"></a>> sumTree :: (Num a) => Tree a -> a
<a name="line-364"></a>> sumTree Nil = 0
<a name="line-365"></a>> sumTree (Node e t1 t2) = e + (sumTree t1) + (sumTree t2)
<a name="line-366"></a>
<a name="line-367"></a>-}</span>
</pre></body>
</html>
