Functor instance for generic polymorphic ADTs in Haskell?

Question

When it comes to applying category theory for generic programming Haskell does a very good job, for instance with libraries like recursion-schemes. However one thing I'm not sure of is how to create a generic functor instance for polymorphic types.

If you have a polymorphic type, like a List or a Tree, you can create a functor from (Hask × Hask) to Hask that represents them. For example:

data ListF a b = NilF | ConsF a b  -- L(A,B) = 1+A×B
data TreeF a b = EmptyF | NodeF a b b -- T(A,B) = 1+A×B×B

These types are polymorphic on A but are fixed points regarding B, something like this:

newtype Fix f = Fix { unFix :: f (Fix f) }
type List a = Fix (ListF a)
type Tree a = Fix (TreeF a)

But as most know, lists and trees are also functors in the usual sense, where they represent a "container" of a's, which you can map a function f :: a -> b to get a container of b's.

I'm trying to figure out if there's a way to make these types (the fixed points) an instance of Functor in a generic way, but I'm not sure how. I've encountered the following 2 problems so far:

---

1) First, there has to be a way to define a generic gmap over any polymorphic fixed point. Knowing that types such as ListF and TreeF are Bifunctors, so far I've got this:

{-# LANGUAGE ScopedTypeVariables #-}
import Data.Bifunctor

newtype Fix f = Fix { unFix :: f (Fix f) }

cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . unFix

-- To explicitly use inF as the initial algebra
inF :: f (Fix f) -> Fix f
inF = Fix

gmap :: forall a b f. Bifunctor f => (a -> b) -> Fix (f a) -> Fix (f b)
gmap f = cata alg
    where
        alg :: f a (Fix (f b)) -> Fix (f b)
        alg = inF . bimap f id

In Haskell this gives me the following error: Could not deduce (Functor (f a)) arising from a use of cata from the context (Bifunctor f).

I'm using the bifunctors package, which has a WrappedBifunctor type that specifically defines the following instance which could solve the above problem: Bifunctor p => Functor (WrappedBifunctor p a). However, I'm not sure how to "lift" this type inside Fix to be able to use it

2) Even if the generic gmap above can be defined, I don't know if it's possible to create a generic instance of Functor that has fmap = gmap, and can instantly work for both the List and Tree types up there (as well as any other type defined in a similar fashion). Is this possible?

If so, would it be possible to make this compatible with recursion-schemes too?

Answer 1

If you're willing to accept for the moment you're dealing with bifunctors, you can say

cata :: Bifunctor f => (f a r -> r) -> Fix (f a) -> r
cata f = f . bimap id (cata f) . unFix

and then

gmap :: forall a b f. Bifunctor f => (a -> b) -> Fix (f a) -> Fix (f b)
gmap f = cata alg
    where
        alg :: f a (Fix (f b)) -> Fix (f b)
        alg = inF . bimap f id

(In gmap, I've just rearranged your class constraint to make scoped type variables work.)

You can also work with your original version of cata, but then you need both the Functor and the Bifunctor constraint on gmap:

gmap :: forall a b f. (Bifunctor f, Functor (f a)) => (a -> b) -> Fix (f a) -> Fix (f b)
gmap f = cata alg
    where
        alg :: f a (Fix (f b)) -> Fix (f b)
        alg = inF . bimap f id

You cannot make your gmap an instance of the normal Functor class, because it would need to be something like

instance ... => Functor (\ x -> Fix (f x))

and we don't have type-level lambda. You can do this if you reverse the two arguments of f, but then you lose the "other" Functor instance and need to define cata specific for Bifunctor again.

[You might also be interested to read http://www.andres-loeh.de/IndexedFunctors/ for a more general approach.]

Answer 2

TBH I'm not sure how helpful this solution is to you because it still requires an extra newtype wrapping for these fixed-point functors, but here we go:

You can keep using your generic cata if you do some wrapping/unwrapping

Given the following two helper functions:

unwrapFixBifunctor :: (Bifunctor f) => Fix (WrappedBifunctor f a) -> Fix (f a)
unwrapFixBifunctor = Fix . unwrapBifunctor . fmap unwrapFixBifunctor . unFix

wrapFixBifunctor :: (Bifunctor f) => Fix (f a) -> Fix (WrappedBifunctor f a)
wrapFixBifunctor = Fix . fmap wrapFixBifunctor . WrapBifunctor . unFix

you can define gmap without any additional constraint on f:

gmap :: (Bifunctor f) => (a -> b) -> Fix (f a) -> Fix (f b)
gmap f = unwrapFixBifunctor . cata alg . wrapFixBifunctor
  where
    alg = inF . bimap f id

You can make Fix . f into a Functor via a newtype

We can implement a Functor instance for \a -> Fix (f a) by implementing this "type-level lambda" as a newtype:

newtype FixF f a = FixF{ unFixF :: Fix (f a) }

instance (Bifunctor f) => Functor (FixF f) where
    fmap f = FixF . gmap f . unFixF