Sunday, December 31, 2017

N-ary Functors

update: Now available on hackage as n-ary-functor.

Functor and Bifunctor are both in base, but what about Trifunctor? Quadrifunctor? There must be a better solution than creating an infinite tower of typeclasses. Here's the API I managed to implement:

> nmap <#> (+1) <#> (+2) $ (0, 0)
(1,2)

> nmap <#> (+1) <#> (+2) <#> (+3) $ (0, 0, 0)
(1,2,3)

> nmap <#> (+1) <#> (+2) <#> (+3) <#> (+4) $ (0, 0, 0, 0)
(1,2,3,4)

The implementation is really short, too:

{-# LANGUAGE RankNTypes, TypeFamilies, TypeInType #-}
import Data.Kind

newtype NMap1 k (f :: Type -> k) (g :: Type -> k) = NMap1
  { (<#>) :: forall a b. (a -> b) -> NMap k (f a) (g b) }

type family NMap k :: k -> k -> Type where
  NMap Type        = (->)
  NMap (Type -> k) = NMap1 k

class NFunctor (f :: k) where
  nmap :: NMap k f f

Of course, the hard part is not writing the code, but figuring out what to write down. Let me show you how I got there.

Computing the Type from the Kind

Since Functor instances are given to type constructors of kind * -> *, and Bifunctor instances are given to type constructors of kind * -> * -> *, my idea was to compute the type of nmap from the kind of the type constructor to which it is applied. Something like this:

class NFunctor (f :: k) where
  nmap :: NMap k f

type family NMap k (f :: k) :: *
type instance NMap (* -> *) f
  = (a -> b) -> f a -> f b
type instance NMap (* -> * -> *) f
  = (a1 -> b1) -> (a2 -> b2) -> f a1 a2 -> f b1 b2
type instance NMap (* -> * -> * -> *) f
  = (a1 -> b1) -> (a2 -> b2) -> (a3 -> b3) -> f a1 a2 a3 -> f b1 b2 b3

Except of course with some recursive definition for NMap, so we don't have to spell out the type for every kind. Thinking of it in terms of recursion made me realize that the base case is kind *, not * -> *:

type instance NMap * f
  = f -> f

This corresponds to a "nullary Functor" typeclass, whose lawful instances have no choice but to use the identity function. So this isn't particularly useful as a typeclass, but it does lead to a nice recursive definition:

type family NMap k (f :: k) (g :: k) where
  NMap Type        a b = a -> b
  NMap (Type -> k) f g = (a -> b) -> NMap k (f a) (g b)

class NFunctor (f :: k) where
  nmap :: NMap k f f

I now have to use Type instead of * for some reason, otherwise I get a "malformed head" error.

Required Newtype Wrapper

Unfortunately, GHC does not accept that recursive definition. First of all, when defining a type family, type variables aren't implicitly universally-quantified like they are in type signatures, so I need to add an explicit forall quantifier:

type family NMap k (f :: k) (g :: k) where
  NMap Type        a b = a -> b
  NMap (Type -> k) f g = forall a b. (a -> b) -> NMap k (f a) (g b)

Now GHC reveals the real problem with the definition:

• Illegal polymorphic type:
    forall a b. (a -> b) -> NMap k (f a) (g b)
• In the equations for closed type family ‘NMap’
  In the type family declaration for ‘NMap’

This is a bummer: I am simply not allowed to use forall here. The usual workaround, when forall is needed but disallowed, is to define a newtype which performs the forall for us:

newtype NMap1 k (f :: Type -> k) (g :: Type -> k) = NMap1
  { runNMap1 :: forall a b. (a -> b) -> NMap k (f a) (g b) }

type family NMap k :: k -> k -> Type where
  NMap Type        = (->)
  NMap (Type -> k) = NMap1 k

This solves the problem, and even allows me to make my NMap definition more point-free!

Ergonomics

I now have a typeclass which generalizes Functor, Bifunctor, Trifunctor, etc., but what does using this typeclass look like? Writing instances requires a bit of boilerplate, but it's not too bad:

instance NFunctor Maybe where
  nmap = NMap1 fmap

instance NFunctor (,) where
  nmap = NMap1 $ \f1
      -> NMap1 $ \f2
      -> \(x1,x2)
      -> (f1 x1, f2 x2)

instance NFunctor (,,) where
  nmap = NMap1 $ \f1
      -> NMap1 $ \f2
      -> NMap1 $ \f3
      -> \(x1,x2,x3)
      -> (f1 x1, f2 x2, f3 x3)

instance NFunctor (,,,) where
  nmap = NMap1 $ \f1
      -> NMap1 $ \f2
      -> NMap1 $ \f3
      -> NMap1 $ \f4
      -> \(x1,x2,x3,x4)
      -> (f1 x1, f2 x2, f3 x3, f4 x4)

When calling nmap, however, the extra boilerplate quickly becomes annoying:

> runNMap1 nmap (+1) $ Just (0)
Just 1

> runNMap1 (runNMap1 nmap (+1)) (+2) (0, 0)
(1,2)

> runNMap1 (runNMap1 (runNMap1 nmap (+1)) (+2)) (+3) (0, 0, 0)
(1,2,3)

> runNMap1 (runNMap1 (runNMap1 (runNMap1 nmap (+1))
|                              (+2))
|                    (+3))
|          (+4)
|          (0, 0, 0, 0)
(1,2,3,4)

The fix is really simple though: by renaming runNMap1 to some left-associative infix operator, say (<#>), the code becomes much more readable!

> nmap <#> (+1) $ Just (0)
Just 1

> nmap <#> (+1) <#> (+2) $ (0, 0)
(1,2)

> nmap <#> (+1) <#> (+2) <#> (+3) $ (0, 0, 0)
(1,2,3)

> nmap <#> (+1) <#> (+2) <#> (+3) <#> (+4) $ (0, 0, 0, 0)
(1,2,3,4)

A Tempting Overlapping Instance

Pairs have both a Bifunctor and a Functor instance. Similarly, quadruples have four NFunctor instances, five if we count the glorified identity function:

-- |
-- >>> nmap <#> (+1) <#> (+2) <#> (+3) <#> (+4) $ (0, 0, 0, 0)
-- (1,2,3,4)
instance NFunctor (,,,) where
  nmap = NMap1 $ \f1
      -> NMap1 $ \f2
      -> NMap1 $ \f3
      -> NMap1 $ \f4
      -> \(x1,x2,x3,x4)
      -> (f1 x1, f2 x2, f3 x3, f4 x4)

-- |
-- >>> nmap <#> (+1) <#> (+2) <#> (+3) $ (0, 0, 0, 0)
-- (0,1,2,3)
instance NFunctor ((,,,) a) where
  nmap = NMap1 $ \f2
      -> NMap1 $ \f3
      -> NMap1 $ \f4
      -> \(x1,x2,x3,x4)
      -> (x1, f2 x2, f3 x3, f4 x4)

-- |
-- >>> nmap <#> (+1) <#> (+2) $ (0, 0, 0, 0)
-- (0,0,1,2)
instance NFunctor ((,,,) a b) where
  nmap = NMap1 $ \f3
      -> NMap1 $ \f4
      -> \(x1,x2,x3,x4)
      -> (x1, x2, f3 x3, f4 x4)

-- |
-- >>> nmap <#> (+1) $ (0, 0, 0, 0)
-- (0,0,0,1)
instance NFunctor ((,,,) a b c) where
  nmap = NMap1 $ \f4
      -> \(x1,x2,x3,x4)
      -> (x1, x2, x3, f4 x4)

-- |
-- >>> nmap (0, 0, 0, 0)
-- (0,0,0,0)
instance NFunctor ((,,,) a b c d) where
  nmap = \(x1,x2,x3,x4)
      -> (x1, x2, x3, x4)

But if we define the following magical instance:

{-# LANGUAGE FlexibleInstances #-}

instance NFunctor (f :: * -> k) => NFunctor (f a) where
  nmap = nmap <#> id

Then we get all five instances for the price of one!

-- |
-- >>> nmap <#> (+1) <#> (+2) <#> (+3) <#> (+4) $ (0, 0, 0, 0)
-- (1,2,3,4)
-- >>> nmap <#> (+1) <#> (+2) <#> (+3) $ (0, 0, 0, 0)
-- (0,1,2,3)
-- >>> nmap <#> (+1) <#> (+2) $ (0, 0, 0, 0)
-- (0,0,1,2)
-- >>> nmap <#> (+1) $ (0, 0, 0, 0)
-- (0,0,0,1)
-- >>> nmap (0, 0, 0, 0)
-- (0,0,0,0)
instance NFunctor (,,,) where
  nmap = NMap1 $ \f1
      -> NMap1 $ \f2
      -> NMap1 $ \f3
      -> NMap1 $ \f4
      -> \(x1,x2,x3,x4)
      -> (f1 x1, f2 x2, f3 x3, f4 x4)

The big problem with that magic instance is that it overlaps with other instances we would like to define. For example, we don't want to define the NFunctor instance for State s in terms of the NFunctor instance for State, because State is not functorial in s, so it doesn't have such an instance. Oh well.