RamdaJS reduceBy() in Haskell using recursion-schemes

Question

I have the following code using recursion-schemes library:

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Functor.Foldable
import Data.Maybe

import qualified Data.Map as M

reduceBy valueAlgebra keyFn = cata $ fooAlgebra valueAlgebra keyFn

fooAlgebra
  :: Ord k =>
     (ListF t a -> a) -> (t -> k) -> ListF t (M.Map k a) -> M.Map k a   
fooAlgebra valueAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.alter 
         (Just . (valueAlgebra . Cons elt) . fromMaybe (valueAlgebra Nil)) 
         (keyFn elt)
         acc

Use as let countBy = reduceBy (\case Nil -> 0 ; Cons a b -> succ b) id in countBy [42,5,5,8,8,8]. The code mimics http://ramdajs.com/docs/#reduceBy

Is there a better way to implement reduceBy using recursion-schemes? The alter arguments seem fragile, and is cata really appropriate there? I heard that some things are implementable both as ana and cata.

Answer 1

I don't see anything wrong with your approach. The arguments to alter are not too pleasant to look at, but that's mostly beacues alter is a little clumsy to use. Since you don't need to remove elements from the map, it is possible to rewrite fooAlgebra using insertWith rather than alter...

fooAlgebra
  :: Ord k =>
     (ListF t a -> a) -> (t -> k) -> ListF t (M.Map k a) -> M.Map k a
fooAlgebra valueAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.insertWith
         (\_ grpAcc -> valueAlgebra (Cons elt grpAcc))
         (keyFn elt)
         (valueAlgebra (Cons elt (valueAlgebra Nil)))
         acc

... which you may or may not find an improvement.

As for using a catamorphism, it feels like a natural thing to do, as you are destroying the original structure to produce a group-wise summary of the elements. (It is also worth noting that if keyFn is a constant function then reduceBy becomes, in essence, a plain old fold of all elements with valueAlgebra.) The refactoring that danidiaz suggests (i.e. separating the valueAlgebra catamorphism from the grouping one) arguably makes that more evident:

reduceBy valueAlgebra keyFn =
    fmap (cata valueAlgebra) . cata (groupAlgebra keyFn)

groupAlgebra
  :: Ord k => (t -> k) -> ListF t (M.Map k [t]) -> M.Map k [t]
groupAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.alter
         (Just . (elt :) . fromMaybe [])
         (keyFn elt)
         acc