This post is part of a series.

Open sum type

With some type-level hackery, we can define an open sum type in GHC which has the same internal representation as other sum types such as Either:

data Variant (types :: [*]) = Variant {-# UNPACK #-} !Word Any

type role Variant representational

The Word value is a tag (similar to a constructor tag) that indicates the actual type of the Any value by indexing into the types list. Given a type-level index n, we can get or set the value with the appropriate type:

-- | Set the value with the given indexed type
setVariantN :: forall (n :: Nat) (l :: [*]).  KnownNat n => Index n l -> Variant l
setVariantN a = Variant (natValue @n) (unsafeCoerce a)

-- | Get the value if it has the indexed type
getVariantN :: forall (n :: Nat) (l :: [*]). KnownNat n => Variant l -> Maybe (Index n l)
getVariantN (Variant t a) = do
   guard (t == natValue @n)
   return (unsafeCoerce a)

It means that where we would have written:

data A = A
data B = B
data C = C
data Error = ErrA A | ErrB B | ErrC C

err :: Error
err = ErrB B

main = case err of
   ErrC c -> doSomething c
   _      -> doSomethingElse

doSomething :: C -> ...

we can now write:

data A = A
data B = B
data C = C

err :: Variant '[A,B,C]
err = setVariantN @1 B            -- or better (see below): err = setVariant B

main = case getVariantN @2 err of -- or better: getVariant err
   Just c  -> doSomething c
   Nothing -> doSomethingElse

doSomething :: C -> ...

Notice how we don’t have to declare a new data type to multiplex A, B and C into a single type.

Open sum type operations

setVariantN and getVariantN are the most basic operations, but we have many more of them:

• set/get a variant value without specifying its index (the first matching type in the list is used):

v :: Variant '[Int,String,Double]
v = setVariant "Hi!"

s :: Maybe String
s = getVariant v

• prepend or append possible types to the variant type list:

v :: Variant '[Int,String,Double]

v2 :: Variant '[A,B,Int,String,Double]
v2 = prependVariant @'[A,B] v

v3 :: Variant '[Int,String,Double,A,B]
v3 = appendVariant @'[A,B] v

• lift a variant into another whose type list is a superset (in any order):

v :: Variant '[Int,String]
v = setVariant "Hi!"

v2 :: Variant '[String,Double,Int]
v2 = liftVariant v

• pick a value by index and get either a new variant or the picked value with the appropriate type:

v :: Variant '[Int,Double,String,Double,Float]
v = setVariant "Hi!"

> :type pickVariant @1 v
pickVariant @1 v :: Either (Variant '[Int, String, Double, Float]) Double

• catch any value of a given type and get either a new variant or the value with the appropriate type:

v :: Variant '[Int,Double,String,Double,Float]
v = setVariant "Hi!"

> :type catchVariant @Double v
catchVariant @Double v :: Either (Variant '[Int, String, Float]) Double

• update a variant:

v :: Variant '[Int,Double,String]
v = ...

f :: Double -> Float
f = ...

> :type updateVariantN @1 f v
updateVariantN @1 f v :: Variant '[Int,Float,String]

> :type updateVariant f v
updateVariant f v :: Variant '[Int,Float,String]

• update a variant by inserting a variant:

v :: Variant '[Int,Double,String]
v = ...

f :: Double -> Variant '[Float,Char]
f = ...

> :type updateVariantFoldN @1 f v
updateVariantFoldN @1 f v :: Variant '[Int,Float,Char,String]

> :type updateVariantFold f v
updateVariantFold f v :: Variant '[Int,Float,Char,String]

Various uses of Variant

In the following part we will see how to use Variant to solve control flow issues. But Variant proves to be also very useful in other contexts. For instance to handle heterogeneous collections of items:

data A = A deriving (Show,Eq,Ord)
data B = B deriving (Show,Eq,Ord)
data C = C deriving (Show,Eq,Ord)
data D = D deriving (Show,Eq,Ord)

type T = Variant '[A,B,C,D]

vs :: [T]
vs = [setVariant B, setVariant A, setVariant B, setVariant C]

In addition, a Variant can easily make use of the type class instances of its members. For instance, Show, Eq and Ord are supported by default:

> print vs
[B,A,B,C]

> vs == vs
True
> vs == reverse vs
False

> sort vs
[A,B,B,C]

Defining new instances for Variant is easy and quite efficient:

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}

class MyClass a where
   doSomething :: a -> IO ()

instance MyClass (Variant '[]) where
   {-# INLINE doSomething #-}
   doSomething = error "Empty variant"
   -- this instance is never used but is necessary for the type-checker

instance (MyClass (Variant xs), MyClass x) => MyClass (Variant (x ': xs)) where
   {-# INLINE doSomething #-}
   doSomething v = case headVariant v of
      Right x -> doSomething x
      Left xs -> doSomething xs

With the INLINE pragmas and -O2, GHC 8.0.1 compiles the following code:

v :: Variant '[A,B,C,D]
v = ...

main = doSomething v

into the following core (in pseudo-code):

main = case tag_of_v of
   0## -> doSomething (unsafeCoerce value_of_v :: A)
   t   -> case t -# 1## of
      0## -> doSomething (unsafeCoerce value_of_v :: B)
      t   -> case t -# 1## of
         0## -> doSomething (unsafeCoerce value_of_v :: C)
         t   -> case t -# 1## of
            0## -> doSomething (unsafeCoerce value_of_v :: D)
            _   -> error "Empty variant"

with my patch (see Trac #12877), GHC now produces the expected:

main = case tag_of_v of
   0## -> doSomething (unsafeCoerce value_of_v :: A)
   1## -> doSomething (unsafeCoerce value_of_v :: B)
   2## -> doSomething (unsafeCoerce value_of_v :: C)
   3## -> doSomething (unsafeCoerce value_of_v :: D)
   _   -> error "Empty variant"

I have started to use this approach for a renderer which uses a Scene data type parameterized by the types of the objects it can contain:

data Scene xs = Scene
   { sceneObjects :: [Variant xs]
   }

class Drawable t where
   draw :: Screen -> t -> IO ()

instance Drawable (Variant '[]) where
   draw = error "Empty variant"

instance (Drawable (Variant xs), Drawable x) => Drawable (Variant (x ': xs)) where
   draw s v = case headVariant v of
      Right x -> draw s x
      Left xs -> draw s xs

drawScene :: Drawable xs => Screen -> Scene xs -> IO ()
drawScene screen scene = traverse_ (draw screen) (sceneObjects scene)

The scene is abstract in the types of objects it can contain. We can use it as follows:

data Circle    = Circle Point Float
data Rectangle = Rectangle Point Point
data Image     = Image ...

instance Drawable Circle    where ...
instance Drawable Rectangle where ...
instance Drawable Image     where ...

scene :: Scene '[Rectangle,Circle,Image]
scene = Scene
   { sceneObjects = [...]
   }

main = drawScene screen scene

Compared to approaches with collections such as [forall a. Drawable a => a], we can get the objects out of the collection in a type-safe manner!

In the next part we see how to use Variant for control-flow.