https://stackoverflow.com/questions/54030077/lifting-a-lens-traversal-to-fix

Example.hs

{-# LANGUAGE DeriveFunctor, DeriveTraversable, RankNTypes, ScopedTypeVariables #-}

module Example where

import Control.Lens
import Data.Functor.Foldable

data PathComponent d a = Directions d | Alt [a] deriving (Show, Functor, Foldable, Traversable)

traversePC ::
  Applicative m =>
  LensLike m pa pb a b ->
  LensLike m (PathComponent a pa) (PathComponent b pb) a b
traversePC _tp f (Directions d) = Directions <$> f d
traversePC  tp f (Alt pas) = Alt <$> (traverse . tp) f pas

newtype Path d a = Path [PathComponent d a] deriving (Show, Functor, Foldable, Traversable)

directions ::
  Applicative m =>
  LensLike m pa pb a b ->
  LensLike m (Path a pa) (Path b pb) a b
directions tp f (Path l) = Path <$> (traverse . traversePC tp) f l

directions' :: Traversal (Fix (Path a)) (Fix (Path b)) a b
directions' f (Fix h) = Fix <$> directions directions' f h

traverseFix ::
  Functor m =>
  (forall x y. LensLike m x y a b -> LensLike m (f x) (g y) a b) ->
  LensLike m (Fix f) (Fix g) a b
traverseFix traverseF = traverseFix' where
  traverseFix' f (Fix h) = Fix <$> traverseF traverseFix' f h

directions'' :: Traversal (Fix (Path a)) (Fix (Path b)) a b
directions'' = traverseFix directions