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

[Ryan Ingram]

Ask and ye shall receive.  A simple guess-a-number game in MonadPrompt
follows.

But before I get to that, I have some comments:

 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.

I haven't looked at MACID at all; what's that?

> {-# LANGUAGE GADTs, RankNTypes #-}
> module Main where
> import Prompt
> import Control.Monad.State
> import System.Random (randomRIO)
> import System.IO
> import Control.Exception (assert)

Minimalist "functional references" implementation.
In particular, for this example, we skip the really interesting thing:
composability.

See http://luqui.org/blog/archives/2007/08/05/ for a real implementation.

> data FRef s a = FRef
>   { frGet :: s -> a
>   , frSet :: a -> s -> s
>   }

> fetch :: MonadState s m => FRef s a -> m a
> fetch ref = get >>= return . frGet ref

> infix 1 =:
> infix 1 =<<:
> (=:) :: MonadState s m => FRef s a -> a -> m ()
> ref =: val = modify $ frSet ref val
> (=<<:) :: MonadState s m => FRef s a -> m a -> m ()
> ref =<<: act = act >>= modify . frSet ref
> update :: MonadState s m => FRef s a -> (a -> a) -> m ()
> update ref f = fetch ref >>= \a -> ref =: f a

Interactions that a user can have with the game:

> data GuessP a where
>    GetNumber :: GuessP Int
>    Guess :: GuessP Int
>    Print :: String -> GuessP ()

Game state.

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.

> data GuessS = GuessS
>   { gsNumGuesses_ :: Int
>   , gsTargetNumber_ :: Int
>   }

> -- a real implementation wouldn't do it this way :)
> initialGameState :: GuessS
> initialGameState = GuessS undefined undefined

> gsNumGuesses, gsTargetNumber :: FRef GuessS Int
> gsNumGuesses   = FRef gsNumGuesses_   $ \a s -> s { gsNumGuesses_   = a }
> gsTargetNumber = FRef gsTargetNumber_ $ \a s -> s { gsTargetNumber_ = a }

Game monad with some useful helper functions

> type Game = StateT GuessS (Prompt GuessP)

> gPrint :: String -> Game ()
> gPrint = prompt . Print

> gPrintLn :: String -> Game ()
> gPrintLn s = gPrint (s ++ "\n")

Implementation of the game:

> gameLoop :: Game Int
> gameLoop = do
>    update gsNumGuesses (+1)
>    guessNum <- fetch gsNumGuesses
>    gPrint ("Guess #" ++ show guessNum ++ ":")
>    guess <- prompt Guess
>    answer <- fetch gsTargetNumber
>
>    if guess == answer
>      then do
>        gPrintLn "Right!"
>        return guessNum
>      else do
>        gPrintLn $ concat
>            [ "You guessed too "
>            , if guess < answer then "low" else "high"
>            , "! Try again."
>            ]
>        gameLoop

> game :: Game ()
> game = do
>    gsNumGuesses =: 0
>    gsTargetNumber =<<: prompt GetNumber
>    gPrintLn "I'm thinking of a number.  Try to guess it!"
>    numGuesses <- gameLoop
>    gPrintLn ("It took you " ++ show numGuesses ++ " guesses!")

Simple unwrapper for StateT that launches the game.

> runGame :: Monad m => (forall a. GuessP a -> m a) -> m ()
> runGame f = runPromptM f (evalStateT game initialGameState)

Here is the magic function for interacting with the player in IO.  Exercise
for the reader: make this more robust.

> gameIOPrompt :: GuessP a -> IO a
> gameIOPrompt GetNumber = randomRIO (1, 100)
> gameIOPrompt (Print s) = putStr s
> gameIOPrompt Guess     = fmap read getLine

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.

> gameIO :: IO ()
> gameIO = do
>     hSetBuffering stdout NoBuffering
>     runGame gameIOPrompt

Here's a scripted version.

> type GameScript = State [Int]
>
> scriptPrompt :: Int -> GuessP a -> GameScript a
> scriptPrompt n GetNumber = return n
> scriptPrompt _ (Print _) = return ()
> scriptPrompt _ Guess     = do
>     (x:xs) <- get -- fails if script runs out of answers
>     put xs
>     return x
>
> scriptTarget :: Int
> scriptTarget = 23
> scriptGuesses :: [Int]
> scriptGuesses = [50, 25, 12, 19, 22, 24, 23]

gameScript is True if the game ran to completion successfully, and False or
bottom otherwise.
Try adding or removing numbers from scriptGuesses above and re-running the
program.

> gameScript :: Bool
> gameScript = null $ execState (runGame (scriptPrompt scriptTarget))
scriptGuesses

> main = do
>    assert gameScript $ return ()
>    gameIO
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20071204/72f1a90e/attachment.htm