Control Flow in Haskell (2) - Variant
 Tags: Haskell, Variant December 12, 2016

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.