Question

Context

I’m writing a Haskell module that represents SI prefixes:

module Unit.SI.Prefix where

Each SI prefix has a corresponding data type:

data Kilo = Kilo deriving Show
data Mega = Mega deriving Show
data Giga = Giga deriving Show
data Tera = Tera deriving Show

-- remaining prefixes omitted for brevity

Problem

I would like to write a function that, when applied with two SI prefixes, determines statically which of the two prefixes is smaller. For example:

-- should compile:
test1 = let Kilo = smaller Kilo Giga in ()
test2 = let Kilo = smaller Giga Kilo in ()

-- should fail to compile:
test3 = let Giga = smaller Kilo Giga in ()
test4 = let Giga = smaller Giga Kilo in ()

Initial Solution

Here’s a solution that uses a type class together with a functional dependency:

{-# LANGUAGE FunctionalDependencies #-}                                                                                         
{-# LANGUAGE MultiParamTypeClasses #-}

class Smaller a b c | a b -> c where smaller :: a -> b -> c

instance Smaller Kilo Kilo Kilo where smaller Kilo Kilo = Kilo
instance Smaller Kilo Mega Kilo where smaller Kilo Mega = Kilo
instance Smaller Kilo Giga Kilo where smaller Kilo Giga = Kilo
instance Smaller Kilo Tera Kilo where smaller Kilo Tera = Kilo

instance Smaller Mega Kilo Kilo where smaller Mega Kilo = Kilo
instance Smaller Mega Mega Mega where smaller Mega Mega = Mega
instance Smaller Mega Giga Mega where smaller Mega Giga = Mega
instance Smaller Mega Tera Mega where smaller Mega Tera = Mega

instance Smaller Giga Kilo Kilo where smaller Giga Kilo = Kilo
instance Smaller Giga Mega Mega where smaller Giga Mega = Mega
instance Smaller Giga Giga Giga where smaller Giga Giga = Giga
instance Smaller Giga Tera Giga where smaller Giga Tera = Giga

instance Smaller Tera Kilo Kilo where smaller Tera Kilo = Kilo
instance Smaller Tera Mega Mega where smaller Tera Mega = Mega
instance Smaller Tera Giga Giga where smaller Tera Giga = Giga
instance Smaller Tera Tera Tera where smaller Tera Tera = Tera

The above solution appears to solve the problem correctly, however it has a downside: the number of type class instances is quadratic w.r.t. the number of types.

Question

Is there any way to reduce the number of type class instances to be linear w.r.t. the number of types, perhaps by exploiting symmetry?

It may be that it’s more appropriate to use Template Haskell here, in which case, feel free to suggest that as a solution.

Thanks!

Answer 1

It could probably be argued that TH is more appropriate in cases like this. That said, I’ll do it with types anyhow.

The problem here is that everything is too discrete. You can’t iterate through the prefixes to find the right one, and you’re not expressing the transitivity of the ordering you want. We can solve it by either route.

For a recursive solution, we first create natural numbers and boolean values at the type level:

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}

data No = No deriving (Show)
data Yes = Yes deriving (Show)

newtype S nat = Succ nat deriving (Show)
data Z = Zero deriving (Show)

type Zero  = Z
type One   = S Zero
type Two   = S One
type Three = S Two

A bit of simple arithmetic:

type family Plus x y :: *
type instance Plus x Z = x
type instance Plus Z y = y
type instance Plus (S x) (S y) = S (S (Plus x y))

type family Times x y :: *
type instance Times x Z = Z
type instance Times x (S y) = Plus x (Times y x)

A “less than or equal to” predicate, and a simple conditional function:

type family IsLTE n m :: *
type instance IsLTE Z Z = Yes
type instance IsLTE (S m) Z = No
type instance IsLTE Z (S n) = Yes
type instance IsLTE (S m) (S n) = IsLTE m n

type family IfThenElse b t e :: *
type instance IfThenElse Yes t e = t
type instance IfThenElse No t e = e

And conversions from the SI prefixes to the magnitude they represent:

type family Magnitude si :: *
type instance Magnitude Kilo = Three
type instance Magnitude Mega = Three `Times` Two
type instance Magnitude Giga = Three `Times` Three

…etc.

Now, to find the smaller prefix, you can do this:

type family Smaller x y :: *
type instance Smaller x y = IfThenElse (Magnitude x `IsLTE` Magnitude y) x y

Given that everything here has a one-to-one correspondence between the type and the single nullary constructor inhabiting it, this can be translated to the term level using a generic class like this:

class TermProxy t where term :: t
instance TermProxy No where term = No
instance TermProxy Yes where term = Yes
{- More instances here... -}

smaller :: (TermProxy a, TermProxy b) => a -> b -> Smaller a b
smaller _ _ = term

Filling in the details as needed.

---

The other approach involves using functional dependencies and overlapping instances to write a generic instance to fill in gaps–so you could write specific instances for Kilo < Mega, Mega < Giga, etc. and let it deduce that this implies Kilo < Giga as well.

This gets deeper into treating functional dependencies as what they are–a primitive logic programming language. If you’ve ever used Prolog, you should have the rough idea. In some ways this is nice, because you can let the compiler figure things out based on a more declarative approach. On the other hand it’s also kind of terrible because…

• Instances are chosen without looking at constraints, only the instance head.
• There’s no backtracking to search for a solution.
• To express this sort of thing you have to turn on UndecidableInstances because of GHC’s very conservative rules about what it knows will terminate; but you then have to take care not to send the type checker into an infinite loop. For instance, it would be very easy to do that by accident given instances like Smaller Kilo Kilo Kilo and something like (Smaller a s c, Smaller t b s) => Smaller a b c–think about why.

Fundeps and overlapping instances are strictly more powerful than type families, but they’re clumsier to use overall, and feel somewhat out of place compared to the more functional, recursive style the latter uses.

---

Oh, and for completeness’ sake, here’s a third approach: This time, we’re abusing the extra power that overlapping instances gives us to implement a recursive solution directly, rather than by converting to natural numbers and using structural recursion.

First, reify the desired ordering as a type-level list:

data MIN = MIN deriving (Show)
data MAX = MAX deriving (Show)

infixr 0 :<
data a :< b = a :< b deriving (Show)

siPrefixOrd :: MIN :< Kilo :< Mega :< Giga :< Tera :< MAX
siPrefixOrd = MIN :< Kilo :< Mega :< Giga :< Tera :< MAX

Implement an equality predicate on types, using some overlapping shenanigans:

class (TypeEq' () x y b) => TypeEq x y b where typeEq :: x -> y -> b
instance (TypeEq' () x y b) => TypeEq x y b where typeEq _ _ = term

class (TermProxy b) => TypeEq' q x y b | q x y -> b
instance (b ~ Yes) => TypeEq' () x x b 
instance (b ~ No) => TypeEq' q x y b 

The alternate “is less than” class, with the two easy cases:

class IsLTE a b o r | a b o -> r where
    isLTE :: a -> b -> o -> r

instance (IsLTE a b o r) => IsLTE a b (MIN :< o) r where
    isLTE a b (_ :< o) = isLTE a b o

instance (No ~ r) => IsLTE a b MAX r where
    isLTE _ _ MAX = No

And then the recursive case, with an auxiliary class used to defer the recursive step based on case analysis of the type-level boolean:

instance ( TypeEq a x isA, TypeEq b x isB
         , IsLTE' a b isA isB o r
         ) => IsLTE a b (x :< o) r where
    isLTE a b (x :< o) = isLTE' a b (typeEq a x) (typeEq b x) o

class IsLTE' a b isA isB xs r | a b isA isB xs -> r where
    isLTE' :: a -> b -> isA -> isB -> xs -> r

instance (Yes ~ r) => IsLTE' a b Yes Yes xs r where isLTE' a b _ _ _ = Yes
instance (Yes ~ r) => IsLTE' a b Yes No xs r where isLTE' a b _ _ _ = Yes
instance (No ~ r) => IsLTE' a b No Yes xs r where isLTE' a b _ _ _ = No
instance (IsLTE a b xs r) => IsLTE' a b No No xs r where
    isLTE' a b _ _ xs = isLTE a b xs

In essence, this takes a type-level list and two arbitrary types, then walks down the list and returns Yes if it finds the first type, or No if it finds the second type or hits the end of the list.

This is actually kind of buggy (you can see why if you think about what happens if one or both types aren’t in the list), as well as prone to failing–direct recursion like this uses a context reduction stack in GHC that is very shallow, so it’s easy to exhaust it and get a type-level stack overflow (ha ha, yes, the joke writes itself) instead of the answer you wanted.