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

[Li-yao Xia]

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-Foldable.html#v:transverse
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-Fixplate-Attributes.html#inherit
> 
> _______________________________________________
> 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.
>