<div>Ask and ye shall receive. A simple guess-a-number game in MonadPrompt follows.</div>
<div> </div>
<div>But before I get to that, I have some comments:</div>
<div> </div>
<div>
<div>Serializing the state at arbitrary places is hard; the Prompt contains a continuation function so unless you have a way to serialize closures it seems like you lose. But if you have "safe points" during the execution at which you know all relevant state is inside your "game state", you can save there by serializing the state and providing a way to restart the computation at those safe points.
</div>
<div> </div>
<div>I haven't looked at MACID at all; what's that?</div></div>
<div> </div>
<div>> {-# 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)</div>
<div> </div>
<div>Minimalist "functional references" implementation.<br>In particular, for this example, we skip the really interesting thing: composability.</div>
<div> </div>
<div>See <a href="http://luqui.org/blog/archives/2007/08/05/">http://luqui.org/blog/archives/2007/08/05/</a> for a real implementation.</div>
<div> </div>
<div>> data FRef s a = FRef<br>> { frGet :: s -> a<br>> , frSet :: a -> s -> s<br>> }</div>
<div> </div>
<div>> fetch :: MonadState s m => FRef s a -> m a<br>> fetch ref = get >>= return . frGet ref</div>
<div> </div>
<div>> 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</div>
<div> </div>
<div>Interactions that a user can have with the game:</div>
<div> </div>
<div>> data GuessP a where<br>> GetNumber :: GuessP Int<br>> Guess :: GuessP Int<br>> Print :: String -> GuessP ()</div>
<div> </div>
<div>Game state.</div>
<div> </div>
<div>We could do this with a lot less state, but I'm trying to show what's possible here. In fact, for this example it's probably easier to just thread the state through the program directly, but bigger games want real state, so I'm showing how to do that.
</div>
<div> </div>
<div>> data GuessS = GuessS<br>> { gsNumGuesses_ :: Int<br>> , gsTargetNumber_ :: Int<br>> }</div>
<div> </div>
<div>> -- a real implementation wouldn't do it this way :)<br>> initialGameState :: GuessS<br>> initialGameState = GuessS undefined undefined</div>
<div> </div>
<div>> gsNumGuesses, gsTargetNumber :: FRef GuessS Int<br>> gsNumGuesses = FRef gsNumGuesses_ $ \a s -> s { gsNumGuesses_ = a }<br>> gsTargetNumber = FRef gsTargetNumber_ $ \a s -> s { gsTargetNumber_ = a }
</div>
<div> </div>
<div>Game monad with some useful helper functions</div>
<div> </div>
<div>> type Game = StateT GuessS (Prompt GuessP)</div>
<div> </div>
<div>> gPrint :: String -> Game ()<br>> gPrint = prompt . Print</div>
<div> </div>
<div>> gPrintLn :: String -> Game ()<br>> gPrintLn s = gPrint (s ++ "\n")</div>
<div> </div>
<div>Implementation of the game:</div>
<div> </div>
<div>> 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
</div>
<div> </div>
<div>> 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!")</div>
<div> </div>
<div>Simple unwrapper for StateT that launches the game.</div>
<div> </div>
<div>> runGame :: Monad m => (forall a. GuessP a -> m a) -> m ()<br>> runGame f = runPromptM f (evalStateT game initialGameState)<br> </div>
<div>Here is the magic function for interacting with the player in IO. Exercise for the reader: make this more robust.</div>
<div> </div>
<div>> gameIOPrompt :: GuessP a -> IO a<br>> gameIOPrompt GetNumber = randomRIO (1, 100)<br>> gameIOPrompt (Print s) = putStr s<br>> gameIOPrompt Guess = fmap read getLine</div>
<div> </div>
<div>If you wanted to add undo, all you have to do is save off the current Prompt in the middle of runPromptM; you can return to the old state at any time.</div>
<div> </div>
<div>> gameIO :: IO ()<br>> gameIO = do<br>> hSetBuffering stdout NoBuffering<br>> runGame gameIOPrompt</div>
<div> </div>
<div>Here's a scripted version.</div>
<div> </div>
<div>> 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]
</div>
<div> </div>
<div>gameScript is True if the game ran to completion successfully, and False or bottom otherwise.<br>Try adding or removing numbers from scriptGuesses above and re-running the program.</div>
<div> </div>
<div>> gameScript :: Bool<br>> gameScript = null $ execState (runGame (scriptPrompt scriptTarget)) scriptGuesses</div>
<div> </div>
<div>> main = do<br>> assert gameScript $ return ()<br>> gameIO<br> </div>