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

[Thomas Hartman]

Would you mind posting the code for Prompt used by

import Prompt

I tried using Prompt.lhs from your first post but it appears to be
incompatible with the guessing game program when I got tired of
reading the code and actually tried running it.

best, thomas.



2007/12/4, Ryan Ingram <ryani.spam at gmail.com>:
> 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
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>