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.