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)

Answer 3

The way I would do this at the type level is to map the phantom types to type level natural numbers and use a "minimum" operation to find the correct return type and then let instance resolution do the job from there on.

I'll be using type families here, but it can probably be done with functional dependencies if you prefer those.

{-# LANGUAGE TypeFamilies, EmptyDataDecls, FlexibleInstances #-}

First, we'll need some type level naturals and a minimum operation.

data Zero
data Succ n

type family Min a b
type instance Min Zero a = Zero
type instance Min a Zero = Zero
type instance Min (Succ a) (Succ b) = Succ (Min a b)

Next, we'll define our phantom types and provide mappings to and from our type level naturals:

data Second
data Minute
data Hour

type family ToIndex a
type instance ToIndex Hour = Succ (Succ Zero)
type instance ToIndex Minute = Succ Zero
type instance ToIndex Second = Zero

type family FromIndex a
type instance FromIndex (Succ (Succ Zero)) = Hour
type instance FromIndex (Succ Zero) = Minute
type instance FromIndex Zero = Second

Next, the Time type and Show instances. These are the same as in your original code.

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 

Just like in my ADT answer, we'll use seconds as the intermediate unit:

class Seconds a where
    toSeconds :: Time a -> Int
    fromSeconds :: Int -> Time a

instance Seconds Hour where
    toSeconds (Time x) = 3600 * x
    fromSeconds x = Time $ x `div` 3600

instance Seconds Minute where
    toSeconds (Time x) = 60 * x
    fromSeconds x = Time $ x `div` 60

instance Seconds Second where
    toSeconds (Time x) = x
    fromSeconds x = Time x

Now all that remains is to define the add function.

add :: (Seconds a, Seconds b, Seconds c,
       c ~ FromIndex (Min (ToIndex a) (ToIndex b)))
       => Time a -> Time b -> Time c
add x y = fromSeconds (toSeconds x + toSeconds y)

The magic happens in the type equality constraint, which makes sure that the correct return type is chosen.

This code can be used just like you wanted:

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

To add another unit, say Days, you only have to add instances for Show, FromIndex, ToIndex and Seconds, i.e. we've successfully avoided the quadratic explosion.

Answer 4

The first part cannot be done this way in Haskell 2010, because the restriction on instantiated types is that they be of the form

T t1 ... tn

where t1...tn are different type variables and that there is at most one instance pro type and class. In Frege, while the restrictions on the form of the type are lifted a bit, the crucial restriction remains at most one instance per class and type constructor. Here is a way to do the show-Part nevertheless:

module Test where

data Seconds = Seconds
data Minutes = Minutes
data Hours   = Hours

data Time u = Time Int

class TimeUnit u where
  verbose :: u -> String
  fromTime :: Time u -> u

instance TimeUnit Seconds where 
  verbose _  = "sec"
  fromTime _ = Seconds
instance TimeUnit Minutes where 
  verbose _   = "min"
  fromTime _  = Minutes
instance TimeUnit Hours   where 
  verbose _ = "hrs"
  fromTime _ = Hours

instance Show (TimeUnit u) => Time u where
  show (o@Time t) = t.show ++ verbose (fromTime o)

main _ = do
 println (Time 42 :: Time Seconds)
 println (Time 42 :: Time Minutes)
 println (Time 42 :: Time Hours)

The fromTime application forces the call site to construct an appropriate dictionary, so that a TimeUnit value can be made ex nihilo, or so it appears.

The same technique could be used to do the arithmetic between different Time types, by creating a factor that makes computations in the smallest unit possible.

Answer 5

Taking hammar's suggestion 1 step further, I'd say for this particular example, just eliminate the type stuff altogether, and use smart constructors instead.

newtype Time = Sec Int

instance Show Time where
  show (Sec n) = h ++ " hrs " ++ m ++ " min " ++ s ++ " sec"
    where h = ...
          m = ...
          s = ...

sec :: Int -> Time
sec = Sec

min :: Int -> Time
min = sec . (*60)

hr  :: Int -> Time
hr  = min . (*60)

add (Sec n) (Sec m) = Sec (n+m)

Of course, that's no fun, since it has no phantom types. Fun exercise: make lenses for hr, min, sec.

Answer 6

The instances are all fairly boilerplate. I'd say this is a case for Template Haskell (though I'll leave the explanation of how to do so to someone who's used it in anger).