RamdaJS reduceBy() in Haskell using recursion-schemes

ListAlgebras.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Functor.Foldable
import Data.Maybe
import qualified Data.Map as M
listCata :: ListCata a b
listCata = cata

reduceBy :: Ord k => ListAlgebra t b -> (t -> k) -> [t] -> M.Map k b
reduceBy valueAlgebra keyFn = fmap (cata valueAlgebra) . unXMap . refix . map (keyFn &&& id)

newtype XMap k v = XMap { unXMap :: M.Map k [v] }
type instance Base (XMap k v) = ListF (k, v)
instance Ord k => Corecursive (XMap k v) where
    embed = \case
        Nil -> XMap M.empty
        Cons (key,elt) acc -> XMap $ M.alter (Just . maybe [elt] (elt:)) key $ unXMap acc

countBy = reduceBy laLength
groupBy = reduceBy laId
indexBy = reduceBy laIndex

type Endo a = a -> a
type ListAlgebra a b = ListF a b -> b
type ListCata a b = ListAlgebra a b -> [a] -> b

laLength = \case Nil -> 0 ; Cons _ b -> b + 1
laIndex = \case Nil -> M.empty ; Cons a b -> a

laId :: ListAlgebra a [a]
laId = embed

alter2 f n = M.alter (Just . f . fromMaybe n)

test = do
        print $ countBy id "foo"
        print $ groupBy id "foo"
        print $ indexBy (M.lookup "id") [M.fromList [("id", "xyz"), ("title", "A")], M.fromList [("id", "abc"), ("title", "B")]]