How to avoid quadratic explosion of typeclass instances?

Question

Consider:

{-# OPTIONS -fglasgow-exts #-}

data Second = Second
data Minute = Minute
data Hour = Hour

-- Look Ma', a phantom type!
data Time a = Time Int

instance Show (Time Second) where
  show (Time t) = show t ++ "sec" 

instance Show (Time Minute) where
  show (Time t) = show t ++ "min" 

instance Show (Time Hour) where
  show (Time t) = show t ++ "hrs" 

sec :: Int -> Time Second
sec t = Time t

minute :: Int -> Time Minute
minute t = Time t 

hour :: Int -> Time Hour
hour t = Time t 

class TimeAdder a b c | a b -> c where
  add :: Time a -> Time b -> Time c

instance TimeAdder Second Second Second where
  add (Time s1) (Time s2) = sec (s1 + s2)

instance TimeAdder Second Minute Second where
  add (Time s) (Time m) = sec (s + 60*m)

instance TimeAdder Second Hour Second where
  add (Time s) (Time h) = sec (s + 3600*h)

instance TimeAdder Minute Second Second where
  add (Time m) (Time s) = sec (60*m + s)

instance TimeAdder Minute Minute Minute where
  add (Time m1) (Time m2) = minute (m1 + m2)

instance TimeAdder Minute Hour Minute where
  add (Time m) (Time h) = minute (m + 60*h)

instance TimeAdder Hour Second Second where
  add (Time h) (Time s) = sec (3600*h + s)

instance TimeAdder Hour Minute Minute where
  add (Time h) (Time m) = minute (60*h + m)

instance TimeAdder Hour Hour Hour where
  add (Time h1) (Time h2) = hour (h1 + h2)

add (minute 5) (hour 2)
--125min

Although I'm quite thrilled that crazy stuff like this works, I wonder how the quadratic explosion of TimeAdder instances could be avoided.

Answer 1

Unless you have a good reason to, I would just skip the type classes and use a plain old ADT:

data Time = Hour Int | Minute Int | Second Int

instance Show Time where
  show (Hour x) = show x ++ "hrs"
  show (Minute x) = show x ++ "min"
  show (Second x) = show x ++ "sec"

add x y = fromSeconds (toSeconds x + toSeconds y)

toSeconds (Hour x) = 3600 * x
toSeconds (Minute x) = 60 * x
toSeconds (Second x) = x

fromSeconds x | mod x 3600 == 0 = Hour (div x 3600)
              | mod x 60 == 0 = Minute (div x 60)
              | otherwise = Second x

This has the advantage of being able to do certain simplifications that the type class approach can't, for example:

> add (Second 18) (Second 42)
1min

Answer 2

You could do something like this, but it doesn't give you the functional dependency.

class TimeUnit a where
    toSeconds :: a -> Int
    fromSeconds :: Int -> a

instance TimeUnit (Time Second) where toSeconds = id; fromSeconds = id
instance TimeUnit (Time Minute) where toSeconds = (* 60); fromSeconds = (`quot` 60)

class TimeAdd a b c where
    add :: a -> b -> c

instance (TimeUnit a, TimeUnit b, TimeUnit c) => TimeAdd a b c where
    add a b = fromSeconds (toSeconds a + toSeconds b)