<div>I posted the current version of this code at</div>
<div><a href="http://ryani.freeshell.org/haskell/">http://ryani.freeshell.org/haskell/</a></div>
<div> </div>
<div><span class="gmail_quote">On 12/28/07, <b class="gmail_sendername">Thomas Hartman</b> <<a href="mailto:tphyahoo@gmail.com">tphyahoo@gmail.com</a>> wrote:</span>
<blockquote class="gmail_quote" style="PADDING-LEFT: 1ex; MARGIN: 0px 0px 0px 0.8ex; BORDER-LEFT: #ccc 1px solid">Would you mind posting the code for Prompt used by<br><br>import Prompt<br><br>I tried using Prompt.lhs from your first post but it appears to be
<br>incompatible with the guessing game program when I got tired of<br>reading the code and actually tried running it.<br><br>best, thomas.<br><br><br><br>2007/12/4, Ryan Ingram <<a href="mailto:ryani.spam@gmail.com">ryani.spam@gmail.com
</a>>:<br>> Ask and ye shall receive. A simple guess-a-number game in MonadPrompt<br>> follows.<br>><br>> But before I get to that, I have some comments:<br>><br>><br>> Serializing the state at arbitrary places is hard; the Prompt contains a
<br>> continuation function so unless you have a way to serialize closures it<br>> seems like you lose. But if you have "safe points" during the execution at<br>> which you know all relevant state is inside your "game state", you can save
<br>> there by serializing the state and providing a way to restart the<br>> computation at those safe points.<br>><br>> I haven't looked at MACID at all; what's that?<br>><br>> > {-# LANGUAGE GADTs, RankNTypes #-}
<br>> > module Main where<br>> > import Prompt<br>> > import Control.Monad.State<br>> > import System.Random (randomRIO)<br>> > import System.IO<br>> > import Control.Exception (assert)
<br>><br>> Minimalist "functional references" implementation.<br>> In particular, for this example, we skip the really interesting thing:<br>> composability.<br>><br>> See <a href="http://luqui.org/blog/archives/2007/08/05/">
http://luqui.org/blog/archives/2007/08/05/</a> for a real<br>> implementation.<br>><br>> > data FRef s a = FRef<br>> > { frGet :: s -> a<br>> > , frSet :: a -> s -> s<br>> > }<br>
><br>> > fetch :: MonadState s m => FRef s a -> m a<br>> > fetch ref = get >>= return . frGet ref<br>><br>> > infix 1 =:<br>> > infix 1 =<<:<br>> > (=:) :: MonadState s m => FRef s a -> a -> m ()
<br>> > ref =: val = modify $ frSet ref val<br>> > (=<<:) :: MonadState s m => FRef s a -> m a -> m ()<br>> > ref =<<: act = act >>= modify . frSet ref<br>> > update :: MonadState s m => FRef s a -> (a -> a) -> m ()
<br>> > update ref f = fetch ref >>= \a -> ref =: f a<br>><br>> Interactions that a user can have with the game:<br>><br>> > data GuessP a where<br>> > GetNumber :: GuessP Int<br>> > Guess :: GuessP Int
<br>> > Print :: String -> GuessP ()<br>><br>> Game state.<br>><br>> We could do this with a lot less state, but I'm trying to show what's<br>> possible here. In fact, for this example it's probably easier to just
<br>> thread the state through the program directly, but bigger games want real<br>> state, so I'm showing how to do that.<br>><br>> > data GuessS = GuessS<br>> > { gsNumGuesses_ :: Int<br>> > , gsTargetNumber_ :: Int
<br>> > }<br>><br>> > -- a real implementation wouldn't do it this way :)<br>> > initialGameState :: GuessS<br>> > initialGameState = GuessS undefined undefined<br>><br>> > gsNumGuesses, gsTargetNumber :: FRef GuessS Int
<br>> > gsNumGuesses = FRef gsNumGuesses_ $ \a s -> s { gsNumGuesses_ = a }<br>> > gsTargetNumber = FRef gsTargetNumber_ $ \a s -> s { gsTargetNumber_ = a }<br>><br>> Game monad with some useful helper functions
<br>><br>> > type Game = StateT GuessS (Prompt GuessP)<br>><br>> > gPrint :: String -> Game ()<br>> > gPrint = prompt . Print<br>><br>> > gPrintLn :: String -> Game ()<br>> > gPrintLn s = gPrint (s ++ "\n")
<br>><br>> Implementation of the game:<br>><br>> > gameLoop :: Game Int<br>> > gameLoop = do<br>> > update gsNumGuesses (+1)<br>> > guessNum <- fetch gsNumGuesses<br>> > gPrint ("Guess #" ++ show guessNum ++ ":")
<br>> > guess <- prompt Guess<br>> > answer <- fetch gsTargetNumber<br>> ><br>> > if guess == answer<br>> > then do<br>> > gPrintLn "Right!"<br>> > return guessNum
<br>> > else do<br>> > gPrintLn $ concat<br>> > [ "You guessed too "<br>> > , if guess < answer then "low" else "high"<br>> > , "! Try again."
<br>> > ]<br>> > gameLoop<br>><br>> > game :: Game ()<br>> > game = do<br>> > gsNumGuesses =: 0<br>> > gsTargetNumber =<<: prompt GetNumber<br>> > gPrintLn "I'm thinking of a number. Try to guess it!"
<br>> > numGuesses <- gameLoop<br>> > gPrintLn ("It took you " ++ show numGuesses ++ " guesses!")<br>><br>> Simple unwrapper for StateT that launches the game.<br>><br>> > runGame :: Monad m => (forall a. GuessP a -> m a) -> m ()
<br>> > runGame f = runPromptM f (evalStateT game initialGameState)<br>><br>> Here is the magic function for interacting with the player in IO. Exercise<br>> for the reader: make this more robust.<br>><br>
> > gameIOPrompt :: GuessP a -> IO a<br>> > gameIOPrompt GetNumber = randomRIO (1, 100)<br>> > gameIOPrompt (Print s) = putStr s<br>> > gameIOPrompt Guess = fmap read getLine<br>><br>> If you wanted to add undo, all you have to do is save off the current Prompt
<br>> in the middle of runPromptM; you can return to the old state at any time.<br>><br>> > gameIO :: IO ()<br>> > gameIO = do<br>> > hSetBuffering stdout NoBuffering<br>> > runGame gameIOPrompt
<br>><br>> Here's a scripted version.<br>><br>> > type GameScript = State [Int]<br>> ><br>> > scriptPrompt :: Int -> GuessP a -> GameScript a<br>> > scriptPrompt n GetNumber = return n
<br>> > scriptPrompt _ (Print _) = return ()<br>> > scriptPrompt _ Guess = do<br>> > (x:xs) <- get -- fails if script runs out of answers<br>> > put xs<br>> > return x<br>> >
<br>> > scriptTarget :: Int<br>> > scriptTarget = 23<br>> > scriptGuesses :: [Int]<br>> > scriptGuesses = [50, 25, 12, 19, 22, 24, 23]<br>><br>> gameScript is True if the game ran to completion successfully, and False or
<br>> bottom otherwise.<br>> Try adding or removing numbers from scriptGuesses above and re-running the<br>> program.<br>><br>> > gameScript :: Bool<br>> > gameScript = null $ execState (runGame (scriptPrompt scriptTarget))
<br>> scriptGuesses<br>><br>> > main = do<br>> > assert gameScript $ return ()<br>> > gameIO<br>><br>> _______________________________________________<br>> Haskell-Cafe mailing list<br>
> <a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>> <a href="http://www.haskell.org/mailman/listinfo/haskell-cafe">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>><br>><br>
</blockquote></div><br>