<div dir="ltr">I had not considered that. I tried it out on a gist (<a href="https://gist.github.com/andrewthad/25d1d443ec54412ae96cea3f40411e45">https://gist.github.com/andrewthad/25d1d443ec54412ae96cea3f40411e45</a>), and you're definitely right. I don't understand right monadic folds well enough to write those out, but it would probably be worthwhile to both variants of it as well. Here's the code from the gist:<br><br><div><div>{-# LANGUAGE ScopedTypeVariables #-}</div><div><br></div><div>module Folds where</div><div><br></div><div>import Control.Applicative</div><div><br></div><div>-- Lazy in the monoidal accumulator.</div><div>foldlMapM :: forall g b a m. (Foldable g, Monoid b, Applicative m) => (a -> m b) -> g a -> m b</div><div>foldlMapM f = foldr f' (pure mempty)</div><div>  where</div><div>  f' :: a -> m b -> m b</div><div>  f' x y = liftA2 mappend (f x) y</div><div><br></div><div>-- Strict in the monoidal accumulator. For monads strict</div><div>-- in the left argument of bind, this will run in constant</div><div>-- space.</div><div>foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b</div><div>foldlMapM' f xs = foldr f' pure xs mempty</div><div>  where</div><div>  f' :: a -> (b -> m b) -> b -> m b</div><div>  f' x k bl = do</div><div>    br <- f x</div><div>    let !b = mappend bl br</div><div>    k b</div></div><div><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Wed, Dec 6, 2017 at 6:11 PM, David Feuer <span dir="ltr"><<a href="mailto:david.feuer@gmail.com" target="_blank">david.feuer@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="auto"><div>It seems this lazily-accumulating version should be Applicative, and a strict version Monad. Do we also need a right-to-left version of each?<br><div class="gmail_extra"><br><div class="gmail_quote"><div><div class="h5">On Dec 6, 2017 9:29 AM, "Andrew Martin" <<a href="mailto:andrew.thaddeus@gmail.com" target="_blank">andrew.thaddeus@gmail.com</a>> wrote:<br type="attribution"></div></div><blockquote class="m_-385097102791477641quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div><div class="h5"><div dir="ltr">Several coworkers and myself have independently reinvented this function several times:<div><br></div><div><div>    foldMapM :: (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b</div><div>    foldMapM f xs = foldlM (\b a -> mappend b <$> (f a)) mempty xs</div><div><br></div><div>I would like to propose that this be added to Data.Foldable. We have the triplet foldr,foldl,foldMap in the Foldable typeclass itself, and Data.Foldable provides foldrM and foldlM. It would be nice to provide foldMapM for symmetry and because it seems to be useful in a variety of applications.</div><font color="#888888"><div><br></div>-- <br><div class="m_-385097102791477641m_-2248131543975941377gmail_signature">-Andrew Thaddeus Martin</div>
</font></div></div>
<br></div></div><span class="">______________________________<wbr>_________________<br>
Libraries mailing list<br>
<a href="mailto:Libraries@haskell.org" target="_blank">Libraries@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bi<wbr>n/mailman/listinfo/libraries</a><br>
<br></span></blockquote></div><br></div></div></div>
</blockquote></div><br><br clear="all"><div><br></div>-- <br><div class="gmail_signature" data-smartmail="gmail_signature">-Andrew Thaddeus Martin</div>
</div>