<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
"guess a number" 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 "untested"
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>"Ryan Ingram"
<ryani.spam@gmail.com></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 <haskell-cafe@haskell.org></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:
"Prompt"</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. Code for the "Prompt" monad is<br>
preceded by ">"; code for my examples is preceded by "]"
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 "how do I get user input"?<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 -> Game ()<br>
] takeTurn player = do<br>
] piece <- action (ChoosePiece player) <br>
] attack <- action (ChooseAttack player piece)<br>
] bonusTurn <- executeAttack piece attack<br>
] 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>
> {-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}<br>
> -- undecidable instances is only needed for the MonadTrans instance
below <br>
><br>
> module Prompt where<br>
> import Control.Monad.Trans<br>
> import Control.Monad.Identity<br>
<br>
> class Monad m => MonadPrompt p m | m -> p where<br>
> prompt :: p a -> m a<br>
<br>
"prompt" 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 => 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 "choose"
<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>
] -- pick a piece to act with<br>
] ChoosePiece :: Player -> GameChoice GamePiece<br>
] -- pick how they should attack <br>
] ChooseAttack :: Player -> GamePiece -> GameChoice
AttackType<br>
] -- etc.<br>
<br>
Now you can use this type information as part of a "handler"
function:<br>
] gameIO :: GamePrompt a -> 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 "IO a"
on the <br>
right hand side. So, "getPiece state player" has the type
"IO GamePiece", not<br>
the general "IO a". 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>
> -- unit testing example<br>
> data ScriptElem p where SE :: p a -> a -> ScriptElem p <br>
> type Script p = [ScriptElem p]<br>
><br>
> infix 1 --><br>
> (-->) = SE<br>
<br>
<br>
] gameScript :: ScriptElem GameChoice -> GameChoice a -> Maybe a<br>
] gameScript (SE (ChoosePiece _) piece) (ChoosePiece
_) = Just piece <br>
] gameScript (SE (ChooseAttack _ _) attack) (ChooseAttack _ _) = Just attack<br>
] gameScript _
_
= Nothing<br>
]<br>
] testGame :: Script GameChoice<br>
] testGame =<br>
] [ ChoosePiece P1 --> Knight
<br>
] , ChooseAttack P1 Knight --> Charge<br>
] , ChoosePiece P2 --> FootSoldier<br>
] , ...<br>
] ]<br>
<br>
So, how to implement all of this?<br>
<br>
> data Prompt (p :: * -> *) :: (* -> *) where <br>
> PromptDone :: result -> Prompt p result<br>
> -- a is the type needed to continue the computation<br>
> Prompt :: p a -> (a -> Prompt p result) ->
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>
> instance Functor (Prompt p) where<br>
> fmap f (PromptDone r) = PromptDone (f r)<br>
> fmap f (Prompt p cont) = Prompt p (fmap f . cont)<br>
><br>
> instance Monad (Prompt p) where <br>
> return = PromptDone<br>
> PromptDone r >>= f = f r<br>
> Prompt p cont >>= f = Prompt p ((>>= f) .
cont)<br>
><br>
> instance MonadPrompt p (Prompt p) where<br>
> prompt p = Prompt p return <br>
><br>
> -- Just for fun, make it work with StateT as well<br>
> -- (needs -fallow-undecidable-instances)<br>
> instance (Monad (t m), MonadTrans t, MonadPrompt p m) => MonadPrompt
p (t m) where<br>
> 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>
> runPromptM :: Monad m => (forall a. p a -> m a) -> Prompt
p r -> m r<br>
> runPromptM _ (PromptDone r) = return r <br>
> runPromptM f (Prompt pa c) = f pa >>= runPromptM f . c<br>
><br>
> runPrompt :: (forall a. p a -> a) -> Prompt p r -> r<br>
> runPrompt f p = runIdentity $ runPromptM (Identity . f) p<br>
> <br>
> runScript :: (forall a. ScriptElem p -> p a -> Maybe a)<br>
> -> Script p ->
Prompt p r -> Maybe r<br>
> runScript _ [] (PromptDone r) = Just r<br>
> runScript s (x:xs) (Prompt pa c) = case s x pa of <br>
> Nothing -> Nothing<br>
> Just a -> runScript s xs (c a)<br>
> runScript _ _ _
= Nothing<br>
> -- script & 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 -> Game a<br>
] action p = do<br>
] state <- get<br>
] prompt $ GP (state, p)<br>
<br>
] runGameScript :: Script GameChoice -> GameState -> Game a ->
Maybe (GameState, a) <br>
] runGameScript script initialState game<br>
] = runScript scriptFn script' (runStateT game initialState)<br>
] where<br>
] script' = map sEmbed script<br>
] scriptFn s (GP (s,p)) = gameScript (sExtract s)
p <br>
] sEmbed (SE p a) = SE (GP (undefined, p))
a<br>
] sExtract (SE (GP (_,p)) a) = SE p a<br>
<br>
Any comments are welcome! Thanks for reading this far.<br>
<br>
-- 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>