packages feed

operational-0.2.0.0: docs/web/examples/TicTacToe.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/TicTacToe.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><span class='hs-comment'>{------------------------------------------------------------------------------
    Control.Monad.Operational
    
    Example:
    An implementation of the game TicTacToe.
    
    Each player (human, AI, ...) is implemented in a separate monad
    which are then intermingled to run the game. This resembles the
    PoorMansConcurrency.hs example.
    
    
    Many thanks to Yves Pars and Bertram Felgenhauer
    <a href="http://www.haskell.org/pipermail/haskell-cafe/2010-April/076216.html">http://www.haskell.org/pipermail/haskell-cafe/2010-April/076216.html</a>

------------------------------------------------------------------------------}</span>
<span class='hs-comment'>{-# LANGUAGE GADTs, Rank2Types #-}</span>
<span class='hs-keyword'>module</span> <span class='hs-conid'>TicTacToe</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'>State</span>

<span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Either</span>
<span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span>

    <span class='hs-comment'>-- external libraries needed</span>
<span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Random</span>

<span class='hs-comment'>{------------------------------------------------------------------------------
    The Player monad for implementing players (human, AI, ...)
    provides two operations
    
        readBoard   -- read the current board position
        playMove    -- play a move

    to query the current board position and perform a move, respectively.
    
    Moreover, it's actually a monad transformer intended to be used over IO.
    This way, the players can perform IO computations.
------------------------------------------------------------------------------}</span>
<span class='hs-keyword'>data</span> <span class='hs-conid'>PlayerI</span> <span class='hs-varid'>a</span> <span class='hs-keyword'>where</span>
    <span class='hs-conid'>ReadBoard</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>PlayerI</span> <span class='hs-conid'>Board</span>
    <span class='hs-conid'>PlayMove</span>  <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>PlayerI</span> <span class='hs-conid'>Bool</span>
    
<span class='hs-keyword'>type</span> <span class='hs-conid'>Player</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-conid'>PlayerI</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>

<span class='hs-definition'>readBoard</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>singleton</span> <span class='hs-conid'>ReadBoard</span>
<span class='hs-definition'>playMove</span>  <span class='hs-keyglyph'>=</span> <span class='hs-varid'>singleton</span> <span class='hs-varop'>.</span> <span class='hs-conid'>PlayMove</span>

    <span class='hs-comment'>-- interpreter</span>
<span class='hs-definition'>runGame</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Player</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Player</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<span class='hs-definition'>runGame</span> <span class='hs-varid'>player1</span> <span class='hs-varid'>player2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eval'</span> <span class='hs-varid'>initialGameState</span> <span class='hs-varid'>player1</span> <span class='hs-varid'>player2</span>
    <span class='hs-keyword'>where</span>
    <span class='hs-varid'>eval'</span> <span class='hs-varid'>game</span> <span class='hs-varid'>p1</span> <span class='hs-varid'>p2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>viewT</span> <span class='hs-varid'>p1</span> <span class='hs-varop'>&gt;&gt;=</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>p1view</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>eval</span> <span class='hs-varid'>game</span> <span class='hs-varid'>p1view</span> <span class='hs-varid'>p2</span>
    
    <span class='hs-varid'>eval</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GameState</span>
         <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>ProgramViewT</span> <span class='hs-conid'>PlayerI</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Player</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
         <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
    <span class='hs-varid'>eval</span> <span class='hs-varid'>game</span> <span class='hs-layout'>(</span><span class='hs-conid'>Return</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span>            <span class='hs-keyword'>_</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-varid'>game</span> <span class='hs-layout'>(</span><span class='hs-conid'>ReadBoard</span>   <span class='hs-conop'>:&gt;&gt;=</span> <span class='hs-varid'>p1</span><span class='hs-layout'>)</span> <span class='hs-varid'>p2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eval'</span> <span class='hs-varid'>game</span> <span class='hs-layout'>(</span><span class='hs-varid'>p1</span> <span class='hs-layout'>(</span><span class='hs-varid'>board</span> <span class='hs-varid'>game</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>p2</span>
    <span class='hs-varid'>eval</span> <span class='hs-varid'>game</span> <span class='hs-layout'>(</span><span class='hs-conid'>PlayMove</span> <span class='hs-varid'>mv</span> <span class='hs-conop'>:&gt;&gt;=</span> <span class='hs-varid'>p1</span><span class='hs-layout'>)</span> <span class='hs-varid'>p2</span> <span class='hs-keyglyph'>=</span>
        <span class='hs-keyword'>case</span> <span class='hs-varid'>makeMove</span> <span class='hs-varid'>mv</span> <span class='hs-varid'>game</span> <span class='hs-keyword'>of</span>
            <span class='hs-conid'>Nothing</span>         <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>eval'</span> <span class='hs-varid'>game</span> <span class='hs-layout'>(</span><span class='hs-varid'>p1</span> <span class='hs-conid'>False</span><span class='hs-layout'>)</span> <span class='hs-varid'>p2</span>
            <span class='hs-conid'>Just</span> <span class='hs-varid'>game'</span>
                <span class='hs-keyglyph'>|</span> <span class='hs-varid'>won</span> <span class='hs-varid'>game'</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>activePlayer</span> <span class='hs-varid'>game</span> <span class='hs-keyword'>in</span>
                               <span class='hs-varid'>putStrLn</span> <span class='hs-varop'>$</span> <span class='hs-str'>"Player "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>p</span> <span class='hs-varop'>++</span> <span class='hs-str'>" has won!"</span>
                <span class='hs-keyglyph'>|</span> <span class='hs-varid'>draw</span> <span class='hs-varid'>game'</span><span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>putStrLn</span> <span class='hs-varop'>$</span> <span class='hs-str'>"It's a draw."</span>
                <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-varid'>eval'</span> <span class='hs-varid'>game'</span> <span class='hs-varid'>p2</span> <span class='hs-layout'>(</span><span class='hs-varid'>p1</span> <span class='hs-conid'>True</span><span class='hs-layout'>)</span>
    
    <span class='hs-comment'>-- example: human vs AI</span>
<span class='hs-definition'>main</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
    <span class='hs-varid'>g</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>getStdGen</span>
    <span class='hs-varid'>runGame</span> <span class='hs-varid'>playerHuman</span> <span class='hs-layout'>(</span><span class='hs-varid'>playerAI</span> <span class='hs-varid'>g</span><span class='hs-layout'>)</span>

<span class='hs-comment'>{------------------------------------------------------------------------------
    TicTacToe Board type and logic
    
    The board looks like this:
    
    +---+---+---+   some squares already played on
    | 1 | 2 | 3 |   the empty squares are numbered
    +---+---+---+
    | 4 | 5 |OOO|
    +---+---+---+
    | 7 |XXX| 9 |
    +---+---+---+
------------------------------------------------------------------------------}</span>
<span class='hs-keyword'>data</span> <span class='hs-conid'>Symbol</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>X</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>O</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Eq</span><span class='hs-layout'>,</span><span class='hs-conid'>Show</span><span class='hs-layout'>)</span>
<span class='hs-keyword'>type</span> <span class='hs-conid'>Square</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Either</span> <span class='hs-conid'>Int</span> <span class='hs-conid'>Symbol</span>
<span class='hs-keyword'>type</span> <span class='hs-conid'>Board</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-conid'>Square</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
<span class='hs-keyword'>data</span> <span class='hs-conid'>GameState</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Game</span> <span class='hs-layout'>{</span> <span class='hs-varid'>board</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Board</span><span class='hs-layout'>,</span> <span class='hs-varid'>activePlayer</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Symbol</span> <span class='hs-layout'>}</span>

<span class='hs-definition'>initialGameState</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GameState</span>
<span class='hs-definition'>initialGameState</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Game</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-conid'>Left</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-num'>2</span><span class='hs-layout'>,</span><span class='hs-num'>3</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-num'>4</span><span class='hs-layout'>,</span><span class='hs-num'>5</span><span class='hs-layout'>,</span><span class='hs-num'>6</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-num'>7</span><span class='hs-layout'>,</span><span class='hs-num'>8</span><span class='hs-layout'>,</span><span class='hs-num'>9</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-conid'>X</span>

    <span class='hs-comment'>-- list the possible moves to play</span>
<span class='hs-definition'>possibleMoves</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Board</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Int</span><span class='hs-keyglyph'>]</span>
<span class='hs-definition'>possibleMoves</span> <span class='hs-varid'>board</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>k</span> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Left</span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>concat</span> <span class='hs-varid'>board</span><span class='hs-keyglyph'>]</span>

    <span class='hs-comment'>-- play a stone at a square</span>
<span class='hs-definition'>makeMove</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Int</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>GameState</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>GameState</span>
<span class='hs-definition'>makeMove</span> <span class='hs-varid'>k</span> <span class='hs-layout'>(</span><span class='hs-conid'>Game</span> <span class='hs-varid'>board</span> <span class='hs-varid'>player</span><span class='hs-layout'>)</span>
    <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>k</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>possibleMoves</span> <span class='hs-varid'>board</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>   <span class='hs-comment'>-- illegal move</span>
    <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Game</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>replace</span><span class='hs-layout'>)</span> <span class='hs-varid'>board</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>switch</span> <span class='hs-varid'>player</span><span class='hs-layout'>)</span>
    <span class='hs-keyword'>where</span>
    <span class='hs-varid'>replace</span> <span class='hs-layout'>(</span><span class='hs-conid'>Left</span> <span class='hs-varid'>k'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>k'</span> <span class='hs-varop'>==</span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Right</span> <span class='hs-varid'>player</span>
    <span class='hs-varid'>replace</span> <span class='hs-varid'>x</span>                   <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span>

    <span class='hs-varid'>switch</span> <span class='hs-conid'>X</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>O</span>
    <span class='hs-varid'>switch</span> <span class='hs-conid'>O</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>X</span>

    <span class='hs-comment'>-- has somebody won the game?</span>
<span class='hs-definition'>won</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GameState</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<span class='hs-definition'>won</span> <span class='hs-layout'>(</span><span class='hs-conid'>Game</span> <span class='hs-varid'>board</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>any</span> <span class='hs-varid'>full</span> <span class='hs-varop'>$</span> <span class='hs-varid'>diagonals</span> <span class='hs-varid'>board</span> <span class='hs-varop'>++</span> <span class='hs-varid'>rows</span> <span class='hs-varid'>board</span> <span class='hs-varop'>++</span> <span class='hs-varid'>cols</span> <span class='hs-varid'>board</span>
    <span class='hs-keyword'>where</span>
    <span class='hs-varid'>full</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'>a</span> <span class='hs-varop'>==</span> <span class='hs-varid'>b</span> <span class='hs-varop'>&amp;&amp;</span> <span class='hs-varid'>b</span> <span class='hs-varop'>==</span> <span class='hs-varid'>c</span>
    <span class='hs-varid'>diagonals</span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>a1</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>b1</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
               <span class='hs-keyglyph'>[</span><span class='hs-keyword'>_</span> <span class='hs-layout'>,</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>
               <span class='hs-keyglyph'>[</span><span class='hs-varid'>b2</span><span class='hs-layout'>,</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>a2</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>a1</span><span class='hs-layout'>,</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span><span class='hs-varid'>a2</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span><span class='hs-keyglyph'>[</span><span class='hs-varid'>b1</span><span class='hs-layout'>,</span><span class='hs-varid'>c</span><span class='hs-layout'>,</span><span class='hs-varid'>b2</span><span class='hs-keyglyph'>]</span><span class='hs-keyglyph'>]</span>
    <span class='hs-varid'>rows</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>id</span>
    <span class='hs-varid'>cols</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>transpose</span>

    <span class='hs-comment'>-- is the game a draw?</span>
<span class='hs-definition'>draw</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>GameState</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Bool</span>
<span class='hs-definition'>draw</span> <span class='hs-layout'>(</span><span class='hs-conid'>Game</span> <span class='hs-varid'>board</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>null</span> <span class='hs-layout'>(</span><span class='hs-varid'>possibleMoves</span> <span class='hs-varid'>board</span><span class='hs-layout'>)</span>

    <span class='hs-comment'>-- print the board</span>
<span class='hs-definition'>showSquare</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>either</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>n</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-str'>" "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>n</span> <span class='hs-varop'>++</span> <span class='hs-str'>" "</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>concat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>replicate</span> <span class='hs-num'>3</span> <span class='hs-varop'>.</span> <span class='hs-varid'>show</span><span class='hs-layout'>)</span>

<span class='hs-definition'>showBoard</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Board</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>String</span>
<span class='hs-definition'>showBoard</span> <span class='hs-varid'>board</span> <span class='hs-keyglyph'>=</span>
      <span class='hs-varid'>unlines</span> <span class='hs-varop'>.</span> <span class='hs-varid'>surround</span> <span class='hs-str'>"+---+---+---+"</span>
    <span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>concat</span> <span class='hs-varop'>.</span> <span class='hs-varid'>surround</span> <span class='hs-str'>"|"</span><span class='hs-varop'>.</span> <span class='hs-varid'>map</span> <span class='hs-varid'>showSquare</span><span class='hs-layout'>)</span>
    <span class='hs-varop'>$</span> <span class='hs-varid'>board</span>
    <span class='hs-keyword'>where</span>
    <span class='hs-varid'>surround</span> <span class='hs-varid'>x</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>x</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>++</span> <span class='hs-varid'>intersperse</span> <span class='hs-varid'>x</span> <span class='hs-varid'>xs</span> <span class='hs-varop'>++</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>x</span><span class='hs-keyglyph'>]</span>

<span class='hs-definition'>printBoard</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>putStr</span> <span class='hs-varop'>.</span> <span class='hs-varid'>showBoard</span>

<span class='hs-comment'>{------------------------------------------------------------------------------
    Player examples
------------------------------------------------------------------------------}</span>
    <span class='hs-comment'>-- a human player on the command line</span>
<span class='hs-definition'>playerHuman</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Player</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<span class='hs-definition'>playerHuman</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>forever</span> <span class='hs-varop'>$</span> <span class='hs-varid'>readBoard</span> <span class='hs-varop'>&gt;&gt;=</span> <span class='hs-varid'>liftIO</span> <span class='hs-varop'>.</span> <span class='hs-varid'>printBoard</span> <span class='hs-varop'>&gt;&gt;</span> <span class='hs-varid'>doMove</span>
    <span class='hs-keyword'>where</span>
    <span class='hs-comment'>-- ask the player where to move</span>
    <span class='hs-varid'>doMove</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Player</span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
    <span class='hs-varid'>doMove</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
        <span class='hs-varid'>liftIO</span> <span class='hs-varop'>.</span> <span class='hs-varid'>putStrLn</span> <span class='hs-varop'>$</span> <span class='hs-str'>"At which number would you like to play?"</span>
        <span class='hs-varid'>n</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>liftIO</span> <span class='hs-varid'>getLine</span>
        <span class='hs-varid'>b</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>playMove</span> <span class='hs-layout'>(</span><span class='hs-varid'>read</span> <span class='hs-varid'>n</span><span class='hs-layout'>)</span>
        <span class='hs-varid'>unless</span> <span class='hs-varid'>b</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
            <span class='hs-varid'>liftIO</span> <span class='hs-varop'>.</span> <span class='hs-varid'>putStrLn</span> <span class='hs-varop'>$</span> <span class='hs-str'>"Position "</span> <span class='hs-varop'>++</span> <span class='hs-varid'>show</span> <span class='hs-varid'>n</span> <span class='hs-varop'>++</span> <span class='hs-str'>" is already full."</span>
            <span class='hs-varid'>doMove</span>

    <span class='hs-comment'>-- a random AI,</span>
    <span class='hs-comment'>-- also demonstrates how to use a custom StateT on top</span>
    <span class='hs-comment'>--   of the Player monad</span>
<span class='hs-definition'>playerAI</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-conid'>StdGen</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>Player</span> <span class='hs-varid'>m</span> <span class='hs-conid'>()</span>
<span class='hs-definition'>playerAI</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>evalStateT</span> <span class='hs-varid'>ai</span>
    <span class='hs-keyword'>where</span>
    <span class='hs-varid'>ai</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-conid'>StateT</span> <span class='hs-conid'>StdGen</span> <span class='hs-layout'>(</span><span class='hs-conid'>ProgramT</span> <span class='hs-conid'>PlayerI</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-conid'>()</span>
    <span class='hs-varid'>ai</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>forever</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
        <span class='hs-varid'>board</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>readBoard</span>
        <span class='hs-varid'>n</span>     <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>uniform</span> <span class='hs-layout'>(</span><span class='hs-varid'>possibleMoves</span> <span class='hs-varid'>board</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- select a random move</span>
        <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>playMove</span> <span class='hs-varid'>n</span>
        <span class='hs-keyword'>where</span>
        <span class='hs-comment'>-- select one element at random</span>
        <span class='hs-varid'>uniform</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=&gt;</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>a</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-&gt;</span> <span class='hs-conid'>StateT</span> <span class='hs-conid'>StdGen</span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
        <span class='hs-varid'>uniform</span> <span class='hs-varid'>xs</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
            <span class='hs-varid'>gen</span> <span class='hs-keyglyph'>&lt;-</span> <span class='hs-varid'>get</span>
            <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span><span class='hs-varid'>gen'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>randomR</span> <span class='hs-layout'>(</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-varid'>length</span> <span class='hs-varid'>xs</span><span class='hs-layout'>)</span> <span class='hs-varid'>gen</span>
            <span class='hs-varid'>put</span> <span class='hs-varid'>gen'</span>
            <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>xs</span> <span class='hs-varop'>!!</span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-comment'>-</span><span class='hs-num'>1</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>

</pre></body>
</html>