Как избежать квадратичного взрыва экземпляров typeclass?

Рассмотрим:

{-# 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

Хотя я очень рад, что такие сумасшедшие вещи, как это работает, интересно, как избежать квадратичного взрыва экземпляров TimeAdder.

Ответы

Ответ 1

Вы можете сделать что-то подобное, но это не дает вам функциональной зависимости.

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)

Ответ 2

Если у вас нет веских оснований, я бы просто пропустил классы классов и использовал простой старый 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

Это имеет то преимущество, что можно сделать некоторые упрощения, которые не могут быть применимы к типу классов типов, например:

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

Ответ 3

То, как я буду делать это на уровне уровня, состоит в том, чтобы сопоставить типы phantom для ввода натуральных чисел уровня и использовать "минимальную" операцию, чтобы найти правильный тип возвращаемого значения, а затем позволить разрешение экземпляра выполнять задание оттуда.

Я буду использовать семейства типов здесь, но, возможно, это возможно с функциональными зависимостями, если вы предпочитаете их.

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

Во-первых, нам понадобятся некоторые типы уровней и минимальная операция.

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)

Далее мы определим наши типы phantom и предоставим сопоставления к и от нашего уровня 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

Далее, экземпляры Time и Show. Они те же, что и в исходном коде.

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 

Как и в моем ответе ADT, мы будем использовать секунды в качестве промежуточной единицы:

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

Теперь остается только определить функцию add.

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)

Магия происходит в ограничении равенства типа, которое гарантирует правильный тип возвращаемого типа.

Этот код можно использовать так, как вы хотели:

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

Чтобы добавить другое устройство, скажем Days, вам нужно добавить экземпляры для Show, FromIndex, ToIndex и Seconds, т.е. мы успешно избегали квадратичного взрыва.

Ответ 4

Первая часть не может быть выполнена таким образом в Haskell 2010, потому что ограничение на экземплярные типы состоит в том, что они имеют вид

T t1 ... tn

где t1... tn - разные переменные типа и что существует не более одного типа pro type и class. В Frege, в то время как ограничения на форму типа немного подняты, решающее ограничение остается не более одного экземпляра для каждого класса и типа конструктор. Вот как сделать шоу-часть тем не менее:

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 ([email protected] t) = t.show ++ verbose (fromTime o)

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

Приложение fromTime заставляет сайт вызова создавать соответствующий словарь, так что значение TimeUnit может быть выполнено ex nihilo, или так оно появляется.

Такую же технику можно использовать для выполнения арифметики между различными типами времени, создавая фактор, который делает возможными вычисления в наименьшей единице.

Ответ 5

Взяв предложение hammar еще на один шаг, я бы сказал, что для этого конкретного примера просто исключите материал типа и вместо этого используйте умные конструкторы.

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)

Конечно, это не забавно, так как у него нет типов phantom. Удовольствие: сделайте объективы для hr, min, sec.

Ответ 6

Экземпляры все довольно условно. Я бы сказал, что это пример шаблона Haskell (хотя я оставлю объяснение, как это сделать с тем, кто использовал его в гневе).