[Haskell-cafe] Re: Fwd: Re: Simple game: a monad for each player

[Limestraël]

Ok, but there is no function such as mapMonad in the operational package?

By the way, I noticed that ProgramT is not automatically made instance of
MonadIO when possible. It could be:
instance (MonadIO m) => MonadIO (ProgramT r m) where
    liftIO = lift . liftIO

Is that intentional?
( In fact, I think it's a slip in the mtl package itself, since every
instance of MonadTrans can be declared instance of MonadIO:
instance (MonadTrans t, MonadIO m) => MonadIO (t m) where
    liftIO = lift . liftIO
)

By the way, I finally managed to use operational to modify my TicTacToe
game.
(One shot, by the way, I had no bugs ^^. Very nice when it happens...)
Human player and AI are working. I'm currently fixing the Network player.
If you are interested, I could upload my code (it can be another example of
how to use the operational package).

In the end, I used a mix of your solution and my former one.
I have a Request datatype:
data Request a where
  GetGrid   :: Request Grid
  TurnDone  :: (Grid, Maybe GridResult) -> Request ()
  GetResult :: Request (Maybe GridResult)

(Grid is what you called Board, GridResult is a type which indicates if
someone wins or if there is a draw)

The game monad is PlayerMonadT, and is a newtype:

newtype PlayerMonadT m a = PMT (ProgramT Request m a)
  deriving (Functor, Monad, MonadTrans)

I still have a datatype Player, which contains functions: (I tried to use
classes, but it was more complicated)

data Player m m' = Player {
  -- | Gets the mark (Cross or Circle) of the player
  plMark      :: Mark,
  -- | Called when the player must play
  plTurn      :: Grid -> m Pos,
  -- | Called when player tries to play at a forbidden position
  plForbidden :: Pos -> m (),
  -- | Called when game has ended.
  plGameOver  :: GridResult -> m (),
  -- | Used to reach PlayerMonad in the monad stack
  plLift      :: forall a. PlayerMonadT m' a -> m a,
  -- | Used to run the monad stack the player runs in
  plRun       :: forall a. m a -> PlayerMonadT m' a
}

*m* is the monad stack the player runs in. It must be able to run it, by
providing a plRun function.
*m'* is the top monad, which can't be run (IO for human, any monad for AI,
etc.)
The alteration done to this type is the addition of the plLift and plRun
functions. Those are the functions you, Heinrich, and Bertram told me about.

Then, *all* the players play according to this logic:

playerLogic :: (Monad m) => Player m m' -> m ()
playerLogic pl = do
  let toProg = plLift pl . PMT . singleton
  grid <- toProg GetGrid
  pos <- plTurn pl grid
  case checkCell grid (plMark pl) pos of
    Nothing -> do        -- The cell was already filled in
      plForbidden pl pos -- We signal the error
      playerLogic pl     -- We start the turn again
    Just newGridAndResult -> do
                         -- The cell has been successfully marked, so we got
a new grid
      toProg $ TurnDone newGridAndResult
                         -- At this point, the interpreter will switch to
the other player
      mbResult <- toProg $ GetResult
                         -- This player is back, and wants to know what's
new
      case mbResult of
        Nothing  -> playerLogic pl
        Just res -> plGameOver pl res

We can then run this function with the player custom stack thanks to the
runPlayer function:
runPlayer :: (Monad m) => Player m m' -> PlayerMonadT m' ()
runPlayer pl = plRun pl $ playerLogic pl

And finally, the interpreter:
doGame :: (Monad m) => Grid -> [PlayerMonadT m ()] -> m Grid
doGame initGrid players =
  mapM unwrap players >>= flip evalStateT (initGrid, Nothing) . eval
  where
    unwrap (PMT pl) = viewT pl

    eval :: (Monad m) => [PromptT Request m ()] -> StateT (Grid, Maybe
GridResult) m Grid

    eval [] = liftM fst get

    eval ((Return _) : pls) = eval pls

    eval ((GetGrid :>>= pl) : pls) = do
      (grid, _) <- get
      p <- lift . viewT $ pl grid
      eval $ p : pls

    eval ((TurnDone (newGrid, mbResult) :>>= pl) : pls) = do
      put (newGrid, mbResult)
      p <- lift . viewT $ pl ()
      eval $ pls ++ [p]

    eval ((GetResult :>>= pl) : pls) = do
      (_, mbResult) <- get
      p <- lift . viewT $ pl mbResult
      eval $ p : pls

The game can be launched by doing for example:
let pl1 = humanPlayer Cross
let pl2 = artificialPlayer Circle levelOfDifficulty
doGame blankGrid [runPlayer pl1, runPlayer pl2]

I did it!

2010/4/15 Heinrich Apfelmus <apfelmus at quantentunnel.de>

> Limestraël wrote:
> > Okay, I start to understand better...
> >
> > Just, Heinrich, how would implement the mapMonad function in terms of the
> > operational package?
> > You just shown the signature.
>
> Ah, that has to be implemented by the library, the user cannot implement
> this. Internally, the code would be as Bertram suggests:
>
>    mapMonad :: (Monad m1, Monad m2)
>             => (forall a . m1 a -> m2 a)
>             -> ProgramT instr m1 a -> ProgramT instr m2 a
>    mapMonad f (Lift m1)  = Lift (f m1)
>    mapMonad f (Bind m k) = Bind (mapMonad f m) (mapMonad f . k)
>    mapMonad f (Instr i)  = Instr i
>
> I was musing that every instance of  MonadTrans  should implement this
> function.
>
> Also note that there's a precondition on  f  , namely it has to respect
> the monad laws:
>
>    f (m >>= k) = f m >>= f . k
>    f return    = return
>
> For instance,
>
>    f :: Identity a -> IO a
>    f x = launchMissiles >> return (runIdentity x)
>
> violates this condition.
>
>
> Regards,
> Heinrich Apfelmus
>
> --
> http://apfelmus.nfshost.com
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100415/c3e3ce73/attachment.html