How do I avoid writing this type of Haskell boilerplate code

Question

I run into this situation often enough for it to be annoying.

Let's say I have a sum type which can hold an instance of x or a bunch of other things unrelated to x -

data Foo x = X x | Y Int | Z String | ...(other constructors not involving x)

To declare a Functor instance I have to do this -

instance Functor Foo where
    fmap f (X x) = X (f x)
    fmap _ (Y y) = Y y
    fmap _ (Z z) = Z z
    ... And so on

Whereas what I would like to do is this -

instance Functor Foo where
    fmap f (X x) = X (f x)
    fmap _ a = a

i.e. I only care about the X constructor, all other constructors are simply "passed through". But of course this wouldn't compile because a on the left hand side is a different type from the a on the right hand side of the equation.

Is there a way I can avoid writing this boilerplate for the other constructors?

Answer 1

There are two main simple solutions to this.

First, for simple types, just deriving (Functor) it using the necessary extension.

The other solution is to define another data type:

data Bar = S String | B Bool | I Int  -- "Inner" type
data Foo a = X a | Q Bar              -- "Outer" type

instance Functor Foo where
    fmap f (X a) = X (f a)
    fmap _ (Q b) = Q b -- `b' requires no type change. 

So you can write one more line to remove many.

It's not exactly ideal for pattern matching, but it does at least solve this problem.

Answer 2

I assume that we'd like to have a solution for the general case where the changing type parameter is not necessarily in the right position for DeriveFunctor.

We can distinguish two cases.

In the simple case out data type is not recursive. Here, prisms are a fitting solution:

{-# LANGUAGE TemplateHaskell #-}

import Control.Lens

data Foo x y = X x | Y y | Z String

makePrisms ''Foo

mapOverX :: (x -> x') -> Foo x y -> Foo x' y
mapOverX = over _X

If our data is recursive, then things get more complicated. Now makePrisms doesn't create type-changing prisms. We can get rid of the recursion in the definition by factoring it out to an explicit fixpoint. This way our prisms remain type-changing:

import Control.Lens

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

-- k marks the recursive positions
-- so the original type would be "data Foo x y = ... | Two (Foo x y) (Foo x y)"
data FooF x y k = X x | Y y | Z String | Two k k deriving (Functor)

type Foo x y = Fix (FooF x y)

makePrisms ''FooF

mapOverX :: (x -> x') -> Foo x y -> Foo x' y
mapOverX f = 
   Fix .               -- rewrap 
   over _X f .         -- map f over X if possible
   fmap (mapOverX f) . -- map over recursively
   out                 -- unwrap

Or we can factor out the bottom-up transformation:

cata :: (Functor f) => (f a -> a) -> Fix f -> a
cata f = go where go = f . fmap go . out

mapOverX :: (x -> x') -> Foo x y -> Foo x' y
mapOverX f = cata (Fix . over _X f)

There's a sizeable literature on using fixpoints of functors for generic programming, and also a number of libraries, for example this or this. You might want to search for "recursion schemes" for further references.

Answer 3

Looks like a job for prisms.

Disclaimer: I'm a lens/prism newbie.

{-# LANGUAGE TemplateHaskell   #-}

import Control.Lens
import Control.Lens.Prism

data Foo x = X x | Y Int | Z String deriving Show

makePrisms ''Foo

instance Functor Foo where
   -- super simple impl, by András Kovács
   fmap = over _X
   -- My overly complicated idea
   --    fmap f = id & outside _X .~ (X . f)
   -- Original still more complicated implementation below
   --     fmap f (X x) = X (f x)
   --     fmap _ a = id & outside _X .~ undefined $ a

Usage:

*Main> fmap (++ "foo") (Y 3)
Y 3
*Main> fmap (++ "foo") (X "abc")
X "abcfoo"