Proposal: Adding Kleisli composition to Control.Monad
Donald Bruce Stewart
dons at cse.unsw.edu.au
Sun Nov 12 21:15:45 EST 2006
http://hackage.haskell.org/trac/ghc/ticket/997
Add Kleisli composition to Control.Monad.
Kleisli composition of monads is a foundational feature missing from the
current Control.Monad library. A recent discussion revealed solid
support for its inclusion.
This patch adds:
(>=>) :: (Monad m) => (a -> m b) -> (b -> m c) -> (a -> m c)
(<=<) :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c)
Along with the useful control combinator:
forever :: (Monad m) => m a -> m ()
Traditionally, >=> has been written as @@, however to support the
flipped version, new notation seems to be required. It should be notated
that there is overlap with the Kleisli class in Control.Arrow
(specifically >>>), however, short of a convenient unifying form for
Arrow and Monad, a monad-specific >>> seems reasonable. To mirror >>>
and =<<, infixr 1 was chosen.
Proposal period: 2 weeks.
Deadline: 27th November.
-- Don
------------------------------------------------------------------------
hunk ./Control/Monad.hs 40
+ , (>=>) -- :: (Monad m) => (a -> m b) -> (b -> m c) -> (a -> m c)
+ , (<=<) -- :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c)
+ , forever -- :: (Monad m) => m a -> m ()
hunk ./Control/Monad.hs 179
+infixr 1 <=<, >=>
+
+-- | Left-to-right Kleisli composition of monads.
+(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
+f >=> g = \x -> f x >>= g
+
+-- | Right-to-left Kleisli composition of monads. '(>=>)', with the arguments flipped
+(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
+(<=<) = flip (>=>)
+
+-- | @'forever' act@ repeats the action infinitely.
+forever :: (Monad m) => m a -> m ()
+forever a = a >> forever a
------------------------------------------------------------------------
More information about the Libraries
mailing list