Proposal: Move `mapM` and `sequence` out of Traversable

Hi All, I have a proposal for the `base` library: I would like to move `mapM` and `sequence` out of the class definition for `Traversable`, redefining them as toplevel aliases: ```haskell mapM :: Traversable t ⇒ Monad m ⇒ (a -> m b) -> t a -> m (t b) mapM = traverse sequence :: Traversable t ⇒ Monad m=> t (m a) -> m (t a) sequence = sequenceA ``` This slims `Traversable` by 50%. This would be a very small breaking change, which is completely tractable, but a great improvement for the ecosystem imo. Thoughts? What timeline should we shoot for with a change like this? Cheers, Emily

I'm generally in favor of removing `sequence`, and probably also
`sequenceA`. Can you demonstrate that there can be no instance for which
`mapM` is much more efficient than `traverse`? Consider especially types
based on monadic streams.
On Sat, Nov 7, 2020 at 2:56 PM Emily Pillmore
Hi All,
I have a proposal for the `base` library: I would like to move `mapM` and `sequence` out of the class definition for `Traversable`, redefining them as toplevel aliases:
```haskell mapM :: Traversable t ⇒ Monad m ⇒ (a -> m b) -> t a -> m (t b) mapM = traverse
sequence :: Traversable t ⇒ Monad m=> t (m a) -> m (t a) sequence = sequenceA ```
This slims `Traversable` by 50%. This would be a very small breaking change, which is completely tractable, but a great improvement for the ecosystem imo. Thoughts? What timeline should we shoot for with a change like this?
Cheers, Emily
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Hi Emily,
As David suggested, removal of `mapM` will be problematic for boxed `Vector`: https://github.com/haskell/vector/blob/a15a52155f281ca6753ecef1247f84a0579e3...
The reason behind that fact is that streams in `vector` are monadic, so `traverse` implementation has to go through a list, while `mapM` can be implemented in a more efficient manner.
My personal opinion on this is that such slimming of Traversable is counterproductive, the only thing we incur is a bunch of broken libraries and redundant work on maintainers part.
Is there anything that can be won from a user's perspective from such a change? A potential performance or usability benefit that I am missing?
Sincerely,
Alexey.
‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐
On Saturday, November 7, 2020 11:03 PM, David Feuer
I'm generally in favor of removing `sequence`, and probably also `sequenceA`. Can you demonstrate that there can be no instance for which `mapM` is much more efficient than `traverse`? Consider especially types based on monadic streams.
On Sat, Nov 7, 2020 at 2:56 PM Emily Pillmore
wrote: Hi All,
I have a proposal for the `base` library: I would like to move `mapM` and `sequence` out of the class definition for `Traversable`, redefining them as toplevel aliases:
```haskell mapM :: Traversable t ⇒ Monad m ⇒ (a -> m b) -> t a -> m (t b) mapM = traverse
sequence :: Traversable t ⇒ Monad m=> t (m a) -> m (t a) sequence = sequenceA ```
This slims `Traversable` by 50%. This would be a very small breaking change, which is completely tractable, but a great improvement for the ecosystem imo. Thoughts? What timeline should we shoot for with a change like this?
Cheers, Emily
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Due to the nature of the Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... abstractions, they are prone to memory leaks and not as efficient as their monadic counterparts. Although all the combinators we provide in this module are perfectly expressible in terms of Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h...,
Hi! Regarding the "there can be no instance for which mapM is more efficient than traverse": There have been issues with Applicative functions leaking memory where Monad ones aren't in Polysemy - some of these have been fixed, but it's not clear that there are none left. There is also this claim in parser-combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Ap... : please prefer Control.Monad.Combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Mo... instead when possible. I have not verified it, but it is a bit worrying. Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions) ====== Georgi

Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
I agree. I'd be very interested in seeing an example (contrived or
otherwise) of a specific Monad which is necessarily more efficient to
`mapM` over some arbitrarily selected Traversable container than to
`traverse`. That would be a good first step I think.
On Sat, Nov 7, 2020 at 3:29 PM Georgi Lyubenov
Hi!
Regarding the "there can be no instance for which mapM is more efficient than traverse": There have been issues with Applicative functions leaking memory where Monad ones aren't in Polysemy - some of these have been fixed, but it's not clear that there are none left. There is also this claim in parser-combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Ap... :
Due to the nature of the Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... abstractions, they are prone to memory leaks and not as efficient as their monadic counterparts. Although all the combinators we provide in this module are perfectly expressible in terms of Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h..., please prefer Control.Monad.Combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Mo... instead when possible.
I have not verified it, but it is a bit worrying.
Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
====== Georgi _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

I don't know about measurements or anything. There are certainly
*implementation strategies* for mapM that don't translate well to traverse.
Imagine a queue, for example. One way to write mapM is this:
mapM f = go empty
where
go !acc xs = case uncons xs of
Just (x, xs') -> do
y <- f x
go (acc `snoc` y)
Nothing -> pure acc
There's no way to do anything operationally equivalent with just
Applicative.
Is this a good way to write it? Well, that presumably depends on the queue
and on the Monad, but I'd give it a good "possibly".
On Sat, Nov 7, 2020, 3:42 PM A S
Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
I agree. I'd be very interested in seeing an example (contrived or otherwise) of a specific Monad which is necessarily more efficient to `mapM` over some arbitrarily selected Traversable container than to `traverse`. That would be a good first step I think.
On Sat, Nov 7, 2020 at 3:29 PM Georgi Lyubenov
wrote: Hi!
Regarding the "there can be no instance for which mapM is more efficient than traverse": There have been issues with Applicative functions leaking memory where Monad ones aren't in Polysemy - some of these have been fixed, but it's not clear that there are none left. There is also this claim in parser-combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Ap... :
Due to the nature of the Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... abstractions, they are prone to memory leaks and not as efficient as their monadic counterparts. Although all the combinators we provide in this module are perfectly expressible in terms of Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h..., please prefer Control.Monad.Combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Mo... instead when possible.
I have not verified it, but it is a bit worrying.
Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
====== Georgi _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

In light of this example, I oppose the proposal.
On Sat, Nov 7, 2020, 5:04 PM David Feuer
I don't know about measurements or anything. There are certainly *implementation strategies* for mapM that don't translate well to traverse. Imagine a queue, for example. One way to write mapM is this:
mapM f = go empty where go !acc xs = case uncons xs of Just (x, xs') -> do y <- f x go (acc `snoc` y) Nothing -> pure acc
There's no way to do anything operationally equivalent with just Applicative.
Is this a good way to write it? Well, that presumably depends on the queue and on the Monad, but I'd give it a good "possibly".
On Sat, Nov 7, 2020, 3:42 PM A S
wrote: Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
I agree. I'd be very interested in seeing an example (contrived or otherwise) of a specific Monad which is necessarily more efficient to `mapM` over some arbitrarily selected Traversable container than to `traverse`. That would be a good first step I think.
On Sat, Nov 7, 2020 at 3:29 PM Georgi Lyubenov
wrote: Hi!
Regarding the "there can be no instance for which mapM is more efficient than traverse": There have been issues with Applicative functions leaking memory where Monad ones aren't in Polysemy - some of these have been fixed, but it's not clear that there are none left. There is also this claim in parser-combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Ap... :
Due to the nature of the Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... abstractions, they are prone to memory leaks and not as efficient as their monadic counterparts. Although all the combinators we provide in this module are perfectly expressible in terms of Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h..., please prefer Control.Monad.Combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Mo... instead when possible.
I have not verified it, but it is a bit worrying.
Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
====== Georgi _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Yeah, mapM is semantically different from traverse. So dropping mapm seems
ill advised.
@david: is there an analogue for sequence?
On Sat, Nov 7, 2020 at 5:15 PM David Feuer
In light of this example, I oppose the proposal.
On Sat, Nov 7, 2020, 5:04 PM David Feuer
wrote: I don't know about measurements or anything. There are certainly *implementation strategies* for mapM that don't translate well to traverse. Imagine a queue, for example. One way to write mapM is this:
mapM f = go empty where go !acc xs = case uncons xs of Just (x, xs') -> do y <- f x go (acc `snoc` y) Nothing -> pure acc
There's no way to do anything operationally equivalent with just Applicative.
Is this a good way to write it? Well, that presumably depends on the queue and on the Monad, but I'd give it a good "possibly".
On Sat, Nov 7, 2020, 3:42 PM A S
wrote: Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
I agree. I'd be very interested in seeing an example (contrived or otherwise) of a specific Monad which is necessarily more efficient to `mapM` over some arbitrarily selected Traversable container than to `traverse`. That would be a good first step I think.
On Sat, Nov 7, 2020 at 3:29 PM Georgi Lyubenov
wrote: Hi!
Regarding the "there can be no instance for which mapM is more efficient than traverse": There have been issues with Applicative functions leaking memory where Monad ones aren't in Polysemy - some of these have been fixed, but it's not clear that there are none left. There is also this claim in parser-combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Ap... :
Due to the nature of the Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... abstractions, they are prone to memory leaks and not as efficient as their monadic counterparts. Although all the combinators we provide in this module are perfectly expressible in terms of Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h..., please prefer Control.Monad.Combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Mo... instead when possible.
I have not verified it, but it is a bit worrying.
Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
====== Georgi _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries

Off the top of my head, I can't think of anything about sequence or
sequenceA to justify their existence as class methods from the standpoint
of practical programming. I could imagine they might be helpful to
beginners who may find it easier to think about a container full of actions
than about a container full of elements and a function that can be applied
to them to get actions. But it's also not clear to me that removing methods
is very valuable unless either:
1. We get down to just one method, which can be good for performance with
non-regular types, or
2. We end up with a class that works with GND/DerivingVia, such as
class (Foldable t, Functor t) => Traversable t where
mapTraverse :: Applicative f => (t b -> r) -> (a -> f b) -> t a -> f r
The one-method bonus can generally be worked around with auxiliary classes
in the rare cases where it comes up, so I wouldn't worry about that too
much here.
On Sat, Nov 7, 2020, 9:47 PM Carter Schonwald
Yeah, mapM is semantically different from traverse. So dropping mapm seems ill advised.
@david: is there an analogue for sequence?
On Sat, Nov 7, 2020 at 5:15 PM David Feuer
wrote: In light of this example, I oppose the proposal.
On Sat, Nov 7, 2020, 5:04 PM David Feuer
wrote: I don't know about measurements or anything. There are certainly *implementation strategies* for mapM that don't translate well to traverse. Imagine a queue, for example. One way to write mapM is this:
mapM f = go empty where go !acc xs = case uncons xs of Just (x, xs') -> do y <- f x go (acc `snoc` y) Nothing -> pure acc
There's no way to do anything operationally equivalent with just Applicative.
Is this a good way to write it? Well, that presumably depends on the queue and on the Monad, but I'd give it a good "possibly".
On Sat, Nov 7, 2020, 3:42 PM A S
wrote: Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
I agree. I'd be very interested in seeing an example (contrived or otherwise) of a specific Monad which is necessarily more efficient to `mapM` over some arbitrarily selected Traversable container than to `traverse`. That would be a good first step I think.
On Sat, Nov 7, 2020 at 3:29 PM Georgi Lyubenov
wrote: Hi!
Regarding the "there can be no instance for which mapM is more efficient than traverse": There have been issues with Applicative functions leaking memory where Monad ones aren't in Polysemy - some of these have been fixed, but it's not clear that there are none left. There is also this claim in parser-combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Ap... :
Due to the nature of the Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... abstractions, they are prone to memory leaks and not as efficient as their monadic counterparts. Although all the combinators we provide in this module are perfectly expressible in terms of Applicative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h... and Alternative https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Applicative.h..., please prefer Control.Monad.Combinators https://hackage.haskell.org/package/parser-combinators-1.2.1/docs/Control-Mo... instead when possible.
I have not verified it, but it is a bit worrying.
Personally I would love to know of some kind of reasoning regarding these things, as I'm not aware of any! (efficiency of Applicative vs Monad based functions)
====== Georgi _______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
participants (6)
-
A S
-
Alexey Kuleshevich
-
Carter Schonwald
-
David Feuer
-
Emily Pillmore
-
Georgi Lyubenov