Dear James,<div><br></div><div>This is so cool! It's so natural to express this as a monad transformer. It's great insight and it's just the sort of insight that Haskell and this way of thinking about computation makes possible. Bravo!</div>
<div><br></div><div>Best wishes,</div><div><br></div><div>--greg<br><br><div class="gmail_quote">On Wed, Jul 27, 2011 at 6:33 AM, James Cook <span dir="ltr"><<a href="mailto:mokus@deepbondi.net">mokus@deepbondi.net</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;"><div style="word-wrap:break-word">Dang, I should have played with both versions before sending this. The 'R' instance has a very obvious error:<div class="im">
<div><br></div><div>> return x = R (ConwayT (return (Left x)) mzero)</div><div><br></div></div><div>should be changed to</div><div><br></div><div><div>> return x = R (ConwayT mzero (return (Left x)))</div><div>
<br></div><div>Sorry!</div><div><br></div><font color="#888888"><div>-- James</div></font><div><div></div><div class="h5"><div><br></div><div><div>On Jul 27, 2011, at 9:28 AM, James Cook wrote:</div><br><blockquote type="cite">
<div style="word-wrap:break-word"><div>For any who are interested, here's a quick and dirty Haskell version of the generalized Conway game monad transformer described in the video. It uses two newtypes, "L" and "R", to select from two possible implementations of the Monad class.</div>
<div><br></div><div>(all the LANGUAGE pragmas are just to support a derived Show instance to make it easier to play around with in GHCi - the type and monad itself are H98)</div><div><br></div><div>-- James</div><div><br>
</div><div><br></div><div>> {-# LANGUAGE StandaloneDeriving #-}</div><div>> {-# LANGUAGE FlexibleInstances #-}</div><div>> {-# LANGUAGE UndecidableInstances #-}</div><div>> module Monads.Conway where</div><div>
> </div><div>> import Control.Applicative</div><div>> import Control.Monad</div><div>> </div><div>> data ConwayT m a</div><div>> = ConwayT</div><div>> { runLeftConwayT :: m (Either a (ConwayT m a))</div>
<div>> , runRightConwayT :: m (Either a (ConwayT m a))</div><div>> } </div><div>> </div><div>> deriving instance (Eq a, Eq (m (Either a (ConwayT m a)))) => Eq (ConwayT m a)</div><div>> deriving instance (Ord a, Ord (m (Either a (ConwayT m a)))) => Ord (ConwayT m a)</div>
<div>> deriving instance (Read a, Read (m (Either a (ConwayT m a)))) => Read (ConwayT m a)</div><div>> deriving instance (Show a, Show (m (Either a (ConwayT m a)))) => Show (ConwayT m a)</div><div>> </div><div>
> instance Functor m => Functor (ConwayT m) where</div><div>> fmap f (ConwayT l r) = ConwayT (fmap g l) (fmap g r)</div><div>> where</div><div>> g (Left x) = Left (f x)</div><div>> g (Right x) = Right (fmap f x)</div>
<div>> </div><div>> bind liftS (ConwayT l r) f = ConwayT</div><div>> (liftS g l)</div><div>> (liftS g r)</div><div>> where</div><div>> g (Left x) = Right (f x)</div><div>> g (Right x) = Right (bind liftS x f)</div>
<div>> </div><div>> newtype L f a = L { runL :: f a } deriving (Eq, Ord, Read, Show)</div><div>> </div><div>> instance Functor m => Functor (L (ConwayT m)) where</div><div>> fmap f (L x) = L (fmap f x)</div>
<div>> </div><div>> instance MonadPlus m => Monad (L (ConwayT m)) where</div><div>> return x = L (ConwayT (return (Left x)) mzero)</div><div>> L x >>= f = L (bind liftM x (runL . f))</div><div>
> </div><div>> newtype R f a = R { runR :: f a } deriving (Eq, Ord, Read, Show)</div><div>> </div><div>> instance Functor m => Functor (R (ConwayT m)) where</div><div>> fmap f (R x) = R (fmap f x)</div>
<div>> </div><div>> instance MonadPlus m => Monad (R (ConwayT m)) where</div><div>> return x = R (ConwayT (return (Left x)) mzero)</div><div>> R x >>= f = R (bind liftM x (runR . f))</div><div>
<br></div><div><br></div><div><br></div><div><br></div><div><div>On Jul 27, 2011, at 4:31 AM, Greg Meredith wrote:</div><br><blockquote type="cite"><div class="gmail_quote">Dear Haskellians,<div><br></div><div>A new C9 video in the series!</div>
<div><br></div><div>So, you folks already know most of this... except for maybe the generalization of the Conway construction!</div>
<div><br></div><div>Best wishes,</div><div><br></div><div>--greg<br><br><div class="gmail_quote">---------- Forwarded message ----------<br>From: <b class="gmail_sendername">Charles Torre</b> <span dir="ltr"><...></span><br>
Date: Tue, Jul 26, 2011 at 1:12 PM<br>Subject: C9 video in the Monadic Design Patterns for the Web series<br>To: Meredith Gregory <<a href="mailto:lgreg.meredith@gmail.com" target="_blank">lgreg.meredith@gmail.com</a>><br>
Cc: Brian Beckman <...><br>
<br><br>
<div lang="EN-US" link="blue" vlink="purple">
<div><p class="MsoNormal"><span style="font-size:11.0pt;color:#1F497D">And we’re live!<u></u><u></u></span></p><p class="MsoNormal"><span style="font-size:11.0pt;color:#1F497D"><u></u> <u></u></span></p><p class="MsoNormal">
<span style="font-size:11.0pt;color:#1F497D"><a href="http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-Design-Patterns-for-the-Web-4-of-n" target="_blank">http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-Design-Patterns-for-the-Web-4-of-n</a><u></u><u></u></span></p>
<p class="MsoNormal"><span style="font-size:11.0pt;color:#1F497D">C<u></u><u></u></span></p><p class="MsoNormal"><span style="font-size:11.0pt;color:#1F497D"><u></u> <u></u></span></p>
<div>
<div style="border:none;border-top:solid #B5C4DF 1.0pt;padding:3.0pt 0in 0in 0in"><p class="MsoNormal"><b><span style="font-size:10.0pt">From:</span></b><span style="font-size:10.0pt"> Charles Torre
<br>
<b>Sent:</b> Tuesday, July 26, 2011 11:51 AM<br>
<b>To:</b> 'Meredith Gregory'<br>
<b>Cc:</b> Brian Beckman<br>
<b>Subject:</b> C9 video in the Monadic Design Patterns for the Web series<u></u><u></u></span></p>
</div>
</div><div><p class="MsoNormal"><u></u> <u></u></p><p class="MsoNormal"><span style="font-size:11.0pt;color:#1F497D">Here it ‘tis:<u></u><u></u></span></p><p class="MsoNormal"><span style="font-size:11.0pt;color:#1F497D"><u></u> <u></u></span></p>
<p><span style="font-size:9.5pt;color:#333333"><a href="http://biosimilarity.blogspot.com/" target="_blank">Greg Meredith</a>, a mathematician and computer scientist, has graciously agreed to do a C9 lecture series covering
monadic design principles applied to web development. You've met Greg before in a
<a href="http://channel9.msdn.com/shows/Going+Deep/E2E-Whiteboard-Jam-Session-with-Brian-Beckman-Greg-Meredith-Monads-and-Coordinate-Systems/" target="_blank">
Whiteboard jam session with Brian Beckman</a>.<u></u><u></u></span></p><p><span style="font-size:9.5pt;color:#333333">The fundamental concept here is the monad, and Greg has a novel and conceptually simplified explanation of what a monad is and why it matters. This is a very important and required
first step in the series since the whole of it is about the application of monadic composition to real world web development.<u></u><u></u></span></p><p><span style="font-size:9.5pt;color:#333333">In
<strong><span>part 4, </span></strong>Greg primarily focuses on the idea that
<em><span>a monad is really an API</span></em> -- it's a view onto the organization of data and control structures, not those structures themselves. In OO terms, it's an
<em><span>interface</span></em>. To make this point concrete Greg explores one of the simplest possible data structures that supports at least two different, yet consistent interpretations of the same API. The structure
used, <a href="http://mathworld.wolfram.com/ConwayGame.html" target="_blank">Conway's partisan games</a>, turned out to be tailor-made for this investigation. Not only does this data structure have the requisite container-like shape, it provided opportunities
to see just what's necessary in a container to implement the monadic interface. <u></u>
<u></u></span></p><p><span style="font-size:9.5pt;color:#333333">Running throughout the presentation is a more general comparison of reuse between an OO approach versus a more functional one. When the monadic API is "mixed into" the implementing
structure we get less reuse than when the implementing structure is passed as a type parameter. Finally, doing the work put us in a unique position to see not just how to generalize Conway's construction,
<em><span>monadically</span></em>, but the underlying pattern which allows the generalization to suggest itself.<u></u><u></u></span></p><p><span style="font-size:9.5pt;color:#333333">See
<strong><span><a href="http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-Design-Patterns-for-the-Web-Introduction-to-Monads" target="_blank">part 1
<br>
</a></span></strong>See <strong><span><a href="http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-Design-Patterns-for-the-Web-2-of-n" target="_blank">part 2</a></span></strong><b><br>
</b>See<strong><span> <a href="http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-Design-Patterns-for-the-Web-3-of-n" target="_blank">
part 3</a></span></strong><u></u><u></u></span></p><p class="MsoNormal"><span style="font-size:11.0pt;color:#1F497D"><u></u> </span></p></div></div></div></div>-- <br>L.G. Meredith<br>Managing Partner<br>Biosimilarity LLC<br>
7329 39th Ave SW<div>Seattle, WA 98136<br><br>
<a href="tel:%2B1%20206.650.3740" value="+12066503740" target="_blank">+1 206.650.3740</a><br><br><a href="http://biosimilarity.blogspot.com/" target="_blank">http://biosimilarity.blogspot.com</a></div><br>
</div>
</div><br><br clear="all"><br>-- <br>L.G. Meredith<br>Managing Partner<br>Biosimilarity LLC<br>1219 NW 83rd St <br>Seattle, WA 98117<br><br><a href="tel:%2B1%20206.650.3740" value="+12066503740" target="_blank">+1 206.650.3740</a><br>
<br><a href="http://biosimilarity.blogspot.com/" target="_blank">http://biosimilarity.blogspot.com</a><br>
_______________________________________________<br>Haskell-Cafe mailing list<br><a href="mailto:Haskell-Cafe@haskell.org" target="_blank">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>
</blockquote></div><br></div>_______________________________________________<br>Haskell-Cafe mailing list<br><a href="mailto:Haskell-Cafe@haskell.org" target="_blank">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>
</blockquote></div><br></div></div></div></div></blockquote></div><br><br clear="all"><br>-- <br>L.G. Meredith<br>Managing Partner<br>Biosimilarity LLC<br>1219 NW 83rd St <br>Seattle, WA 98117<br><br>+1 206.650.3740<br><br>
<a href="http://biosimilarity.blogspot.com" target="_blank">http://biosimilarity.blogspot.com</a><br>
</div>