Proposal: add foldMapA to Data.Foldable or Control.Applicative
David Feuer
david.feuer at gmail.com
Wed May 8 02:49:10 UTC 2019
On Tue, May 7, 2019, 9:57 PM Vanessa McHale <vanessa.mchale at iohk.io> wrote:
> It's relatively easy to define foldMapA, viz.
>
> foldMapA :: (Monoid b, Traversable t, Applicative f) => (a -> f b) -> t
> a -> f b
> foldMapA = (fmap fold .) . traverse
>
That's a bit hard for me to read. Let's rewrite it a bit:
foldMapA f = fmap fold . traverse f
Looking at it more plainly, I can see that this traverses the container
with f, producing a bunch of values, then maps under the functor to fold
them. That smells funny. Let's fix it.
fold
:: (Foldable f, Monoid a)
=> f a -> a
fold = foldMap id
foldMapDefault
:: (Traversable t, Monoid m)
=> (a -> m) -> t a -> m
foldMapDefault f = getConst . traverse (Const . f)
so
foldMapA f = fmap (getConst . traverse Const) . traverse f
By the functor composition law, we can write
foldMapA f = fmap getConst . fmap (traverse Const) . traverse f
By the traversable composition law,
foldMapA f = fmap getConst . getCompose . traverse (Compose . fmap Const
. f)
This isn't looking so hot yet, but bear with me. fmap getConst doesn't
actually do anything (it's operationally the same as fmap id = id), so we
can ignore it). The functor we're traversing in is
Compose f (Const b) (t x)
where x can be anything. How does this functor behave?
pure a
= Compose (pure (pure a))
= Compose (pure (Const mempty))
liftA2 f (Compose x) (Compose y)
= Compose (liftA2 (liftA2 f) x y)
= Compose (liftA2 (\(Const p) (Const q) -> p <> q) x y)
Whew! There are a lot of newtype wrappers, but let's ignore them. Does this
Applicative instance look familiar? It should. It's operationally the same
as the Monoid instance for Data.Monoid.Ap! So we can weaken Traversable to
Foldable, and write
foldMapA
:: (Monoid b, Foldable t, Applicative f)
=> (a -> f b) -> t a -> f b
foldMapA f = getAp . foldMap (Ap . f)
But now it's so simple I'm not sure we need to define it anymore.
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20190507/325c0063/attachment.html>
More information about the Libraries
mailing list