<div dir="auto">Actually, the key modifiers are probably Dual and Backwards, with Reverse combining them. Or something like that.</div><div class="gmail_extra"><br><div class="gmail_quote">On Dec 6, 2017 8:20 PM, "David Feuer" <<a href="mailto:david.feuer@gmail.com">david.feuer@gmail.com</a>> wrote:<br type="attribution"><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Actually, the most "natural" Applicative version is probably this:<br>
<br>
newtype Ap f a = Ap {getAp :: f a}<br>
instance (Applicative f, Monoid a) => Monoid (Ap f a) where<br>
  mempty = Ap $ pure mempty<br>
  mappend (Ap x) (Ap y) = Ap $ liftA2 mappend x y<br>
<br>
foldMapA :: (Foldable t, Monoid m, Applicative f) => (a -> f m) -> t a -> f m<br>
foldMapA f = getAp . foldMap (Ap . f)<br>
<br>
Of course, we can use some Data.Coerce magic to avoid silly eta<br>
expansion, as usual.<br>
<br>
The "right" way to perform the actions in the opposite order is probably just<br>
<br>
foldMapA f . Reverse<br>
<br>
and you can accumulate the other way using getDual . foldMapA (Dual . f)<br>
<br>
So I think the whole Applicative side of this proposal might be seen as further<br>
motivation for my long-ago stalled proposal to add Ap to Data.Monoid.<br>
<br>
On Wed, Dec 6, 2017 at 7:27 PM, Andrew Martin <<a href="mailto:andrew.thaddeus@gmail.com">andrew.thaddeus@gmail.com</a>> wrote:<br>
> I had not considered that. I tried it out on a gist<br>
> (<a href="https://gist.github.com/andrewthad/25d1d443ec54412ae96cea3f40411e45" rel="noreferrer" target="_blank">https://gist.github.com/<wbr>andrewthad/<wbr>25d1d443ec54412ae96cea3f40411e<wbr>45</a>), and<br>
> you're definitely right. I don't understand right monadic folds well enough<br>
> to write those out, but it would probably be worthwhile to both variants of<br>
> it as well. Here's the code from the gist:<br>
><br>
> {-# LANGUAGE ScopedTypeVariables #-}<br>
><br>
> module Folds where<br>
><br>
> import Control.Applicative<br>
><br>
> -- Lazy in the monoidal accumulator.<br>
> foldlMapM :: forall g b a m. (Foldable g, Monoid b, Applicative m) => (a -><br>
> m b) -> g a -> m b<br>
> foldlMapM f = foldr f' (pure mempty)<br>
>   where<br>
>   f' :: a -> m b -> m b<br>
>   f' x y = liftA2 mappend (f x) y<br>
><br>
> -- Strict in the monoidal accumulator. For monads strict<br>
> -- in the left argument of bind, this will run in constant<br>
> -- space.<br>
> foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b)<br>
> -> g a -> m b<br>
> foldlMapM' f xs = foldr f' pure xs mempty<br>
>   where<br>
>   f' :: a -> (b -> m b) -> b -> m b<br>
>   f' x k bl = do<br>
>     br <- f x<br>
>     let !b = mappend bl br<br>
>     k b<br>
><br>
><br>
> On Wed, Dec 6, 2017 at 6:11 PM, David Feuer <<a href="mailto:david.feuer@gmail.com">david.feuer@gmail.com</a>> wrote:<br>
>><br>
>> It seems this lazily-accumulating version should be Applicative, and a<br>
>> strict version Monad. Do we also need a right-to-left version of each?<br>
>><br>
>> On Dec 6, 2017 9:29 AM, "Andrew Martin" <<a href="mailto:andrew.thaddeus@gmail.com">andrew.thaddeus@gmail.com</a>> wrote:<br>
>><br>
>> Several coworkers and myself have independently reinvented this function<br>
>> several times:<br>
>><br>
>>     foldMapM :: (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m<br>
>> b<br>
>>     foldMapM f xs = foldlM (\b a -> mappend b <$> (f a)) mempty xs<br>
>><br>
>> I would like to propose that this be added to Data.Foldable. We have the<br>
>> triplet foldr,foldl,foldMap in the Foldable typeclass itself, and<br>
>> Data.Foldable provides foldrM and foldlM. It would be nice to provide<br>
>> foldMapM for symmetry and because it seems to be useful in a variety of<br>
>> applications.<br>
>><br>
>> --<br>
>> -Andrew Thaddeus Martin<br>
>><br>
>> ______________________________<wbr>_________________<br>
>> Libraries mailing list<br>
>> <a href="mailto:Libraries@haskell.org">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-<wbr>bin/mailman/listinfo/libraries</a><br>
>><br>
>><br>
><br>
><br>
><br>
> --<br>
> -Andrew Thaddeus Martin<br>
</blockquote></div></div>