Is there a recursion-scheme function to push info down one level?

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

Is there a recursion-scheme function to push info down one level?

Robin Palotai
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


_______________________________________________
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.
Reply | Threaded
Open this post in threaded view
|

Re: Is there a recursion-scheme function to push info down one level?

Li-yao Xia-2
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.
>
_______________________________________________
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.