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

[Ryan Ingram]

I posted the current version of this code at
http://ryani.freeshell.org/haskell/

On 12/28/07, Thomas Hartman <tphyahoo at gmail.com> wrote:
>
> 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
> >
> >
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20071229/4f5a2464/attachment.htm