<br><font size=2 face="sans-serif">I've been playing with MonadPrompt for
about ten days now, trying to get it to do something useful for me.</font>
<br>
<br><font size=2 face="sans-serif">Specifically, I'm trying to implement
&quot;guess a number&quot; since that's the hello world of haskell state
programs, or so it seems to me. I want to have this with scripting / replay
/ undo and the other goodies claimed possible</font>
<br>
<br><font size=2 face="sans-serif">http://thomashartman-learning.googlecode.com/svn/trunk/haskell/guessANumber</font>
<br>
<br><font size=2 face="sans-serif">It's been slow going due to still getting
to grips with GADTs and other more advanced features of the typing system.</font>
<br>
<br><font size=2 face="sans-serif">If Ryan (or anyone) would care to share
any working code for a simple game that uses MonadPrompt, ideally with
scripting / replay / undo that would be extremely helpful.</font>
<br>
<br><font size=2 face="sans-serif">Otherwise I'll be back with more specific
questions about my attempts to use this stuff soon enough :)</font>
<br>
<br><font size=2 face="sans-serif">(At present, that;'s just trying to
get some of the more interesting code you posted as &quot;untested&quot;
to compile.)</font>
<br>
<br><font size=2 face="sans-serif">For what it's worth, my game currently
saves high some (but not all) state-y information in a serialized form
to track high scores. If I can get this working with MonadPrompt, my next
quest will be to use MACID to do the serialization instead, and then *all*
state will be saved if I understand correctly.</font>
<br>
<br><font size=2 face="sans-serif">t.</font>
<br>
<br>
<br>
<br>
<table width=100%>
<tr valign=top>
<td width=40%><font size=1 face="sans-serif"><b>&quot;Ryan Ingram&quot;
&lt;ryani.spam@gmail.com&gt;</b> </font>
<br><font size=1 face="sans-serif">Sent by: haskell-cafe-bounces@haskell.org</font>
<p><font size=1 face="sans-serif">11/18/2007 07:22 PM</font>
<td width=59%>
<table width=100%>
<tr valign=top>
<td>
<div align=right><font size=1 face="sans-serif">To</font></div>
<td><font size=1 face="sans-serif">haskell &lt;haskell-cafe@haskell.org&gt;</font>
<tr valign=top>
<td>
<div align=right><font size=1 face="sans-serif">cc</font></div>
<td>
<tr valign=top>
<td>
<div align=right><font size=1 face="sans-serif">Subject</font></div>
<td><font size=1 face="sans-serif">[Haskell-cafe] An interesting monad:
&quot;Prompt&quot;</font></table>
<br>
<table>
<tr valign=top>
<td>
<td></table>
<br></table>
<br>
<br>
<br><font size=3 face="Courier New">(This message is a literate haskell
file. &nbsp;Code for the &quot;Prompt&quot; monad is<br>
preceded by &quot;&gt;&quot;; code for my examples is preceded by &quot;]&quot;
and isn't complete, <br>
but intended for illustration.)<br>
<br>
I've been trying to implement a few rules-driven board/card games in Haskell<br>
and I always run into the ugly problem of &quot;how do I get user input&quot;?<br>
<br>
The usual technique is to embed the game in the IO Monad: <br>
<br>
] type Game = IO<br>
] -- or<br>
] type Game = StateT GameState IO<br>
<br>
The problem with this approach is that now arbitrary IO computations are<br>
expressible as part of a game action, which makes it much harder to implement
<br>
things like replay, undo, and especially testing!<br>
<br>
The goal was to be able to write code like this:<br>
<br>
] takeTurn :: Player -&gt; Game ()<br>
] takeTurn player = do<br>
] &nbsp; &nbsp; piece &nbsp;&lt;- action (ChoosePiece player) <br>
] &nbsp; &nbsp; attack &lt;- action (ChooseAttack player piece)<br>
] &nbsp; &nbsp; bonusTurn &lt;- executeAttack piece attack<br>
] &nbsp; &nbsp; when bonusTurn $ takeTurn player<br>
<br>
but be able to script the code for testing, allow undo, automatically <br>
be able to save replays, etc.<br>
<br>
While thinking about this problem earlier this week, I came up with the<br>
following solution:<br>
<br>
&gt; {-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances &nbsp;#-}<br>
&gt; -- undecidable instances is only needed for the MonadTrans instance
below <br>
&gt;<br>
&gt; module Prompt where<br>
&gt; import Control.Monad.Trans<br>
&gt; import Control.Monad.Identity<br>
<br>
&gt; class Monad m =&gt; MonadPrompt p m | m -&gt; p where<br>
&gt; &nbsp; &nbsp;prompt :: p a -&gt; m a<br>
<br>
&quot;prompt&quot; is an action that takes a prompt type and gives you
a result. <br>
<br>
A simple example:<br>
] prompt [1,3,5] :: MonadPrompt [] m =&gt; m Int<br>
<br>
This prompt would ask for someone to pick a value from the list and return
it.<br>
This would be somewhat useful on its own; you could implement a &quot;choose&quot;
<br>
function that picked randomly from a list of options and gave<br>
non-deterministic (or even exhaustive) testing, but on its own this wouldn't<br>
be much better than the list monad.<br>
<br>
What really made this click for me was that the prompt type could be built
<br>
on a GADT:<br>
<br>
] newtype GamePrompt a = GP (GameState, GameChoice a)<br>
] data GameChoice a where<br>
] &nbsp; &nbsp;-- pick a piece to act with<br>
] &nbsp; &nbsp;ChoosePiece :: Player -&gt; GameChoice GamePiece<br>
] &nbsp; &nbsp;-- pick how they should attack <br>
] &nbsp; &nbsp;ChooseAttack :: Player -&gt; GamePiece -&gt; GameChoice
AttackType<br>
] &nbsp; &nbsp;-- etc.<br>
<br>
Now you can use this type information as part of a &quot;handler&quot;
function:<br>
] gameIO :: GamePrompt a -&gt; IO a<br>
] gameIO (GP (state, ChoosePiece player)) = getPiece state player<br>
] gameIO (GP (state, ChooseAttack player piece)) = attackMenu player piece<br>
] -- ...<br>
<br>
The neat thing here is that the GADT specializes the type of &quot;IO a&quot;
on the <br>
right hand side. &nbsp;So, &quot;getPiece state player&quot; has the type
&quot;IO GamePiece&quot;, not<br>
the general &quot;IO a&quot;. &nbsp;So the GADT is serving as a witness
of the type of<br>
response wanted by the game.<br>
<br>
Another neat things is that, you don't need to embed this in the IO monad
at<br>
all; you could instead run a pure computation to do AI, or even use it
for<br>
unit testing!<br>
<br>
&gt; -- unit testing example<br>
&gt; data ScriptElem p where SE :: p a -&gt; a -&gt; ScriptElem p <br>
&gt; type Script p = [ScriptElem p]<br>
&gt;<br>
&gt; infix 1 --&gt;<br>
&gt; (--&gt;) = SE<br>
<br>
<br>
] gameScript :: ScriptElem GameChoice -&gt; GameChoice a -&gt; Maybe a<br>
] gameScript (SE (ChoosePiece _) &nbsp; &nbsp;piece) &nbsp;(ChoosePiece
_) &nbsp; &nbsp;= Just piece <br>
] gameScript (SE (ChooseAttack _ _) attack) (ChooseAttack _ _) = Just attack<br>
] gameScript _ &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;_ &nbsp; &nbsp; &nbsp;
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;= Nothing<br>
]<br>
] testGame :: Script GameChoice<br>
] testGame =<br>
] &nbsp; [ ChoosePiece &nbsp;P1 &nbsp; &nbsp; &nbsp; &nbsp;--&gt; Knight
<br>
] &nbsp; , ChooseAttack P1 Knight --&gt; Charge<br>
] &nbsp; , ChoosePiece &nbsp;P2 &nbsp; &nbsp; &nbsp; &nbsp;--&gt; FootSoldier<br>
] &nbsp; , ...<br>
] &nbsp; ]<br>
<br>
So, how to implement all of this?<br>
<br>
&gt; data Prompt (p :: * -&gt; *) :: (* -&gt; *) where <br>
&gt; &nbsp; &nbsp; PromptDone :: result -&gt; Prompt p result<br>
&gt; &nbsp; &nbsp; -- a is the type needed to continue the computation<br>
&gt; &nbsp; &nbsp; Prompt :: p a -&gt; (a -&gt; Prompt p result) -&gt;
Prompt p result<br>
<br>
This doesn't require GADT's; it's just using existential types, but I like
<br>
the aesthetics better this way.<br>
<br>
Intuitively, a (Prompt p result) either gives you an immediate result<br>
(PromptDone), or gives you a prompt which you need to reply to in order
to<br>
continue the computation.<br>
<br>
This type is a MonadPrompt:<br>
<br>
&gt; instance Functor (Prompt p) where<br>
&gt; &nbsp; &nbsp;fmap f (PromptDone r) = PromptDone (f r)<br>
&gt; &nbsp; &nbsp;fmap f (Prompt p cont) = Prompt p (fmap f . cont)<br>
&gt;<br>
&gt; instance Monad (Prompt p) where <br>
&gt; &nbsp; &nbsp;return = PromptDone<br>
&gt; &nbsp; &nbsp;PromptDone r &nbsp;&gt;&gt;= f = f r<br>
&gt; &nbsp; &nbsp;Prompt p cont &gt;&gt;= f = Prompt p ((&gt;&gt;= f) .
cont)<br>
&gt;<br>
&gt; instance MonadPrompt p (Prompt p) where<br>
&gt; &nbsp; &nbsp;prompt p = Prompt p return <br>
&gt;<br>
&gt; -- Just for fun, make it work with StateT as well<br>
&gt; -- (needs -fallow-undecidable-instances)<br>
&gt; instance (Monad (t m), MonadTrans t, MonadPrompt p m) =&gt; MonadPrompt
p (t m) where<br>
&gt; &nbsp; &nbsp;prompt = lift . prompt <br>
<br>
The last bit to tie it together is an observation function which allows
you to<br>
run the game:<br>
<br>
&gt; runPromptM :: Monad m =&gt; (forall a. p a -&gt; m a) -&gt; Prompt
p r -&gt; m r<br>
&gt; runPromptM _ (PromptDone r) = return r <br>
&gt; runPromptM f (Prompt pa c) &nbsp;= f pa &gt;&gt;= runPromptM f . c<br>
&gt;<br>
&gt; runPrompt :: (forall a. p a -&gt; a) -&gt; Prompt p r -&gt; r<br>
&gt; runPrompt f p = runIdentity $ runPromptM (Identity . f) p<br>
&gt; <br>
&gt; runScript :: (forall a. ScriptElem p -&gt; p a -&gt; Maybe a)<br>
&gt; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; -&gt; Script p -&gt;
Prompt p r -&gt; Maybe r<br>
&gt; runScript _ [] &nbsp; &nbsp; (PromptDone r) = Just r<br>
&gt; runScript s (x:xs) (Prompt pa c) &nbsp;= case s x pa of <br>
&gt; &nbsp; &nbsp;Nothing -&gt; Nothing<br>
&gt; &nbsp; &nbsp;Just a &nbsp;-&gt; runScript s xs (c a)<br>
&gt; runScript _ _ &nbsp; &nbsp; &nbsp;_ &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;
&nbsp; &nbsp;= Nothing<br>
&gt; &nbsp; &nbsp;-- script &amp; computation out of sync<br>
<br>
My original goal is now achievable: <br>
<br>
] type Game = StateT GameState (Prompt GamePrompt)<br>
]<br>
] action :: GameChoice a -&gt; Game a<br>
] action p = do<br>
] &nbsp; &nbsp;state &lt;- get<br>
] &nbsp; &nbsp;prompt $ GP (state, p)<br>
<br>
] runGameScript :: Script GameChoice -&gt; GameState -&gt; Game a -&gt;
Maybe (GameState, a) <br>
] runGameScript script initialState game<br>
] &nbsp; &nbsp;= runScript scriptFn script' (runStateT game initialState)<br>
] &nbsp; &nbsp;where<br>
] &nbsp; &nbsp; &nbsp; script' = map sEmbed script<br>
] &nbsp; &nbsp; &nbsp; scriptFn s (GP (s,p)) = gameScript (sExtract s)
p <br>
] &nbsp; &nbsp; &nbsp; sEmbed &nbsp; (SE p a) = SE (GP (undefined, p))
a<br>
] &nbsp; &nbsp; &nbsp; sExtract (SE (GP (_,p)) a) = SE p a<br>
<br>
Any comments are welcome! &nbsp;Thanks for reading this far.<br>
<br>
 &nbsp;-- ryan<br>
</font><tt><font size=2>_______________________________________________<br>
Haskell-Cafe mailing list<br>
Haskell-Cafe@haskell.org<br>
http://www.haskell.org/mailman/listinfo/haskell-cafe<br>
</font></tt>
<br>
<br>
<span style="font-family:sans-serif,helvetica; font-size:10pt; color:#000000">---</span><br>
<br>
<span style="font-family:sans-serif,helvetica; font-size:10pt; color:#000000">This e-mail may contain confidential and/or privileged information. If you </span><br>
<span style="font-family:sans-serif,helvetica; font-size:10pt; color:#000000">are not the intended recipient (or have received this e-mail in error) </span><br>
<span style="font-family:sans-serif,helvetica; font-size:10pt; color:#000000">please notify the sender immediately and destroy this e-mail. Any </span><br>
<span style="font-family:sans-serif,helvetica; font-size:10pt; color:#000000">unauthorized copying, disclosure or distribution of the material in this </span><br>
<span style="font-family:sans-serif,helvetica; font-size:10pt; color:#000000">e-mail is strictly forbidden.</span><br>