Fwd: C9 video in the Monadic Design Patterns for the Web series

Dear Haskellians,
A new C9 video in the series!
So, you folks already know most of this... except for maybe the
generalization of the Conway construction!
Best wishes,
--greg
---------- Forwarded message ----------
From: Charles Torre <...>
Date: Tue, Jul 26, 2011 at 1:12 PM
Subject: C9 video in the Monadic Design Patterns for the Web series
To: Meredith Gregory

On 27 July 2011 10:31, Greg Meredith
Dear Haskellians, A new C9 video in the series! So, you folks already know most of this... except for maybe the generalization of the Conway construction! Best wishes, --greg
Thanks for the heads up! I love these videos.

I'm always glad to see videos like this. I wish more people could have that much fun playing with math ;). It wouldn't really be suitable for your application but another interesting generalization is to insert the 'Either' at the top level:
data ConwayT m a = Pure a | ConwayT { runLeftConwayT :: m (ConwayT m a) , runRightConwayT :: m (ConwayT m a) }
Using this construction, the "handedness" of the structure doesn't appear until you start implementing binary operations on games, so there is a unique monad structure instead of just a unique bind/join:
instance Functor m => Monad (ConwayT m) where return = Pure Pure x >>= f = f x ConwayT l r >>= f = ConwayT (fmap (>>= f) l) (fmap (>>= f) r)
but there are then (at least) two versions of every monoid structure. Given that monoidal structures such as addition and multiplication are the main purpose of a calculator it's probably simpler in this case to just give up the 'unit' as you chose to do. On the other hand, if for some reason a monadic structure is the extent of one's interest then this version definitely simplifies that structure. -- James On Jul 27, 2011, at 4:31 AM, Greg Meredith wrote:
Dear Haskellians,
A new C9 video in the series!
So, you folks already know most of this... except for maybe the generalization of the Conway construction!
Best wishes,
--greg
---------- Forwarded message ---------- From: Charles Torre <...> Date: Tue, Jul 26, 2011 at 1:12 PM Subject: C9 video in the Monadic Design Patterns for the Web series To: Meredith Gregory
Cc: Brian Beckman <...> And we’re live!
http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-...
C
From: Charles Torre Sent: Tuesday, July 26, 2011 11:51 AM To: 'Meredith Gregory' Cc: Brian Beckman Subject: C9 video in the Monadic Design Patterns for the Web series
Here it ‘tis:
Greg Meredith, 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 Whiteboard jam session with Brian Beckman.
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.
In part 4, Greg primarily focuses on the idea that a monad is really an API -- it's a view onto the organization of data and control structures, not those structures themselves. In OO terms, it's an interface. 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, Conway's partisan games, 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.
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, monadically, but the underlying pattern which allows the generalization to suggest itself.
See part 1 See part 2 See part 3
-- L.G. Meredith Managing Partner Biosimilarity LLC 7329 39th Ave SW Seattle, WA 98136
+1 206.650.3740
http://biosimilarity.blogspot.com
-- L.G. Meredith Managing Partner Biosimilarity LLC 1219 NW 83rd St Seattle, WA 98117
+1 206.650.3740
http://biosimilarity.blogspot.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

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. (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) -- James
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Monads.Conway where
import Control.Applicative import Control.Monad
data ConwayT m a = ConwayT { runLeftConwayT :: m (Either a (ConwayT m a)) , runRightConwayT :: m (Either a (ConwayT m a)) }
deriving instance (Eq a, Eq (m (Either a (ConwayT m a)))) => Eq (ConwayT m a) deriving instance (Ord a, Ord (m (Either a (ConwayT m a)))) => Ord (ConwayT m a) deriving instance (Read a, Read (m (Either a (ConwayT m a)))) => Read (ConwayT m a) deriving instance (Show a, Show (m (Either a (ConwayT m a)))) => Show (ConwayT m a)
instance Functor m => Functor (ConwayT m) where fmap f (ConwayT l r) = ConwayT (fmap g l) (fmap g r) where g (Left x) = Left (f x) g (Right x) = Right (fmap f x)
bind liftS (ConwayT l r) f = ConwayT (liftS g l) (liftS g r) where g (Left x) = Right (f x) g (Right x) = Right (bind liftS x f)
newtype L f a = L { runL :: f a } deriving (Eq, Ord, Read, Show)
instance Functor m => Functor (L (ConwayT m)) where fmap f (L x) = L (fmap f x)
instance MonadPlus m => Monad (L (ConwayT m)) where return x = L (ConwayT (return (Left x)) mzero) L x >>= f = L (bind liftM x (runL . f))
newtype R f a = R { runR :: f a } deriving (Eq, Ord, Read, Show)
instance Functor m => Functor (R (ConwayT m)) where fmap f (R x) = R (fmap f x)
instance MonadPlus m => Monad (R (ConwayT m)) where return x = R (ConwayT (return (Left x)) mzero) R x >>= f = R (bind liftM x (runR . f))
On Jul 27, 2011, at 4:31 AM, Greg Meredith wrote:
Dear Haskellians,
A new C9 video in the series!
So, you folks already know most of this... except for maybe the generalization of the Conway construction!
Best wishes,
--greg
---------- Forwarded message ---------- From: Charles Torre <...> Date: Tue, Jul 26, 2011 at 1:12 PM Subject: C9 video in the Monadic Design Patterns for the Web series To: Meredith Gregory
Cc: Brian Beckman <...> And we’re live!
http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-...
C
From: Charles Torre Sent: Tuesday, July 26, 2011 11:51 AM To: 'Meredith Gregory' Cc: Brian Beckman Subject: C9 video in the Monadic Design Patterns for the Web series
Here it ‘tis:
Greg Meredith, 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 Whiteboard jam session with Brian Beckman.
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.
In part 4, Greg primarily focuses on the idea that a monad is really an API -- it's a view onto the organization of data and control structures, not those structures themselves. In OO terms, it's an interface. 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, Conway's partisan games, 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.
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, monadically, but the underlying pattern which allows the generalization to suggest itself.
See part 1 See part 2 See part 3
-- L.G. Meredith Managing Partner Biosimilarity LLC 7329 39th Ave SW Seattle, WA 98136
+1 206.650.3740
http://biosimilarity.blogspot.com
-- L.G. Meredith Managing Partner Biosimilarity LLC 1219 NW 83rd St Seattle, WA 98117
+1 206.650.3740
http://biosimilarity.blogspot.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Dang, I should have played with both versions before sending this. The 'R' instance has a very obvious error:
return x = R (ConwayT (return (Left x)) mzero)
should be changed to
return x = R (ConwayT mzero (return (Left x)))
Sorry! -- James On Jul 27, 2011, at 9:28 AM, James Cook wrote:
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.
(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)
-- James
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Monads.Conway where
import Control.Applicative import Control.Monad
data ConwayT m a = ConwayT { runLeftConwayT :: m (Either a (ConwayT m a)) , runRightConwayT :: m (Either a (ConwayT m a)) }
deriving instance (Eq a, Eq (m (Either a (ConwayT m a)))) => Eq (ConwayT m a) deriving instance (Ord a, Ord (m (Either a (ConwayT m a)))) => Ord (ConwayT m a) deriving instance (Read a, Read (m (Either a (ConwayT m a)))) => Read (ConwayT m a) deriving instance (Show a, Show (m (Either a (ConwayT m a)))) => Show (ConwayT m a)
instance Functor m => Functor (ConwayT m) where fmap f (ConwayT l r) = ConwayT (fmap g l) (fmap g r) where g (Left x) = Left (f x) g (Right x) = Right (fmap f x)
bind liftS (ConwayT l r) f = ConwayT (liftS g l) (liftS g r) where g (Left x) = Right (f x) g (Right x) = Right (bind liftS x f)
newtype L f a = L { runL :: f a } deriving (Eq, Ord, Read, Show)
instance Functor m => Functor (L (ConwayT m)) where fmap f (L x) = L (fmap f x)
instance MonadPlus m => Monad (L (ConwayT m)) where return x = L (ConwayT (return (Left x)) mzero) L x >>= f = L (bind liftM x (runL . f))
newtype R f a = R { runR :: f a } deriving (Eq, Ord, Read, Show)
instance Functor m => Functor (R (ConwayT m)) where fmap f (R x) = R (fmap f x)
instance MonadPlus m => Monad (R (ConwayT m)) where return x = R (ConwayT (return (Left x)) mzero) R x >>= f = R (bind liftM x (runR . f))
On Jul 27, 2011, at 4:31 AM, Greg Meredith wrote:
Dear Haskellians,
A new C9 video in the series!
So, you folks already know most of this... except for maybe the generalization of the Conway construction!
Best wishes,
--greg
---------- Forwarded message ---------- From: Charles Torre <...> Date: Tue, Jul 26, 2011 at 1:12 PM Subject: C9 video in the Monadic Design Patterns for the Web series To: Meredith Gregory
Cc: Brian Beckman <...> And we’re live!
http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-...
C
From: Charles Torre Sent: Tuesday, July 26, 2011 11:51 AM To: 'Meredith Gregory' Cc: Brian Beckman Subject: C9 video in the Monadic Design Patterns for the Web series
Here it ‘tis:
Greg Meredith, 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 Whiteboard jam session with Brian Beckman.
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.
In part 4, Greg primarily focuses on the idea that a monad is really an API -- it's a view onto the organization of data and control structures, not those structures themselves. In OO terms, it's an interface. 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, Conway's partisan games, 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.
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, monadically, but the underlying pattern which allows the generalization to suggest itself.
See part 1 See part 2 See part 3
-- L.G. Meredith Managing Partner Biosimilarity LLC 7329 39th Ave SW Seattle, WA 98136
+1 206.650.3740
http://biosimilarity.blogspot.com
-- L.G. Meredith Managing Partner Biosimilarity LLC 1219 NW 83rd St Seattle, WA 98117
+1 206.650.3740
http://biosimilarity.blogspot.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Dear James,
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!
Best wishes,
--greg
On Wed, Jul 27, 2011 at 6:33 AM, James Cook
Dang, I should have played with both versions before sending this. The 'R' instance has a very obvious error:
return x = R (ConwayT (return (Left x)) mzero)
should be changed to
return x = R (ConwayT mzero (return (Left x)))
Sorry!
-- James
On Jul 27, 2011, at 9:28 AM, James Cook wrote:
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.
(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)
-- James
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Monads.Conway where
import Control.Applicative import Control.Monad
data ConwayT m a = ConwayT { runLeftConwayT :: m (Either a (ConwayT m a)) , runRightConwayT :: m (Either a (ConwayT m a)) }
deriving instance (Eq a, Eq (m (Either a (ConwayT m a)))) => Eq (ConwayT m a) deriving instance (Ord a, Ord (m (Either a (ConwayT m a)))) => Ord (ConwayT m a) deriving instance (Read a, Read (m (Either a (ConwayT m a)))) => Read (ConwayT m a) deriving instance (Show a, Show (m (Either a (ConwayT m a)))) => Show (ConwayT m a)
instance Functor m => Functor (ConwayT m) where fmap f (ConwayT l r) = ConwayT (fmap g l) (fmap g r) where g (Left x) = Left (f x) g (Right x) = Right (fmap f x)
bind liftS (ConwayT l r) f = ConwayT (liftS g l) (liftS g r) where g (Left x) = Right (f x) g (Right x) = Right (bind liftS x f)
newtype L f a = L { runL :: f a } deriving (Eq, Ord, Read, Show)
instance Functor m => Functor (L (ConwayT m)) where fmap f (L x) = L (fmap f x)
instance MonadPlus m => Monad (L (ConwayT m)) where return x = L (ConwayT (return (Left x)) mzero) L x >>= f = L (bind liftM x (runL . f))
newtype R f a = R { runR :: f a } deriving (Eq, Ord, Read, Show)
instance Functor m => Functor (R (ConwayT m)) where fmap f (R x) = R (fmap f x)
instance MonadPlus m => Monad (R (ConwayT m)) where return x = R (ConwayT (return (Left x)) mzero) R x >>= f = R (bind liftM x (runR . f))
On Jul 27, 2011, at 4:31 AM, Greg Meredith wrote:
Dear Haskellians,
A new C9 video in the series!
So, you folks already know most of this... except for maybe the generalization of the Conway construction!
Best wishes,
--greg
---------- Forwarded message ---------- From: Charles Torre <...> Date: Tue, Jul 26, 2011 at 1:12 PM Subject: C9 video in the Monadic Design Patterns for the Web series To: Meredith Gregory
Cc: Brian Beckman <...> And we’re live!****
** **
http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-... ****
C****
** **
*From:* Charles Torre *Sent:* Tuesday, July 26, 2011 11:51 AM *To:* 'Meredith Gregory' *Cc:* Brian Beckman *Subject:* C9 video in the Monadic Design Patterns for the Web series****
** **
Here it ‘tis:****
** **
Greg Meredith http://biosimilarity.blogspot.com/, 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 Whiteboard jam session with Brian Beckmanhttp://channel9.msdn.com/shows/Going+Deep/E2E-Whiteboard-Jam-Session-with-Br... .****
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.****
In *part 4, *Greg primarily focuses on the idea that *a monad is really an API* -- it's a view onto the organization of data and control structures, not those structures themselves. In OO terms, it's an *interface*. 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, Conway's partisan games http://mathworld.wolfram.com/ConwayGame.html, 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. ** **
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, *monadically*, but the underlying pattern which allows the generalization to suggest itself.****
See *part 1 http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-... *See *part 2http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-... ** *See* part 3http://channel9.msdn.com/Shows/Going+Deep/C9-Lectures-Greg-Meredith-Monadic-... *****
** -- L.G. Meredith Managing Partner Biosimilarity LLC 7329 39th Ave SW Seattle, WA 98136
+1 206.650.3740
http://biosimilarity.blogspot.com
-- L.G. Meredith Managing Partner Biosimilarity LLC 1219 NW 83rd St Seattle, WA 98117
+1 206.650.3740
http://biosimilarity.blogspot.com _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- L.G. Meredith Managing Partner Biosimilarity LLC 1219 NW 83rd St Seattle, WA 98117 +1 206.650.3740 http://biosimilarity.blogspot.com
participants (3)
-
Christopher Done
-
Greg Meredith
-
James Cook