A Tree fold does not optimize very well

Summary

The following fold function on a rose tree does not optimize very well.

data Tree a = Node a [Tree a]

foldrTree :: (a -> b -> b) -> b -> Tree a -> b
foldrTree f z t = go t z
  where go (Node x ts) z' = f x (foldr go z' ts)

But some more complex variations of it do. An example with benchmarks on -O2:

import Control.DeepSeq
import Criterion.Main

main :: IO ()
main = defaultMain
  [ env (pure t_) $ \t -> bgroup ""
    [ bench "foldrTree" $ whnf (foldrTree (&&) True) t
    , bench "foldrTreeAlt" $ whnf (foldrTreeAlt (&&) True) t
    ]
  ]
  where
    t_ = Node True [Node True [] | _ <- [1..1000000]]

data Tree a = Node a [Tree a]

instance NFData a => NFData (Tree a) where
  rnf (Node x ts) = rnf x `seq` rnf ts

foldrTree :: (a -> b -> b) -> b -> Tree a -> b
foldrTree f z t = go t z
  where go (Node x ts) z' = f x (foldr go z' ts)

foldrTreeAlt :: (a -> b -> b) -> b -> Tree a -> b
foldrTreeAlt f z t = go t z
  where go (Node x ts) = f x . foldr ((.) . go) id ts

benchmarking foldrTree
time                 11.60 ms   (11.50 ms .. 11.70 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 11.61 ms   (11.58 ms .. 11.65 ms)
std dev              93.16 μs   (76.81 μs .. 111.6 μs)

benchmarking foldrTreeAlt
time                 5.890 ms   (5.869 ms .. 5.910 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 5.943 ms   (5.928 ms .. 5.969 ms)
std dev              57.94 μs   (43.70 μs .. 88.66 μs)

For background, this was encountered in https://github.com/haskell/containers/pull/880

Expected behavior

The simpler function should ideally optimize as well as the other one.

Environment

• GHC version used: 9.2.5