proposed change to transformers package

Edward Kmett ekmett at gmail.com
Mon Mar 29 08:11:55 EDT 2010


While I personally prefer the (:*:) and (:+:) notation, both require an
additional extension, TypeOperators, and to Ross's point (:+:) fails to be
an Applicative/Monad transformers, so the scope of the package starts to
stretch there.

That said, there are always ideal monad coproducts, but then you need the
notion of ideal monads. ;)

data Ideal m a = Return a | Ideal (m a)
data Mutual m n a = Mutual (m (Mutual n m a))
data (m :+: n) a = Coproduct { runCoproduct :: Either (m a) (n a) }
type IdealCoproduct m n = Ideal (Mutual m n :+: Mutual n m)

given a definition for

class MonadIdeal m where
    idealize :: m (Ideal m a) -> m a

which describes a monad, that has a separate return.

You can define

instance MonadIdeal m => Monad (Ideal m)

and then you can define an 'ideal monad coproduct' of any two ideal monads
from there.

This covers, Maybe, Either, Identity, and a bunch of others. wherever the
'Return' constructor can be cleanly separated from the rest of the monad.

However, this drifts out of library/platform territory and into esoterica.

-Edward Kmett

On Mon, Mar 29, 2010 at 5:42 AM, Nicolas Pouillard <
nicolas.pouillard at gmail.com> wrote:

> On Fri, 26 Mar 2010 19:28:18 +0000, Ross Paterson <ross at soi.city.ac.uk>
> wrote:
> > On Fri, Mar 26, 2010 at 05:24:18AM -0700, Nicolas Pouillard wrote:
> > > Could we have functors products, sums, fixpoints as well? It would
> really
> > > avoid to redefine them each time.
> >
> > Do you mean
> >
> >   data Product f g a = Product (f a) (g a)
>
> Yes, I was thinking of using :*: instead of Product:
>
> data (:*:) f g a = (:*:) (f a) (g a)
>
> > with Functor, Foldable, Traversable and Applicative instances?
>
> Yes.
>
> > Not sure if the other two count as transformers.
>
> Why not:
>
> data (:+:) f g a = Inl (f a) | Inr (g a)
>
>  And sure, no applicative nor monad instance for this one.
>
> And Fix like in category-extras:
>
> http://hackage.haskell.org/packages/archive/category-extras/0.53.5/doc/html/Control-Functor-Fix.html
>
> Best regards,
>
> --
> Nicolas Pouillard
> http://nicolaspouillard.fr
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/libraries/attachments/20100329/c2b1590c/attachment.html


More information about the Libraries mailing list