There is the project. I changed some little things with the player datatype. For flexibility sake, it's stack has no longer to contain PlayerMonadT (I needed it for the net player client)
The most interesting part (the one that deals with operational) is in
TicTacToe/Game.hs
This is not very, very clean (incomplete doc, for instance), but it'll do
the work.
By the way, the game.hs and client.hs are to be modified (it's the only way
to change the type of the players in the game)
2010/4/15 Limestraël <limestr...@gmail.com>
> 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 <apfel...@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@haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
>
operational-tictactoe-1.0.tar.gz
Description: GNU Zip compressed data
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
