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

29 Dec 2007


      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  wrote:
...
I posted the current version of this code at
http://ryani.freeshell.org/haskell/
...
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 :
...
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
On 12/28/07, Thomas Hartman  wrote:
the
...
...
program.
...
gameScript :: Bool
gameScript = null $ execState (runGame (scriptPrompt scriptTarget))
scriptGuesses
...
main = do
   assert gameScript $ return ()
   gameIO
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

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

Steve Lihn