How do I give a Functor instance to a datatype built for general recursion schemes?

Question

I have a recursive datatype which has a Functor instance:

data Expr1 a
  = Val1 a
  | Add1 (Expr1 a) (Expr1 a)
  deriving (Eq, Show, Functor)

Now, I'm interested in modifying this datatype to support general recursion schemes, as they are described in this tutorial and this Hackage package. I managed to get the catamorphism to work:

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

data ExprF a r
  = Val a
  | Add r r
  deriving (Eq, Show, Functor)

type Expr2 a = Fix (ExprF a)

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

eval :: Expr2 Int -> Int
eval = cata $ \case
  Val n -> n
  Add x y -> x + y

main :: IO ()
main =
  print $ eval
    (Fix (Add (Fix (Val 1)) (Fix (Val 2))))

But now I can't figure out how to give Expr2 the same functor instance that the original Expr had. It seems there is a kind mismatch when trying to define the functor instance:

instance Functor (Fix (ExprF a)) where
    fmap = undefined

Kind mis-match
    The first argument of `Functor' should have kind `* -> *',
    but `Fix (ExprF a)' has kind `*'
    In the instance declaration for `Functor (Fix (ExprF a))'

How do I write a Functor instance for Expr2?

I thought about wrapping Expr2 in a newtype with newtype Expr2 a = Expr2 (Fix (ExprF a)) but then this newtype needs to be unwrapped to be passed to cata, which I don't like very much. I also don't know if it would be possible to automatically derive the Expr2 functor instance like I did with Expr1.

Aflcio

I don't think it can be done like that, not with a type alias like you're trying to do. – Proselytize

@LouisWasserman: Assuming I do end up using a newtype for Expr2, is there a way to have the functor instance be derived automatically like I did with Expr1? – Aflcio

You can't have the functor instance derived automatically for something like newtype Expr a = Expr (Fix (ExprF a)) because Fix is not a functor. If you change it to data Fix f a = Fix (f (Fix f a)) then you can write a functor instance that looks like instance Functor f => Functor (Fix f) and you don't need a newtype. – Picasso

Answer 1

I wonder if you might be better off using the Free type:

data Free f a
  = Pure a
  | Wrap (f (Free f a))
deriving Functor

data ExprF r
  = Add r r
deriving Functor

This has the added benefit that there are quite a few libraries that work on free monads already, so maybe they'll save you some work.

Extraction

Excellent suggestion, IMHO. Just like container types, trees are Yet Another Monad Analogy, with return as "construct a singleton tree from an arbitrary value` and >>= as "replace leaf nodes with a subtree generated by applying a function to their contents." – Clea

Accepting this question because it gives the most stuff "for free" in this particular case where the a parameter only shows up on the leaves and doesn't need to use newtype wrappers. I guess the Bifunctor version is more general though. – Aflcio

Answer 2

This is an old sore for me. The crucial point is that your ExprF is functorial in both its parameters. So if we had

class Bifunctor b where
  bimap :: (x1 -> y1) -> (x2 -> y2) -> b x1 x2 -> b y1 y2

then you could define (or imagine a machine defining for you)

instance Bifunctor ExprF where
  bimap k1 k2 (Val a)    = Val (k1 a)
  bimap k1 k2 (Add x y)  = Add (k2 x) (k2 y)

and now you can have

newtype Fix2 b a = MkFix2 (b a (Fix2 b a))

accompanied by

map1cata2 :: Bifunctor b => (a -> a') -> (b a' t -> t) -> Fix2 b a -> t
map1cata2 e f (MkFix2 bar) = f (bimap e (map1cata2 e f) bar)

which in turn gives you that when you take a fixpoint in one of the parameters, what's left is still functorial in the other

instance Bifunctor b => Functor (Fix2 b) where
  fmap k = map1cata2 k MkFix2

and you sort of get what you wanted. But your Bifunctor instance isn't going to be built by magic. And it's a bit annoying that you need a different fixpoint operator and a whole new kind of functor. The trouble is that you now have two sorts of substructure: "values" and "subexpressions".

And here's the turn. There is a notion of functor which is closed under fixpoints. Turn on the kitchen sink (especially DataKinds) and

type s :-> t = forall x. s x -> t x

class FunctorIx (f :: (i -> *) -> (o -> *)) where
  mapIx :: (s :-> t) -> f s :-> f t

Note that "elements" come in a kind indexed over i and "structures" in a kind indexed over some other o. We take i-preserving functions on elements to o preserving functions on structures. Crucially, i and o can be different.

The magic words are "1, 2, 4, 8, time to exponentiate!". A type of kind * can easily be turned into a trivially indexed GADT of kind () -> *. And two types can be rolled together to make a GADT of kind Either () () -> *. That means we can roll both sorts of substructure together. In general, we have a kind of type level either.

data Case :: (a -> *) -> (b -> *) -> Either a b -> * where
  CL :: f a -> Case f g (Left a)
  CR :: g b -> Case f g (Right b)

equipped with its notion of "map"

mapCase :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g'
mapCase ff gg (CL fx) = CL (ff fx)
mapCase ff gg (CR gx) = CR (gg gx)

So we can refunctor our bifactors as Either-indexed FunctorIx instances.

And now we can take the fixpoint of any node structure f which has places for either elements p or subnodes. It's just the same deal we had above.

newtype FixIx (f :: (Either i o -> *) -> (o -> *))
              (p :: i -> *)
              (b :: o)
  = MkFixIx (f (Case p (FixIx f p)) b)

mapCata :: forall f p q t. FunctorIx f =>
  (p :-> q) -> (f (Case q t) :-> t) -> FixIx f p :-> t
mapCata e f (MkFixIx node) = f (mapIx (mapCase e (mapCata e f)) node)

But now, we get the fact that FunctorIx is closed under FixIx.

instance FunctorIx f => FunctorIx (FixIx f) where
  mapIx f = mapCata f MkFixIx

Functors on indexed sets (with the extra freedom to vary the index) can be very precise and very powerful. They enjoy many more convenient closure properties than Functors do. I don't suppose they'll catch on.

Radarscope

Answer 3

Nothing wrong with pigworker's answer, but maybe you can use a simpler one as a stepping-stone:

{-# LANGUAGE DeriveFunctor, ScopedTypeVariables #-}

import Prelude hiding (map)

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

-- This is the catamorphism function you hopefully know and love
-- already.  Generalizes 'foldr'.
cata :: Functor f => (f r -> r) -> Fix f -> r
cata phi = phi . fmap (cata phi) . unFix

-- The 'Bifunctor' class.  You can find this in Hackage, so if you
-- want to use this just use it from there.
--
-- Minimal definition: either 'bimap' or both 'first' and 'second'.
class Bifunctor f where
    bimap :: (a -> c) -> (b -> d) -> f a b -> f c d
    bimap f g = first f . second g

    first :: (a -> c) -> f a b -> f c b
    first f = bimap f id

    second :: (b -> d) -> f a b -> f a d
    second g = bimap id g

-- The generic map function.  I wrote this out with
-- ScopedTypeVariables to make it easier to read...
map :: forall f a b. (Functor (f a), Bifunctor f) => 
       (a -> b) -> Fix (f a) -> Fix (f b)
map f = cata phi 
    where phi :: f a (Fix (f b)) -> Fix (f b)
          phi = Fix . first f

Now your expression language works like this:

-- This is the base (bi)functor for your expression type.
data ExprF a r = Val a 
               | Add r r
               deriving (Eq, Show, Functor)

instance Bifunctor ExprF where
    bimap f g (Val a) = Val (f a)
    bimap f g (Add l r) = Add (g l) (g r)

newtype Expr a = Expr (Fix (ExprF a))

instance Functor Expr where
    fmap f (Expr exprF) = Expr (map f exprF)

EDIT: Here's a link to the bifunctors package in Hackage.

Clea

Interesting. This is very similar to the solution I had already stumbled upon, except that my implementation of map was much uglier because I didn't know about BiFunctors :) – Aflcio

Answer 4

The keyword type is used only as a synonymous of an existing type, maybe this is what you are looking for

newtype Expr2 a r = In { out :: (ExprF a r)} deriving Functor

Daisydaitzman