[Haskell-cafe] Why Kleisli composition is not in the Monad signature?

AUGER Cédric sedrikov at gmail.com
Mon Oct 15 16:45:39 CEST 2012


Le Mon, 15 Oct 2012 15:12:28 +0200,
Benjamin Franksen <benjamin.franksen at helmholtz-berlin.de> a écrit :

> Ertugrul Söylemez wrote:
> > damodar kulkarni <kdamodar2000 at gmail.com> wrote:
> >> The Monad class makes us define bind (>>=) and unit (return) for
> >> our monads.
> >>
> >> Why the Kleisli composition (>=>) or (<=<) is not made a part of
> >> Monad class instead of bind (>>=)?
> >>
> >> Is there any historical reason behind this?
> >>
> >> The bind (>>=) is not as elegant as (>=>), at least as I find it.
> >>
> >> Am I missing something?
> > 
> > Try to express
> > 
> >     do x <- getLine
> >        y <- getLine
> >        print (x, y)
> > 
> > using only Kleisli composition (without cheating).  Through cheating
> > (doing non-categorical stuff) it's possible to implement (>>=) in
> > terms of (<=<), but as said that's basically breaking the
> > abstraction.
> 
> What do you mean with "cheating" / "doing non-categorical stuff"?
> 
> m >>= f = (const m >=> f) ()
> 
> f >=> g = \x -> f x >>= g
> 
> How does the first definition "break the abstraction" while the
> second does not?
> 
> Cheers

It does not really break the categorical stuff, but I think that bind
has better its place rather than being replaced by the Kleisli arrow.

I am quite new to Haskell, so I do not know its history, but for the
categorical point of view, bind would better have received the
signature "∀ α β, (α→Mβ) → (Mα→Mβ)", expressing 'M' as a functor from
Kleisli(M) category to the Hask category, sending each morphism "α→Mβ"
from "α" to "β" in Kleisli category, to a morphism "Mα→Mβ" in the Hask
category.

As you may have already read, the usual point of view of monads in
mathematic is not with (return, bind) but (return, join) [return is
usually noted ε and is called the unit, and join is usually noted μ and
called multiplication]. In this context, "return : ∀ α, (α→Mα)" and
"join : ∀ α, (MMα→Mα)" are called natural transformations and must
respect some additionnal rules (called monad laws).

If you do not know what a natural transformation is, this is some
definition (in a Haskell context).
Consider two functors S and T, "f: ∀ α, (Sα→Tα)" is a natural
transformation from S to T, if for any types "t1" and "t2" and any
pure function "g: t1→t2", we following egality holds: "f.(fmap
g)=(fmap g).f"

For instance when S is the identity functor, and T is the functor
associated to the monad, you must have "return.(fmap g) = (fmap
g).return".

Now, I do not really know why "bind" is used rather than "join". I
guess that join is not very common in practice, so we would have to
write "join (fmap f) x" each time we would like to write "bind x f".
Another reason may be history, and the last one would be efficiency (I
guess that "bind" correspond better to machine models than "join"). In
any case, "join" has a simpler type than "bind" (only one type
variable), which in turn is simpler than your Kleisli arrow (you need 3
type variables).

It would be rather awful to expand each of your Kleisli arrows with
"const" as you said. Of course you wouldn't have to do it, but for
efficient compilation, as I guess that in most cases "bind" can be
rather efficiently implemented, while "kleisli" would not, I fear some
minor performance issues with "bind" defined in terms of "kleisli".
Once again I am not a Haskell expert.

For the small story, the concept of Monad is strongly linked to the one
of Adjunction (although adjunctions in Haskell are probably not very
commonly used and easy to define). The composition of a left and a
right adjunction gives a Monad, and given a Monad, we can build an
adjunction. One of the adjunction you can build is using … the Kleisli
category (see Wikipedia).



More information about the Haskell-Cafe mailing list