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

[Steve Lihn]

Ryan,
I get "cannot parse LANGUAGE pragma" on GHC 6.6.1. Does the code require 6.8 ?
Thanks,
Steve

On Dec 29, 2007 6:09 PM, Ryan Ingram <ryani.spam at gmail.com> wrote:
> 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
> > >
> > >
> >
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>