# [Haskell-cafe] Is there a recursion-scheme function to push info down one level?

Li-yao Xia lysxia at gmail.com
Fri Jan 25 22:58:47 UTC 2019

```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

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

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
--
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]: