如何避免类型类实例的二次爆炸？

Question

考虑:

{-# 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避免实例的二次爆炸.

Answer 1

除非你有充分的理由,否则我会跳过类型类并使用普通的旧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

Answer 2

你可以做这样的事情,但它没有给你功能依赖.

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

我在类型级别执行此操作的方法是将幻像类型映射到类型级别自然数,并使用"最小"操作来查找正确的返回类型,然后让实例解析从那里开始执行作业.

我将在这里使用类型系列,但如果您愿意,可以使用函数依赖项.

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

接下来,我们将定义我们的幻像类型,并提供与我们的类型级自然的映射:

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,也就是,我们成功地避免了二次爆炸.