[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