Hi Robin, I don't think there is a combinator that would make this function simpler, but you might find it interesting to see how this can be implemented with cata. Note that the constraint gets switched to Functor f instead of Functor g, and the eta expansion (fr0) to handle the order of arguments of cata. {-# LANGUAGE RankNTypes #-} import Data.Functor.Foldable import Control.Monad.Free import qualified Control.Monad.Trans.Free as Trans hoistWithUpper' :: forall f g s t n . (Functor f) => (forall a. f a -> n) -> n -> (forall a. n -> f a -> g a) -> (n -> s -> t) -> Free f s -> Free g t hoistWithUpper' fu n0 hoistFr hoistPure fr0 = cata (\fr n -> case fr of Trans.Pure a -> Pure (hoistPure n a) Trans.Free f -> let n2 = fu f in Free (hoistFr n (fmap ($ n2) f))) fr0 n0 Another solution, taking advantage of the particular choice of g you have, is to notice that Free (ConstProd n f) (n, s) is isomorphic to FreeT f ((,) n) s, where FreeT is a free monad transformer. The pairing with the annotation n thus gets refactored in a single location in the source. {-# LANGUAGE RankNTypes #-} import Data.Functor.Foldable import Data.Functor.Compose import Control.Monad.Free import qualified Control.Monad.Trans.Free as Trans hoistWithUpper'' :: forall f g s t n . (Functor f) => (forall a. f a -> n) -> n -> Free f s -> Trans.FreeT f ((,) n) s hoistWithUpper'' fu n0 fr = transverse (\fr n -> Compose (n, case fr of Trans.Pure a -> Trans.Pure a Trans.Free f -> Trans.Free (fmap ($ n2) f) where n2 = fu f)) fr n0 -- recursion-schemes >= 5.1 -- https://hackage.haskell.org/package/recursion-schemes-5.1/docs/Data-Functor-... transverse :: (Recursive s, Corecursive t, Functor f) => (forall a. Base s (f a) -> f (Base t a)) -> (s -> f t) transverse n = cata (fmap embed . n) There is probably a similar construction with (CoFree _ n) instead of (FreeT _ ((,) n) _) as well. Regards, Li-yao On 1/25/19 4:48 PM, Robin Palotai wrote:

I came up with this utility function so I can access some info (`n`) from the parent's level:

hoistWithUpper     :: forall f g s t n      . (Functor g)     => (forall a. f a -> n)     -> n     -> (forall a. n -> f a -> g a)     -> (n -> s -> t)     -> Free f s     -> Free g t hoistWithUpper fu n0 hoistFr hoistPure = go n0   where     go :: n -> Free f s -> Free g t     go n fr = case fr of         Pure s -> Pure (hoistPure n s)         Free f -> let n2 = fu f                   in Free (go n2 <$> (hoistFr n f :: g (Free f s)))

I wonder if there's already a generalized form of this in recursion-schemes? Admittedly I'm fine with my helper so don't loose nights on this, but a little type golfing never hurts.

There's a similar function `inherit` [1] in fixplate, but that operates on Fix (Mu there), not Free. With Free I guess the complication is managing the different way of maintaining annotation at the Free and Pure ctors.

Practically I pass in

   (\n f -> ConstProd (Pair (Const n) f))  -- for hoistFr    (\n u -> (n,u))  -- for hoistPure.

where

    newtype ConstProd c f a = ConstProd (Product (Const c) f a)

Thanks! Robin

[1]: http://hackage.haskell.org/package/fixplate-0.1.7/docs/src/Data-Generics-Fix...

_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.