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

[Thomas Hartman]

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

t.

2007/11/24, Thomas Hartman <tphyahoo at gmail.com>:
> 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
> >
> >
>