[Haskell-cafe] Parameterisations of Monads

Dan Weston westondan at imageworks.com
Tue Feb 5 15:27:15 EST 2008


Matthew,

Your SuperMonad seems remarkably similar to Gabor Greif's Thrist 
datatype [1,2] reported only six days ago on this list [3].

Can you compare/contrast your class approach with his polymorphic type 
approach? Or have I completely confused the two because of the similar 
kind of their arguments?

     data Thrist :: (* -> * -> *) -> * -> * -> * where
     Nil :: Thrist p a a
     Cons :: p a b -> Thrist p b c -> Thrist p a c

     data Arrow' :: (* -> * -> *) -> * -> * -> * where
     Arr :: Arrow a => a b c -> Arrow' a b c
     First :: Arrow a => Arrow' a b c -> Arrow' a (b, d) (c, d)


[1] http://heisenbug.blogspot.com/2007/11/trendy-topics.html
[2] 
http://heisenbug.blogspot.com/2008/01/embeddings-part-one-arrow-thrist.html
[3] http://thread.gmane.org/gmane.comp.lang.haskell.cafe/35907/focus=35957

Dan

Matthew Sackman wrote:
> So I was thinking how dull and uninspiring the current definiton of
> Monad really is and came up with some more interesting
> parameterisations. The only problem with this one is I'm a) not sure if
> it still is a Monad and b) very unsure if it's of any use. There's the
> possibility that chucking Cont in there or using newtype to simultate
> multiple arrows / type lambdas may lead to more interesting instances,
> but can anyone think of exciting use cases for this stuff?
> 
> Feel free to fill in the instances! It's also not a parameterisation
> I've seen before.
> 
> Matthew
> 
>> class SuperMonad (m1 :: * -> * -> *) (m2 :: * -> *) where
>>    (>>~)   :: m1 (m2 a) (m1 (m2 b) (m2 b))
>>    (>>=~)  :: m1 (m2 a) (m1 (m1 a (m2 b)) (m2 b))
>>    returns :: m1 a (m2 a)
>>
>> instance (Monad m) => SuperMonad ((->)) m where
>>    (>>~)   :: m a -> m b -> m b
>>    (>>~)   = (>>)
>>    (>>=~)  :: m a -> (a -> m b) -> m b
>>    (>>=~)  = (>>=)
>>    returns :: a -> m a
>>    returns = return
>>
>> instance (Monad m) => SuperMonad ((,)) m where
>>    (>>~)   :: (m a, (m b, m b))
>>    (>>=~)  :: (m a, ((a, m b), m b))
>>    returns :: (a, m a)
>>
>> instance (Monad m) => SuperMonad Either m where
>>    (>>~)   :: Either (m a) (Either (m a) (m b))
>>    (>>=~)  :: Either (m a) (Either (Either a (m b)) (m b))
>>    returns :: Either a (m a)
>>
>> instance (Monad m) => SuperMonad State m where
>>    (>>~)   :: State (m a) (State (m a) (m b))
>>    (>>=~)  :: State (m a) (State (State a (m b)) (m b))
>>    returns :: State a (m a)
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
> 
> 




More information about the Haskell-Cafe mailing list