I shall present first the currently standard way of handling open sums. I do it for plain non-indexed functors for the sake of simplicity and because the construction is the same for indexed ones. Then I'll introduce some enhancements enabled by GHC 8.

First, we define n-ary functor sums as a GADT indexed by a list of functors. This is more convenient and cleaner than using binary sums.

{-# language RebindableSyntax, TypeInType, TypeApplications, AllowAmbiguousTypes, GADTs, TypeFamilies, ScopedTypeVariables, UndecidableInstances, LambdaCase, EmptyCase, TypeOperators, ConstraintKinds, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} import Data.Kind data NS :: [* -> *] -> * -> * where Here :: f x -> NS (f ': fs) x There :: NS fs x -> NS (f ': fs) x instance Functor (NS '[]) where fmap _ = \case {} instance (Functor f, Functor (NS fs)) => Functor (NS (f ': fs)) where fmap f (Here fx) = Here (fmap f fx) fmap f (There ns) = There (fmap f ns)

Projecting and injecting can be either done

Directly with a class, but this needs overlapping or incoherent instances.

Indirectly, first computing the index of the element where we'd like to inject, then using the (natural number) index to define class instances without overlapping.

The latter solution is the preferable one, so let's see that:

data Nat = Z | S Nat type family Find (x :: a) (xs :: [a]) :: Nat where Find x (x ': xs) = Z Find x (y ': xs) = S (Find x xs) class Elem' (n :: Nat) (f :: * -> *) (fs :: [* -> *]) where inj' :: forall x. f x -> NS fs x prj' :: forall x. NS fs x -> Maybe (f x) instance (gs ~ (f ': gs')) => Elem' Z f gs where inj' = Here prj' (Here fx) = Just fx prj' _ = Nothing instance (Elem' n f gs', (gs ~ (g ': gs'))) => Elem' (S n) f gs where inj' = There . inj' @n prj' (Here _) = Nothing prj' (There ns) = prj' @n ns type Elem f fs = (Functor (NS fs), Elem' (Find f fs) f fs) inj :: forall fs f x. Elem f fs => f x -> NS fs x inj = inj' @(Find f fs) prj :: forall f x fs. Elem f fs => NS fs x -> Maybe (f x) prj = prj' @(Find f fs)

Now in ghci:

> :t inj @[Maybe, []] (Just True) inj @[Maybe, []] (Just True) :: NS '[Maybe, []] Bool

However, our Find type family is somewhat problematic because its reduction is often blocked by type variables. GHC disallows branching on inequality of type variables, because unification can possibly instantiate different variables to equal types later (and making premature decisions based on inequality can lead to loss of solutions).

For example:

> :kind! Find Maybe [Maybe, []] Find Maybe [Maybe, []] :: Nat = 'Z -- this works > :kind! forall (a :: *)(b :: *). Find (Either b) [Either a, Either b] forall (a :: *)(b :: *). Find (Either b) [Either a, Either b] :: Nat = Find (Either b) '[Either a, Either b] -- this doesn't

In the second example GHC doesn't commit to the inequality of a and b so it can't step over the first list element.

This historically caused rather annoying type inference deficiencies in Data Types a la Carte and extensible effects libraries. For example, even if we have just a single State s effect in a functor sum, writing (x :: n) <- get in a context where only Num n is known results in type inference failure, because GHC can't compute the index of the State effect when the state parameter is a type variable.

However, with GHC 8 we can write a significantly more powerful Find type family, which looks into type expressions to see if there's a unique possible position index. For example, if we're trying to find a State s effect, if there's only a single State in the effect list, we can safely return its position without looking at the s parameter, and subsequently GHC will be able to unify s with the other state parameter contained in the list.

First, we need a generic traversal of type expressions:

import Data.Type.Bool data Entry = App | forall a. Con a type family (xs :: [a]) ++ (ys :: [a]) :: [a] where '[] ++ ys = ys (x ': xs) ++ ys = x ': (xs ++ ys) type family Preord (x :: a) :: [Entry] where Preord (f x) = App ': (Preord f ++ Preord x) Preord x = '[ Con x]

Preord converts an arbitrary type into a list of its sub-expressions in preorder. App denotes the places where type constructor application occurs. For example:

> :kind! Preord (Maybe Int) Preord (Maybe Int) :: [Entry] = '['App, 'Con Maybe, 'Con Int] > :kind! Preord [Either String, Maybe] Preord [Either String, Maybe] :: [Entry] = '['App, 'App, 'Con (':), 'App, 'Con Either, 'App, 'Con [], 'Con Char, 'App, 'App, 'Con (':), 'Con Maybe, 'Con '[]]

After this, writing the new Find is just a matter of functional programming. My implementation below converts the list of types into a list of index-traversal pairs, and successively filters out entries from the list by comparing the traversals of the list elements and the to-be-found element.

type family (x :: a) == (y :: b) :: Bool where x == x = True _ == _ = False type family PreordList (xs :: [a]) (i :: Nat) :: [(Nat, [Entry])] where PreordList '[] _ = '[] PreordList (a ': as) i = '(i, Preord a) ': PreordList as (S i) type family Narrow (e :: Entry) (xs :: [(Nat, [Entry])]) :: [(Nat, [Entry])] where Narrow _ '[] = '[] Narrow e ('(i, e' ': es) ': ess) = If (e == e') '[ '(i, es)] '[] ++ Narrow e ess type family Find_ (es :: [Entry]) (ess :: [(Nat, [Entry])]) :: Nat where Find_ _ '[ '(i, _)] = i Find_ (e ': es) ess = Find_ es (Narrow e ess) type Find x ys = Find_ (Preord x) (PreordList ys Z)

Now we have:

> :kind! forall (a :: *)(b :: *). Find (Either a) [Maybe, [], Either b] forall (a :: *)(b :: *). Find (Either a) [Maybe, [], Either b] :: Nat = 'S ('S 'Z)

This Find can be used in any code involving open sums, and it works for indexed and non-indexed types all the same.

Here's some example code with the kind of injection/projection presented above, for non-indexed extensible effects.