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

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