Ryan Ingram wrote:

apfelmus wrote:

...

A slightly different point of view is that you use a term implementation for your monad, at least for the interesting primitive effects

That's a really interesting point of view, which had struck me slightly, but putting it quite clearly like that definitely helps me understand what is going on.

In fact, it seems like I can implement the original "list" and "state" examples from the Unimo paper in terms of Prompt as well, using a specialized observation function. For example:

data StateP s a where Get :: StateP s s Put :: s -> StateP s ()

runStateP :: Prompt (StateP s) a -> s -> (a,s) runStateP (PromptDone a) s = (a,s) runStateP (Prompt Get k) s = runStateP (k s) s runStateP (Prompt (Put s) k) _ = runStateP (k ()) s

instance MonadState s (Prompt (StatePrompt s)) where get = prompt Get put = prompt . Put

Strangely, this makes me less happy about Prompt rather than more; if it's capable of representing any reasonable computation, it means it's not really the "targeted silver bullet" I was hoping for. On the other hand, it still seems useful for what I am doing.

It appears that your prompt data type is basically Unimo with Bind and Effect fused, i.e. data Prompt p a where Return :: a -> Prompt p a BindEffect :: p b -> (b -> Prompt p a) -> Prompt p a I think that an explicit Bind isn't needed at all, the whole Unimo "framework" can be recast in terms of this type. This simplifies it considerably: the helper function observe_monad can be dropped and observation functions like run_list or run_state can be implemented by directly pattern matching on Prompt. ( unit_op and bind_op are nothing else than the two cases of this match) (The other minor difference is that effects p does not explicitly contain monadic actions, but it's easy to introduce the recursion afterwards: data EffectPlus a where Mplus :: Prompt EffectPlus a -> Prompt EffectPlus a -> EffectPlus a Mzero :: EffectPlus a In Unimo, the effect can be parametrized on the monad, whereas it's fixed here. But this is straightforward to rectify.)

I definitely feel like the full term implementation (like the Unimo paper describes) is overkill; unless I'm misunderstanding what's going on there, you're basically destroying any ability for the compiler to reason about your computations by reifying them into data. As long as (>>=) and return are functions that get inlined, lots of extraneous computation can be eliminated as the compiler "discovers" the monad laws through compile-time beta-reduction; once you turn them into data constructors that ability basically goes away.

I don't know what the compiler does, so I wouldn't recommend unlimited enthusiasm :) But there's an efficiency issue with your implementation that the full term implementation doesn't have (contrary to what I believed in a previous post about the state moand): just like with lists and ++, using

...

= left-recursively runs in quadratic instead of linear time. Here's a demonstration:

data Effect a = Foo a -- example effect Bef m := BindEffect Foo -- shorthand for the lengthy constructor x = BindEffect Foo Return -- just the example effect = z Return m >> n = m >>= \_ -> n -- we use >> for simplicity Now, consider evaluation to WHNF: (x >> x) => Bef f >> x -- reduce x to WHNF => Bef f (\b -> f b >> x) -- definition of >> (x >> x) >> x => .. => (Bef f (\b -> f b >> x)) >> x -- reduce (x >> x) => Bef f (\b -> (\b2 -> f b2 >> x) b >> x) = Bef f (\b -> (f b >> x) >> x) -- shorthand We see that in the general case, the evaluation of (..(((x >> x) >> x) >> x) ... ) = foldl1 (>>) (replicate n x) will produce the expression Bef f (\b -> (..(((f b >> x) >> x) >> x)..)) in O(n) time. The problem is that this contains another left-recursive chain of (>>) which will take O(n-1) time to evaluate and produce another such chain when the monad is executed. Thus, the whole thing will run in O(n^2). A context passing implementation (yielding the ContT monad transformer) will remedy this. See also John Hughes. The Design of a Pretty-printing Library. http://citeseer.ist.psu.edu/hughes95design.html Regards, apfelmus

On Fri, 2007-11-23 at 21:11 -0800, Ryan Ingram wrote:

On 11/22/07, apfelmus wrote: A context passing implementation (yielding the ContT monad transformer) will remedy this.

Wait, are you saying that if you apply ContT to any monad that has the "left recursion on >>= takes quadratic time" problem, and represent all primitive operations via lift (never using >>= within "lift"), that you will get a new monad that doesn't have that problem?

If so, that's pretty cool.

To be clear, by ContT I mean this monad: newtype ContT m a = ContT { runContT :: forall b. (a -> m b) -> m b }

instance Monad m => Monad (ContT m) where return x = ContT $ \c -> c x m >>= f = ContT $ \c -> runContT m $ \a -> runContT (f a) c fail = lift . fail

instance MonadTrans ContT where lift m = ContT $ \c -> m >>= c

evalContT :: Monad m => ContT m a -> m a evalContT m = runContT m return

Indeed this was discussed on #haskell a few weeks ago. That information has been put on the wiki at http://www.haskell.org/haskellwiki/Performance/Monads and refers to a blog post http://r6.ca/blog/20071028T162529Z.html that describes it in action. I'm fairly confident, though I'd have to actually work through it, that the Unimo work, http://web.cecs.pdx.edu/~cklin/ could benefit from this. In fact, I think this does much of what Unimo does and could capture many of the same things.

On Sat, 2007-11-24 at 11:10 +0100, apfelmus wrote:

Derek Elkins wrote:

...

Ryan Ingram wrote:

...

apfelmus wrote: A context passing implementation (yielding the ContT monad transformer) will remedy this.

Wait, are you saying that if you apply ContT to any monad that has the "left recursion on >>= takes quadratic time" problem, and represent all primitive operations via lift (never using >>= within "lift"), that you will get a new monad that doesn't have that problem?

If so, that's pretty cool.

To be clear, by ContT I mean this monad: newtype ContT m a = ContT { runContT :: forall b. (a -> m b) -> m b }

instance Monad m => Monad (ContT m) where return x = ContT $ \c -> c x m >>= f = ContT $ \c -> runContT m $ \a -> runContT (f a) c fail = lift . fail

instance MonadTrans ContT where lift m = ContT $ \c -> m >>= c

evalContT :: Monad m => ContT m a -> m a evalContT m = runContT m return

Yes, that's the case because the only way to use >>= from the old monad is via lift. Since only primitive operations are being lifted into the left of >>=, it's only nested in a right-associative fashion. The remaining thing to prove is that ContT itself doesn't have the left-associativity problem or any other similar problem. It's pretty intuitive, but unfortunately, I currently don't know how to prove or even specify that exactly. The problem is that expressions with >>= contain arbitrary unapplied lambda abstractions and mixed types but the types shouldn't be much a minor problem.

...

Indeed this was discussed on #haskell a few weeks ago. That information has been put on the wiki at http://www.haskell.org/haskellwiki/Performance/Monads and refers to a blog post http://r6.ca/blog/20071028T162529Z.html that describes it in action.

Note that the crux of the Maybe example on the wiki page is not curing a left-associativity problem, Maybe doesn't have one.

I agree, hence the fact that that is massively understated. However, while Maybe may not have a problem on the same order, there is definitely a potential inefficiency. (Nothing >>= f) >>= g expands to case (case Nothing of Nothing -> Nothing; Just x -> f x) of Nothing -> Nothing Just y -> g y This tests that original Nothing twice. This can be arbitrarily deep. The right associative version would expand to case Nothing of Nothing -> Nothing Just x -> f x >>= g

The key point here is that continuation passing style allows us to inline the liftings

(Just x >>=) = \f -> f x (Nothing >>=) = \_ -> Nothing

and thus eliminate lots of case analysis. (Btw, this is exactly the behavior of exceptions in an imperative language.)

Indeed, avoiding case analyses and achieving "exactly the behaviour of exceptions" was the motivation.

(Concerning the blog post, it looks like this inlining brings speed. But Data.Sequence is not to be underestimated, it may well be responsible for the meat of the speedup.)

I'm not quite sure what all is being compared to what, but Russell O'Connor did say that using continuations passing style did lead to a significant percentage speed up.

...

I'm fairly confident, though I'd have to actually work through it, that the Unimo work, http://web.cecs.pdx.edu/~cklin/ could benefit from this. In fact, I think this does much of what Unimo does and could capture many of the same things.

Well, Unimo doesn't have the left-associativity problem in the first place, so the "only" motive for using ContT Prompt instead is to eliminate the Bind constructor and implied case analyses.

But there's a slight yet important difference between Unimo p a and Unimo' p a = ContT (Prompt p) a , namely the ability the run the continuation in the "outer" monad. Let me explain: in the original Unimo, we have a helper function

observe_monad :: (a -> v) -> (forall b . p (Unimo p) b -> (b -> Unimo p a) -> v) -> (Unimo p a -> v)

for running a monad. For simplicity and to match with Ryan's prompt, we'll drop the fact that p can be parametrized on the "outer" monad, i.e. we consider

observe_monad :: (a -> v) -> (forall b . p b -> (b -> Unimo p a) -> v) -> (Unimo p a -> v)

This is just the case expression for the data type

data PromptU p a where Return :: a -> PromptU p a BindEffect :: p b -> (b -> Unimo p a) -> PromptU p a

observe_monad :: (PromptU p a -> v) -> (Unimo p a -> v)

The difference I'm after is that the second argument to BindEffect is free to return an Unimo and not only another PromptU! This is quite handy for writing monads.

In contrast, things for Unimo' p a = ContT (Prompt p) a are as follows:

data Prompt p a where Return :: a -> Prompt p a BindEffect :: p b -> (b -> Prompt p a) -> Prompt p a

observe :: (Prompt p a -> v) -> (Unimo' p a -> v) observe f m = f (runCont m Return)

Here, we don't have access to the "outer" monad Unimo' p a when defining an argument f to observe. I don't think we can fix that by allowing the second argument of BindEffect to return an Unimo' p a since in this case,

lift :: p a -> Unimo' p a lift x = Cont $ BindEffect x

won't work anymore.

Of course, the question now is whether this can be fixed. Put differently, this is the question I keep asking: does it allow Unimo to implement strictly more monads than ContT = Unimo' or is the latter enough? I.e. can every monad be implemented with ContT?

As I said, I need to work through this stuff first.

fwiw, if I comment those two lines around 141 out, it compiles. t. 2007/11/24, Thomas Hartman :

Looks very cool. So I tried playing with this code, unfortunately couldn't get it to compile.

Could you double check that what you posted compiles, and if it does, any idea what I'm doing wrong?

This is with

...

{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}

thanks, t.

Prelude> :r [1 of 1] Compiling Prompt ( prompt.lhs, interpreted )

prompt.lhs:140:1: Could not deduce (Monad tm) from the context (Monad (t m), MonadTrans t, MonadPrompt p m) arising from the superclasses of an instance declaration at prompt.lhs:140:1 Possible fix: add (Monad tm) to the instance declaration superclass context In the instance declaration for `MonadPrompt p tm'

prompt.lhs:141:13: Couldn't match expected type `tm' (a rigid variable) against inferred type `t1 m1' `tm' is bound by the instance declaration at prompt.lhs:140:1 Expected type: p a -> tm a Inferred type: p a -> t1 m1 a In the expression: lift . prompt In the definition of `prompt': prompt = lift . prompt Failed, modules loaded: none.

This is around

...

-- Just for fun, make it work with StateT as well -- (needs -fallow-undecidable-instances)

...

instance (Monad (t m), MonadTrans t, MonadPrompt p m) => MonadPrompt p (tm) where prompt = lift . prompt

2007/11/18, Ryan Ingram :

...

(This message is a literate haskell file. Code for the "Prompt" monad is preceded by ">"; code for my examples is preceded by "]" and isn't complete, but intended for illustration.)

I've been trying to implement a few rules-driven board/card games in Haskell and I always run into the ugly problem of "how do I get user input"?

The usual technique is to embed the game in the IO Monad:

] type Game = IO ] -- or ] type Game = StateT GameState IO

The problem with this approach is that now arbitrary IO computations are expressible as part of a game action, which makes it much harder to implement things like replay, undo, and especially testing!

The goal was to be able to write code like this:

] takeTurn :: Player -> Game () ] takeTurn player = do ] piece <- action (ChoosePiece player) ] attack <- action (ChooseAttack player piece) ] bonusTurn <- executeAttack piece attack ] when bonusTurn $ takeTurn player

but be able to script the code for testing, allow undo, automatically be able to save replays, etc.

While thinking about this problem earlier this week, I came up with the following solution:

...

{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-} -- undecidable instances is only needed for the MonadTrans instance below

module Prompt where import Control.Monad.Trans import Control.Monad.Identity

...

class Monad m => MonadPrompt p m | m -> p where prompt :: p a -> m a

"prompt" is an action that takes a prompt type and gives you a result.

A simple example: ] prompt [1,3,5] :: MonadPrompt [] m => m Int

This prompt would ask for someone to pick a value from the list and return it. This would be somewhat useful on its own; you could implement a "choose" function that picked randomly from a list of options and gave non-deterministic (or even exhaustive) testing, but on its own this wouldn't be much better than the list monad.

What really made this click for me was that the prompt type could be built on a GADT:

] newtype GamePrompt a = GP (GameState, GameChoice a) ] data GameChoice a where ] -- pick a piece to act with ] ChoosePiece :: Player -> GameChoice GamePiece ] -- pick how they should attack ] ChooseAttack :: Player -> GamePiece -> GameChoice AttackType ] -- etc.

Now you can use this type information as part of a "handler" function: ] gameIO :: GamePrompt a -> IO a ] gameIO (GP (state, ChoosePiece player)) = getPiece state player ] gameIO (GP (state, ChooseAttack player piece)) = attackMenu player piece ] -- ...

The neat thing here is that the GADT specializes the type of "IO a" on the right hand side. So, "getPiece state player" has the type "IO GamePiece", not the general "IO a". So the GADT is serving as a witness of the type of response wanted by the game.

Another neat things is that, you don't need to embed this in the IO monad at all; you could instead run a pure computation to do AI, or even use it for unit testing!

...

-- unit testing example data ScriptElem p where SE :: p a -> a -> ScriptElem p type Script p = [ScriptElem p]

infix 1 --> (-->) = SE

] gameScript :: ScriptElem GameChoice -> GameChoice a -> Maybe a ] gameScript (SE (ChoosePiece _) piece) (ChoosePiece _) = Just piece ] gameScript (SE (ChooseAttack _ _) attack) (ChooseAttack _ _) = Just attack ] gameScript _ _ = Nothing ] ] testGame :: Script GameChoice ] testGame = ] [ ChoosePiece P1 --> Knight ] , ChooseAttack P1 Knight --> Charge ] , ChoosePiece P2 --> FootSoldier ] , ... ] ]

So, how to implement all of this?

...

data Prompt (p :: * -> *) :: (* -> *) where PromptDone :: result -> Prompt p result -- a is the type needed to continue the computation Prompt :: p a -> (a -> Prompt p result) -> Prompt p result

This doesn't require GADT's; it's just using existential types, but I like the aesthetics better this way.

Intuitively, a (Prompt p result) either gives you an immediate result (PromptDone), or gives you a prompt which you need to reply to in order to continue the computation.

This type is a MonadPrompt:

...

instance Functor (Prompt p) where fmap f (PromptDone r) = PromptDone (f r) fmap f (Prompt p cont) = Prompt p (fmap f . cont)

instance Monad (Prompt p) where return = PromptDone PromptDone r >>= f = f r Prompt p cont >>= f = Prompt p ((>>= f) . cont)

instance MonadPrompt p (Prompt p) where prompt p = Prompt p return

-- Just for fun, make it work with StateT as well -- (needs -fallow-undecidable-instances) instance (Monad (t m), MonadTrans t, MonadPrompt p m) => MonadPrompt p (t m) where prompt = lift . prompt

The last bit to tie it together is an observation function which allows you to run the game:

...

runPromptM :: Monad m => (forall a. p a -> m a) -> Prompt p r -> m r runPromptM _ (PromptDone r) = return r runPromptM f (Prompt pa c) = f pa >>= runPromptM f . c

runPrompt :: (forall a. p a -> a) -> Prompt p r -> r runPrompt f p = runIdentity $ runPromptM (Identity . f) p

runScript :: (forall a. ScriptElem p -> p a -> Maybe a) -> Script p -> Prompt p r -> Maybe r runScript _ [] (PromptDone r) = Just r runScript s (x:xs) (Prompt pa c) = case s x pa of Nothing -> Nothing Just a -> runScript s xs (c a) runScript _ _ _ = Nothing -- script & computation out of sync

My original goal is now achievable:

] type Game = StateT GameState (Prompt GamePrompt) ] ] action :: GameChoice a -> Game a ] action p = do ] state <- get ] prompt $ GP (state, p)

] runGameScript :: Script GameChoice -> GameState -> Game a -> Maybe (GameState, a) ] runGameScript script initialState game ] = runScript scriptFn script' (runStateT game initialState) ] where ] script' = map sEmbed script ] scriptFn s (GP (s,p)) = gameScript (sExtract s) p ] sEmbed (SE p a) = SE (GP (undefined, p)) a ] sExtract (SE (GP (_,p)) a) = SE p a

Any comments are welcome! Thanks for reading this far.

-- ryan

_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

that did it, thanks. 2007/11/24, Brent Yorgey :

...

...

-- Just for fun, make it work with StateT as well -- (needs -fallow-undecidable-instances)

...

instance (Monad (t m), MonadTrans t, MonadPrompt p m) => MonadPrompt p

(tm) where

...

...

prompt = lift . prompt

Looks like that should be MonadPrompt p (t m) rather than (tm). Note the space.

-Brent

Thank you! I really appreciate your explanation, and I hope this will enable me to do some interesting and usefull stuff, in addition to firming up my understanding of some of the more advanced haskell type system features. MACID is a sort of RDBMS replacement used as a backend by the HAppS web framework. To quote from http://www.haskell.org/communities/05-2007/html/report.html "Apps as Simple State Transformers HAppS keeps your application development very simple. You represent state with the Haskell data structure you find most natural for that purpose. Your app then is just a set of state transformer functions (in the MACID Monad) that take an event and state as input and that evaluate to a new state, a response, and a (possibly null) set of sideeffects." It sounds great, but in practice it is not that simple to use, largely because HAppS is in such a state of flux right now that even installing the current codebase is pretty daunting. However, I think a simple example of using MACID to "guess a number" would be a great piece of documentation, and it might even be a step towards using HAppS/MACID to easily do things other than serve web apps. (HAppS is meant to be a general application serving framework, but all the docu is oriented towards serving web pages, and even that documentation is pretty shaky.) What I ultimately would like to do is adapt this guess a number stuff to HAppS/MACID so it is an example server for a multi-user console app with this cool undo/replay/logging functionality which can then be plugged into more sophisticated uses. Porting the console app to a web app would be a further step. Hopefully, since all the state stuff has been so meticulously compartmentalized it's easy and obvious how to do this, just a matter of changing the IO to be outputting html rather than console text. That is the HAppS tutorial I would like to see. 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 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

I posted the current version of this code at http://ryani.freeshell.org/haskell/ On 12/28/07, Thomas Hartman 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.

...

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

2007/12/4, Ryan Ingram : 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

Currently, yes; I was experimenting with type families. But it's pretty simple to get it to compile on 6.6.1: - remove the {-# LANGUAGE #-} pragma and replace with {-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-} - change the class declaration for MonadPrompter from

class Monad m => MonadPrompter m where type PromptType m :: * -> * prompt :: PromptType m a -> m a

to

class Monad m => MonadPrompter p m | m -> p where prompt :: p a -> m a

- change all the instance declarations from something like this:

instance MonadPrompter (XXX) where type PromptType (XXX) = YYY prompt = ...

to something like this:

instance MonadPrompter YYY (XXX) where prompt = ...

& you're done. -- ryan

Felipe Lessa wrote:

Ryan Ingram wrote: [snip]

...

...

data Prompt (p :: * -> *) :: (* -> *) where PromptDone :: result -> Prompt p result -- a is the type needed to continue the computation Prompt :: p a -> (a -> Prompt p result) -> Prompt p result [snip] runPromptM :: Monad m => (forall a. p a -> m a) -> Prompt p r -> m r runPromptM _ (PromptDone r) = return r runPromptM f (Prompt pa c) = f pa >>= runPromptM f . c [snip]

How can we prove that (runPromptM prompt === id)? I was trying to go with

You probably mean runPromptM id = id

runPromptM prompt (PromptDone r) = return r = PromptDone r

runPromptM prompt (Prompt pa c) = prompt pa >>= runPromptM prompt . c = Prompt pa return >>= runPromptM prompt . c = Prompt pa ((>>= (runPromptM prompt . c) . return) = Prompt pa (runPromptM prompt . c)

.... and I got stuck here. It "seems obvious" that we can strip out the 'runPromptM prompt' down there to finish the proof, but that doesn't sound very nice, as I'd need to suppose what I'm trying to prove. Am I missing something here?

You want to deduce runPromptM id (Prompt pa c) = Prompt pa c from runPromptM id (Prompt pa c) = Prompt pa (runPromptM id . c) by somehow assuming that runPromptM id = id at least when applied to c . If it were a problem about lists like foldr (:) [] = id you could use mathematical induction . You can do the same here, but you need to use coinduction. For more, see also http://www.cs.nott.ac.uk/~gmh/bib.html#corecursion Regards, apfelmus