foldMapA, Applicative-action folding in Haskell

FoldMapA.hs

-- Written for GHC 8.0

import           Data.Foldable (foldr')


-- The other day I had the feeling that if I can write
--
--   minumumABy :: (Applicative f)
--              => (b -> b -> Ordering) -> [a] -> (a -> f b) -> f (Maybe b)
--
-- I should also be able to write
--
--   foldA :: (Applicative f) => (b -> a -> f b) -> b -> [a] -> f b
--
-- because it is similar.
-- But I felt wrong: The thing that can exploit the Applicative here is only
-- `(b -> b -> Ordering)`, or in general any folding function `(a -> b -> b)`
-- that does not mention `f`.
-- For `foldM`/`foldA` that's not the case: it mentions `f` in the folding function.
--
-- What can be written is
--
--   foldMapA :: (Applicative f, Monoid m) => (a -> f m) -> [a] -> f m
--
-- and one can nicely see that when it's implemented using its non-Monoid-typeclass
-- counterpart
--
--   foldMapAWith :: (Applicative f) => c -> (b -> c -> c) -> (a -> f b) -> [a] -> f c
--
-- where the `(b -> c -> c)` doesn't involve `f`.
--
-- Below I've done exactly that.
-- I find it odd that these `foldMapAWith`, `foldMapA`, or even `foldMapM`
-- are not in `base`, though something going into this direction was already
-- discussed in 2008:
--   http://comments.gmane.org/gmane.comp.lang.haskell.libraries/8284


foldMapAWith :: (Applicative f, Foldable t) => c -> (b -> c -> c) -> (a -> f b) -> t a -> f c
foldMapAWith defaultC combine f =
  foldr' (\a c -> combine <$> f a <*> c) (pure defaultC)


-- Note how this is *not* equivalent to some `fold combine <$> traverse f`,
-- because that one holds to the entire outputs of the `traverse`,
-- while `foldMapAWith` doesn't.
-- You can see that nicely by the fact that the `f a` is in the middle of the
-- folding function syntactically.


foldMapA :: (Applicative f, Foldable t, Monoid m) => (a -> f m) -> t a -> f m
foldMapA = foldMapAWith mempty mappend


-- Example usage:
-- Finding the minimum after an applicative map (`traverse`) without holding to
-- the entire output "list" of the map.

minBy :: (a -> a -> Ordering) -> a -> a -> a
minBy ord l r = case ord r l of
  LT -> r -- pick right one only if it's strictly smaller (left-biased minBy)
  _  -> l


minumumABy :: (Applicative f, Foldable t) => (b -> b -> Ordering) -> t a -> (a -> f b) -> f (Maybe b)
minumumABy ord l f = foldMapAWith Nothing minMaybe f l
  where
    minMaybe b mbCurrentBest = case mbCurrentBest of
      Nothing          -> Just b
      Just currentBest -> Just $ minBy ord currentBest b


minumumAMaybeBy :: (Applicative f, Foldable t) => (b -> b -> Ordering) -> t a -> (a -> f (Maybe b)) -> f (Maybe b)
minumumAMaybeBy ord l f = foldMapAWith Nothing minMaybe f l
  where
    minMaybe mbB mbCurrentBest = case (mbCurrentBest, mbB) of
      (Nothing         , _      ) -> mbB
      (_               , Nothing) -> mbCurrentBest
      (Just currentBest, Just b ) -> Just $ minBy ord currentBest b