An interesting monad: "Prompt"

[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@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[Heinrich Apfelmus]

Ryan Ingram wrote:

> 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:
>
> 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:
>
>> 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.
> [...]
>> 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
>
> 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

Marvelous!

Basically, by making the continuation (a -> Prompt p result) explicit,
we have the flexibility to acquire the value  a  differently, like
through user input or a replay script. The popular continuations for
implementing web applications in Lisp/Scheme do the same thing.

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

   choosePiece   :: Player -> Game Piece
   chooseAttack  :: Player -> Piece -> Game Attack

By using constructors for them, you have the flexibility to write
different interpreters for  Game a , like

   play   :: Game a -> IO a
   replay :: Game a -> GameScript -> a

with the semantics

   play (choosePiece pl >>= f) = do
      putStrLn "Player " ++ show pl ++ ", choose your piece:"
      play f . read =<< getLine

   replay (choosePiece pl >>= f) (Piece pl' piece:xs)
      | pl == pl' = replay (f piece) xs

Just for the record, the most general term implementation is presented here

   Chuan-kai Lin. Programming Monads Operationally with Unimo.
   http://web.cecs.pdx.edu/~cklin/papers/unimo-143.pdf


Btw, the web framework WASH/CGI for Haskell uses some kind of prompt
monad, too.

   Peter Thiemann. An Embedded Domain-Specific Language for
   Type-Safe Server-Side Web-Scripting.
   http://www.informatik.uni-freiburg.de/~thiemann/WASH/draft.pdf

Here, the server replays parts of the CGI monad when the user submits a
form i.e. answers to a prompt.


Regards,
apfelmus

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

[Ryan Ingram]

On 11/21/07, apfelmus <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.

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.

That said, the generalization to monad transformers and the metaprogramming techniques demonstrated look pretty cool.

   -- ryan

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

[Heinrich Apfelmus]

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

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

[Ryan Ingram]

On 11/22/07, apfelmus <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

 

  -- ryan

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

[Derek Elkins]

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

> On 11/22/07, apfelmus <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.


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

[Heinrich Apfelmus]

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. 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.)

(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 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?


Regards,
apfelmus

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

[tphyahoo]

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 <ryani.spam@...>:

> (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@...
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>

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

[tphyahoo]

fwiw, if I comment those two lines around 141 out, it compiles.

t.

2007/11/24, Thomas Hartman <tphyahoo@...>:

> 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 <ryani.spam@...>:
> > (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@...
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> >
>

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

[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

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

[tphyahoo]

that did it, thanks.

2007/11/24, Brent Yorgey <byorgey@...>:

>
>
> >
> > > -- 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
>
>

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

[Derek Elkins]

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.

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

[Ryan Ingram]

Also, I didn't realize this at first, but in order to use any of the MonadTrans instances, like having StateT s (Prompt p) automatically be a MonadPrompt, you sadly also need "-fallow-overlapping-instances".

 

This is because MonadTrans monads looks a lot like Prompt.

 

arbitrary MonadTrans monad:

  t (m :: * -> *) (a :: *)

Prompt:

  Prompt (p :: * -> *) (a :: *)

 

Since you can substitute "Prompt" for t and rename m to p, they look like they match the some of the same types to the compiler.  However, since Prompt won't ever be declared as an instance of MonadTrans, the overlap is safe.

 

The alternative is to declare all the instances you need manually:

 

instance MonadPrompt p (StateT s (Prompt p)) where prompt = lift . prompt

-- etc.

 

  -- ryan
 

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

[Thomas Hartman]

I've been playing with MonadPrompt for about ten days now, trying to get it to do something useful for me.

Specifically, I'm trying to implement "guess a number" since that's the hello world of haskell state programs, or so it seems to me. I want to have this with scripting / replay / undo and the other goodies claimed possible

http://thomashartman-learning.googlecode.com/svn/trunk/haskell/guessANumber

It's been slow going due to still getting to grips with GADTs and other more advanced features of the typing system.

If Ryan (or anyone) would care to share any working code for a simple game that uses MonadPrompt, ideally with scripting / replay / undo that would be extremely helpful.

Otherwise I'll be back with more specific questions about my attempts to use this stuff soon enough :)

(At present, that;'s just trying to get some of the more interesting code you posted as "untested" to compile.)

For what it's worth, my game currently saves high some (but not all) state-y information in a serialized form to track high scores. If I can get this working with MonadPrompt, my next quest will be to use MACID to do the serialization instead, and then *all* state will be saved if I understand correctly.

t.

"Ryan Ingram" <ryani.spam@...>
Sent by: haskell-cafe-bounces@...

11/18/2007 07:22 PM

To	haskell <haskell-cafe@...>
cc
Subject	[Haskell-cafe] An interesting monad: "Prompt"

(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@...
http://www.haskell.org/mailman/listinfo/haskell-cafe


---

This e-mail may contain confidential and/or privileged information. If you
are not the intended recipient (or have received this e-mail in error)
please notify the sender immediately and destroy this e-mail. Any
unauthorized copying, disclosure or distribution of the material in this
e-mail is strictly forbidden.

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

[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@...
http://www.haskell.org/mailman/listinfo/haskell-cafe

[tphyahoo]

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 <ryani.spam@...>:

> 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@...
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>

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

[tphyahoo]

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@...>:

> 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@...
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>

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

[Ryan Ingram]

I posted the current version of this code at

http://ryani.freeshell.org/haskell/

 

On 12/28/07, Thomas Hartman <tphyahoo@...> 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@...>:

> 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@...
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>

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

[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@...> wrote:

> I posted the current version of this code at
> http://ryani.freeshell.org/haskell/
>
>
> On 12/28/07, Thomas Hartman <tphyahoo@...> 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@... >:
> > > 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@...
> > > http://www.haskell.org/mailman/listinfo/haskell-cafe
> > >
> > >
> >
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@...
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>

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

[Ryan Ingram]

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

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