merge_monoid_with_fold.hs

foldMonoidTree :: (Monoid a) => [a] -> a
foldMonoidTree =
  foldl1 (flip (<>)) . map snd . foldl addToCounter []
  where
    addToCounter counter x = propagate ((1::Int,x) : counter)
    propagate [] = []
    propagate [x] = [x]
    propagate counter@(x:y:xs) -- x arrived last => combine on right
      | fst x == fst y = propagate ((fst x + fst y, snd y <> snd x) : xs)
      | otherwise      = counter