Ok, but there is no function such as mapMonad in the operational package?<br><br>By the way, I noticed that ProgramT is not automatically made instance of MonadIO when possible. It could be:<br>instance (MonadIO m) => MonadIO (ProgramT r m) where<br>
liftIO = lift . liftIO<br><br>Is that intentional?<br>( In fact, I think it's a slip in the mtl package itself, since every instance of MonadTrans can be declared instance of MonadIO:<br>instance (MonadTrans t, MonadIO m) => MonadIO (t m) where<br>
liftIO = lift . liftIO<br>)<br><br>By the way, I finally managed to use operational to modify my TicTacToe game.<br>(One shot, by the way, I had no bugs ^^. Very nice when it happens...)<br>Human player and AI are working. I'm currently fixing the Network player.<br>
If you are interested, I could upload my code (it can be another example of how to use the operational package).<br><br>In the end, I used a mix of your solution and my former one.<br>I have a Request datatype:<br>data Request a where<br>
GetGrid :: Request Grid<br> TurnDone :: (Grid, Maybe GridResult) -> Request ()<br> GetResult :: Request (Maybe GridResult)<br><br>(Grid is what you called Board, GridResult is a type which indicates if someone wins or if there is a draw)<br>
<br>The game monad is PlayerMonadT, and is a newtype:<br><br>newtype PlayerMonadT m a = PMT (ProgramT Request m a)<br> deriving (Functor, Monad, MonadTrans)<br><br>I still have a datatype Player, which contains functions: (I tried to use classes, but it was more complicated)<br>
<br>data Player m m' = Player {<br> -- | Gets the mark (Cross or Circle) of the player<br> plMark :: Mark,<br> -- | Called when the player must play<br> plTurn :: Grid -> m Pos,<br> -- | Called when player tries to play at a forbidden position<br>
plForbidden :: Pos -> m (),<br> -- | Called when game has ended.<br> plGameOver :: GridResult -> m (),<br> -- | Used to reach PlayerMonad in the monad stack<br> plLift :: forall a. PlayerMonadT m' a -> m a,<br>
-- | Used to run the monad stack the player runs in<br> plRun :: forall a. m a -> PlayerMonadT m' a<br>}<br><br><b>m</b> is the monad stack the player runs in. It must be able to run it, by providing a plRun function.<br>
<b>m'</b> is the top monad, which can't be run (IO for human, any monad for AI, etc.)<br>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.<br>
<br>Then, <b>all</b> the players play according to this logic:<br><br>playerLogic :: (Monad m) => Player m m' -> m ()<br>playerLogic pl = do<br> let toProg = plLift pl . PMT . singleton<br> grid <- toProg GetGrid<br>
pos <- plTurn pl grid<br> case checkCell grid (plMark pl) pos of<br> Nothing -> do -- The cell was already filled in<br> plForbidden pl pos -- We signal the error<br> playerLogic pl -- We start the turn again<br>
Just newGridAndResult -> do<br> -- The cell has been successfully marked, so we got a new grid<br> toProg $ TurnDone newGridAndResult<br> -- At this point, the interpreter will switch to the other player<br>
mbResult <- toProg $ GetResult<br> -- This player is back, and wants to know what's new<br> case mbResult of<br> Nothing -> playerLogic pl<br> Just res -> plGameOver pl res<br>
<br>We can then run this function with the player custom stack thanks to the runPlayer function:<br>runPlayer :: (Monad m) => Player m m' -> PlayerMonadT m' ()<br>runPlayer pl = plRun pl $ playerLogic pl<br>
<br>And finally, the interpreter:<br>doGame :: (Monad m) => Grid -> [PlayerMonadT m ()] -> m Grid<br>doGame initGrid players =<br> mapM unwrap players >>= flip evalStateT (initGrid, Nothing) . eval<br> where <br>
unwrap (PMT pl) = viewT pl<br><br> eval :: (Monad m) => [PromptT Request m ()] -> StateT (Grid, Maybe GridResult) m Grid<br><br> eval [] = liftM fst get<br><br> eval ((Return _) : pls) = eval pls<br><br>
eval ((GetGrid :>>= pl) : pls) = do<br> (grid, _) <- get<br> p <- lift . viewT $ pl grid<br> eval $ p : pls<br><br> eval ((TurnDone (newGrid, mbResult) :>>= pl) : pls) = do<br> put (newGrid, mbResult)<br>
p <- lift . viewT $ pl ()<br> eval $ pls ++ [p]<br><br> eval ((GetResult :>>= pl) : pls) = do<br> (_, mbResult) <- get<br> p <- lift . viewT $ pl mbResult<br> eval $ p : pls<br>
<br>The game can be launched by doing for example:<br>let pl1 = humanPlayer Cross<br>let pl2 = artificialPlayer Circle levelOfDifficulty<br>doGame blankGrid [runPlayer pl1, runPlayer pl2]<br><br>I did it!<br><br><div class="gmail_quote">
2010/4/15 Heinrich Apfelmus <span dir="ltr"><<a href="mailto:apfelmus@quantentunnel.de">apfelmus@quantentunnel.de</a>></span><br><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
<div class="im">Limestraël wrote:<br>
> Okay, I start to understand better...<br>
><br>
> Just, Heinrich, how would implement the mapMonad function in terms of the<br>
> operational package?<br>
> You just shown the signature.<br>
<br>
</div>Ah, that has to be implemented by the library, the user cannot implement<br>
this. Internally, the code would be as Bertram suggests:<br>
<br>
mapMonad :: (Monad m1, Monad m2)<br>
=> (forall a . m1 a -> m2 a)<br>
-> ProgramT instr m1 a -> ProgramT instr m2 a<br>
mapMonad f (Lift m1) = Lift (f m1)<br>
mapMonad f (Bind m k) = Bind (mapMonad f m) (mapMonad f . k)<br>
mapMonad f (Instr i) = Instr i<br>
<br>
I was musing that every instance of MonadTrans should implement this<br>
function.<br>
<br>
Also note that there's a precondition on f , namely it has to respect<br>
the monad laws:<br>
<br>
f (m >>= k) = f m >>= f . k<br>
f return = return<br>
<br>
For instance,<br>
<br>
f :: Identity a -> IO a<br>
f x = launchMissiles >> return (runIdentity x)<br>
<br>
violates this condition.<br>
<div class="im"><br>
<br>
Regards,<br>
Heinrich Apfelmus<br>
<br>
--<br>
<a href="http://apfelmus.nfshost.com" target="_blank">http://apfelmus.nfshost.com</a><br>
<br>
_______________________________________________<br>
</div><div><div></div><div class="h5">Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</div></div></blockquote></div><br>