[Haskell-cafe] An interesting monad: "Prompt"

[Thomas Hartman]

I've been playing with MonadPrompt for about ten days now, trying to get 
it to do something useful for me.

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

http://thomashartman-learning.googlecode.com/svn/trunk/haskell/guessANumber

It's been slow going due to still getting to grips with GADTs and other 
more advanced features of the typing system.

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.

Otherwise I'll be back with more specific questions about my attempts to 
use this stuff soon enough :)

(At present, that;'s just trying to get some of the more interesting code 
you posted as "untested" to compile.)

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.

t.




"Ryan Ingram" <ryani.spam at gmail.com> 
Sent by: haskell-cafe-bounces at haskell.org
11/18/2007 07:22 PM

To
haskell <haskell-cafe at haskell.org>
cc

Subject
[Haskell-cafe] An interesting monad: "Prompt"






(This message is a literate haskell file.  Code for the "Prompt" monad is
preceded by ">"; code for my examples is preceded by "]" and isn't 
complete, 
but intended for illustration.)

I've been trying to implement a few rules-driven board/card games in 
Haskell
and I always run into the ugly problem of "how do I get user input"?

The usual technique is to embed the game in the IO Monad: 

] type Game = IO
] -- or
] type Game = StateT GameState IO

The problem with this approach is that now arbitrary IO computations are
expressible as part of a game action, which makes it much harder to 
implement 
things like replay, undo, and especially testing!

The goal was to be able to write code like this:

] takeTurn :: Player -> Game ()
] takeTurn player = do
]     piece  <- action (ChoosePiece player) 
]     attack <- action (ChooseAttack player piece)
]     bonusTurn <- executeAttack piece attack
]     when bonusTurn $ takeTurn player

but be able to script the code for testing, allow undo, automatically 
be able to save replays, etc.

While thinking about this problem earlier this week, I came up with the
following solution:

> {-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances  #-}
> -- undecidable instances is only needed for the MonadTrans instance 
below 
>
> module Prompt where
> import Control.Monad.Trans
> import Control.Monad.Identity

> class Monad m => MonadPrompt p m | m -> p where
>    prompt :: p a -> m a

"prompt" is an action that takes a prompt type and gives you a result. 

A simple example:
] prompt [1,3,5] :: MonadPrompt [] m => m Int

This prompt would ask for someone to pick a value from the list and return 
it.
This would be somewhat useful on its own; you could implement a "choose" 
function that picked randomly from a list of options and gave
non-deterministic (or even exhaustive) testing, but on its own this 
wouldn't
be much better than the list monad.

What really made this click for me was that the prompt type could be built 

on a GADT:

] newtype GamePrompt a = GP (GameState, GameChoice a)
] data GameChoice a where
]    -- pick a piece to act with
]    ChoosePiece :: Player -> GameChoice GamePiece
]    -- pick how they should attack 
]    ChooseAttack :: Player -> GamePiece -> GameChoice AttackType
]    -- etc.

Now you can use this type information as part of a "handler" function:
] gameIO :: GamePrompt a -> IO a
] gameIO (GP (state, ChoosePiece player)) = getPiece state player
] gameIO (GP (state, ChooseAttack player piece)) = attackMenu player piece
] -- ...

The neat thing here is that the GADT specializes the type of "IO a" on the 

right hand side.  So, "getPiece state player" has the type "IO GamePiece", 
not
the general "IO a".  So the GADT is serving as a witness of the type of
response wanted by the game.

Another neat things is that, you don't need to embed this in the IO monad 
at
all; you could instead run a pure computation to do AI, or even use it for
unit testing!

> -- unit testing example
> data ScriptElem p where SE :: p a -> a -> ScriptElem p 
> type Script p = [ScriptElem p]
>
> infix 1 -->
> (-->) = SE


] gameScript :: ScriptElem GameChoice -> GameChoice a -> Maybe a
] gameScript (SE (ChoosePiece _)    piece)  (ChoosePiece _)    = Just 
piece 
] gameScript (SE (ChooseAttack _ _) attack) (ChooseAttack _ _) = Just 
attack
] gameScript _                              _                  = Nothing
]
] testGame :: Script GameChoice
] testGame =
]   [ ChoosePiece  P1        --> Knight 
]   , ChooseAttack P1 Knight --> Charge
]   , ChoosePiece  P2        --> FootSoldier
]   , ...
]   ]

So, how to implement all of this?

> data Prompt (p :: * -> *) :: (* -> *) where 
>     PromptDone :: result -> Prompt p result
>     -- a is the type needed to continue the computation
>     Prompt :: p a -> (a -> Prompt p result) -> Prompt p result

This doesn't require GADT's; it's just using existential types, but I like 

the aesthetics better this way.

Intuitively, a (Prompt p result) either gives you an immediate result
(PromptDone), or gives you a prompt which you need to reply to in order to
continue the computation.

This type is a MonadPrompt:

> instance Functor (Prompt p) where
>    fmap f (PromptDone r) = PromptDone (f r)
>    fmap f (Prompt p cont) = Prompt p (fmap f . cont)
>
> instance Monad (Prompt p) where 
>    return = PromptDone
>    PromptDone r  >>= f = f r
>    Prompt p cont >>= f = Prompt p ((>>= f) . cont)
>
> instance MonadPrompt p (Prompt p) where
>    prompt p = Prompt p return 
>
> -- Just for fun, make it work with StateT as well
> -- (needs -fallow-undecidable-instances)
> instance (Monad (t m), MonadTrans t, MonadPrompt p m) => MonadPrompt p 
(t m) where
>    prompt = lift . prompt 

The last bit to tie it together is an observation function which allows 
you to
run the game:

> runPromptM :: Monad m => (forall a. p a -> m a) -> Prompt p r -> m r
> runPromptM _ (PromptDone r) = return r 
> runPromptM f (Prompt pa c)  = f pa >>= runPromptM f . c
>
> runPrompt :: (forall a. p a -> a) -> Prompt p r -> r
> runPrompt f p = runIdentity $ runPromptM (Identity . f) p
> 
> runScript :: (forall a. ScriptElem p -> p a -> Maybe a)
>               -> Script p -> Prompt p r -> Maybe r
> runScript _ []     (PromptDone r) = Just r
> runScript s (x:xs) (Prompt pa c)  = case s x pa of 
>    Nothing -> Nothing
>    Just a  -> runScript s xs (c a)
> runScript _ _      _              = Nothing
>    -- script & computation out of sync

My original goal is now achievable: 

] type Game = StateT GameState (Prompt GamePrompt)
]
] action :: GameChoice a -> Game a
] action p = do
]    state <- get
]    prompt $ GP (state, p)

] runGameScript :: Script GameChoice -> GameState -> Game a -> Maybe 
(GameState, a) 
] runGameScript script initialState game
]    = runScript scriptFn script' (runStateT game initialState)
]    where
]       script' = map sEmbed script
]       scriptFn s (GP (s,p)) = gameScript (sExtract s) p 
]       sEmbed   (SE p a) = SE (GP (undefined, p)) a
]       sExtract (SE (GP (_,p)) a) = SE p a

Any comments are welcome!  Thanks for reading this far.

  -- ryan
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe at haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



---

This e-mail may contain confidential and/or privileged information. If you 
are not the intended recipient (or have received this e-mail in error) 
please notify the sender immediately and destroy this e-mail. Any 
unauthorized copying, disclosure or distribution of the material in this 
e-mail is strictly forbidden.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20071203/07f95e08/attachment-0001.htm