operational-0.2.0.0: docs/web/examples/ListT.hs.html
<!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>examples/ListT.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><span class='hs-comment'>{------------------------------------------------------------------------------
Control.Monad.Operational
Example:
List Monad Transformer
------------------------------------------------------------------------------}</span>
<span class='hs-comment'>{-# LANGUAGE GADTs, Rank2Types, FlexibleInstances #-}</span>
<span class='hs-keyword'>module</span> <span class='hs-conid'>ListT</span> <span class='hs-keyword'>where</span>
<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-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'>Operational</span>
<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-comment'>{------------------------------------------------------------------------------
A direct implementation
type ListT m a = m [a]
would violate the monad laws, but we don't have that problem.
------------------------------------------------------------------------------}</span>
<span class='hs-keyword'>data</span> <span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyword'>where</span>
<span class='hs-conid'>MZero</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<span class='hs-conid'>MPlus</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ListT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ListT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<span class='hs-keyword'>type</span> <span class='hs-conid'>ListT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ProgramT</span> <span class='hs-layout'>(</span><span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<span class='hs-comment'>-- *sigh* I want to use type synonyms for type constructors, too;</span>
<span class='hs-comment'>-- GHC doesn't accept MonadMPlus (ListT m)</span>
<span class='hs-keyword'>instance</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>MonadPlus</span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgramT</span> <span class='hs-layout'>(</span><span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<span class='hs-varid'>mzero</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>singleton</span> <span class='hs-conid'>MZero</span>
<span class='hs-varid'>mplus</span> <span class='hs-varid'>m</span> <span class='hs-varid'>n</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>singleton</span> <span class='hs-layout'>(</span><span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span>
<span class='hs-definition'>runListT</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>ListT</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span>
<span class='hs-definition'>runListT</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eval</span> <span class='hs-varop'><=<</span> <span class='hs-varid'>viewT</span>
<span class='hs-keyword'>where</span>
<span class='hs-varid'>eval</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>ProgramViewT</span> <span class='hs-layout'>(</span><span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span>
<span class='hs-varid'>eval</span> <span class='hs-layout'>(</span><span class='hs-conid'>Return</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>x</span><span class='hs-keyglyph'>]</span>
<span class='hs-varid'>eval</span> <span class='hs-layout'>(</span><span class='hs-conid'>MZero</span> <span class='hs-conop'>:>>=</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-conid'>[]</span>
<span class='hs-varid'>eval</span> <span class='hs-layout'>(</span><span class='hs-conid'>MPlus</span> <span class='hs-varid'>m</span> <span class='hs-varid'>n</span> <span class='hs-conop'>:>>=</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<span class='hs-varid'>liftM2</span> <span class='hs-layout'>(</span><span class='hs-varop'>++</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>runListT</span> <span class='hs-layout'>(</span><span class='hs-varid'>m</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>runListT</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>k</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<span class='hs-definition'>testListT</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IO</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>()</span><span class='hs-keyglyph'>]</span>
<span class='hs-definition'>testListT</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runListT</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<span class='hs-varid'>n</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>choice</span> <span class='hs-keyglyph'>[</span><span class='hs-num'>1</span><span class='hs-keyglyph'>..</span><span class='hs-num'>5</span><span class='hs-keyglyph'>]</span>
<span class='hs-varid'>lift</span> <span class='hs-varop'>.</span> <span class='hs-varid'>print</span> <span class='hs-varop'>$</span> <span class='hs-str'>"You've chosen the number: "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>n</span>
<span class='hs-keyword'>where</span>
<span class='hs-varid'>choice</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldr1</span> <span class='hs-varid'>mplus</span> <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>return</span>
<span class='hs-comment'>-- testing the monad laws, from the Haskellwiki</span>
<span class='hs-comment'>-- <a href="http://www.haskell.org/haskellwiki/ListT_done_right#Order_of_printing">http://www.haskell.org/haskellwiki/ListT_done_right#Order_of_printing</a></span>
<span class='hs-definition'>a</span><span class='hs-layout'>,</span><span class='hs-varid'>b</span><span class='hs-layout'>,</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ListT</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<span class='hs-keyglyph'>[</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-varid'>c</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>lift</span> <span class='hs-varop'>.</span> <span class='hs-varid'>putChar</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-chr'>'a'</span><span class='hs-layout'>,</span><span class='hs-chr'>'b'</span><span class='hs-layout'>,</span><span class='hs-chr'>'c'</span><span class='hs-keyglyph'>]</span>
<span class='hs-comment'>-- t1 and t2 have to print the same sequence of letters</span>
<span class='hs-definition'>t1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runListT</span> <span class='hs-varop'>$</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-varop'>`mplus`</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span> <span class='hs-varid'>c</span>
<span class='hs-definition'>t2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>runListT</span> <span class='hs-varop'>$</span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-varop'>`mplus`</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-varop'>>></span> <span class='hs-layout'>(</span><span class='hs-varid'>b</span> <span class='hs-varop'>>></span> <span class='hs-varid'>c</span><span class='hs-layout'>)</span>
</pre></body>
</html>