自定义类型类 #

-- 使用class定义类型类
class ClassName a where
    methodName :: TypeSignature
    methodName = defaultImplementation  -- 可选默认实现

-- 定义一个可描述的类型类
class Describable a where
    describe :: a -> String

-- 实现实例
instance Describable Bool where
    describe True  = "True: yes"
    describe False = "False: no"

instance Describable Int where
    describe n = "Int: " ++ show n

-- 使用
describe True   -- "True: yes"
describe 42     -- "Int: 42"

-- 多个方法的类型类
class Serializable a where
    serialize   :: a -> String
    deserialize :: String -> a

-- 实现实例
instance Serializable Bool where
    serialize True  = "true"
    serialize False = "false"
    deserialize "true"  = True
    deserialize "false" = False
    deserialize _       = error "Invalid boolean"

-- 默认实现
class Eq a where
    (==) :: a -> a -> Bool
    (/=) :: a -> a -> Bool
    
    -- 默认实现
    x == y = not (x /= y)
    x /= y = not (x == y)

-- 实现时只需实现一个
instance Eq Bool where
    True  == True  = True
    False == False = True
    _     == _     = False
    -- (/=) 使用默认实现

-- 相互依赖
class Comparable a where
    compare :: a -> a -> Ordering
    (<) :: a -> a -> Bool
    (>) :: a -> a -> Bool
    
    -- 默认实现
    x < y = compare x y == LT
    x > y = compare x y == GT

-- 只需实现compare
instance Comparable Int where
    compare x y
        | x < y     = LT
        | x > y     = GT
        | otherwise = EQ

-- 类型类继承
class Eq a => Ord a where
    compare :: a -> a -> Ordering
    (<) :: a -> a -> Bool
    -- ...

-- Ord继承Eq
-- 实现Ord必须先实现Eq

-- 多重继承
class (Show a, Eq a) => PrintableEq a where
    printEq :: a -> a -> String
    printEq x y = 
        if x == y 
            then show x ++ " equals " ++ show y
            else show x ++ " not equals " ++ show y

-- 实现PrintableEq需要先实现Show和Eq
instance PrintableEq Int  -- 使用派生

-- 层次结构
class Eq a where ...

class Eq a => Ord a where ...

class Ord a => Enum a where ...

-- 实现Enum需要先实现Ord和Eq

-- 单参数
class Functor f where
    fmap :: (a -> b) -> f a -> f b

-- 实现Functor
instance Functor Maybe where
    fmap _ Nothing  = Nothing
    fmap f (Just x) = Just (f x)

instance Functor [] where
    fmap = map

{-# LANGUAGE MultiParamTypeClasses #-}

-- 多参数类型类
class Convert a b where
    convert :: a -> b

-- 实现
instance Convert Int Double where
    convert = fromIntegral

instance Convert String Int where
    convert = read

-- 使用
convert (42 :: Int) :: Double  -- 42.0

{-# LANGUAGE FunctionalDependencies #-}

-- 类型依赖
class Collection c e | c -> e where
    empty  :: c
    insert :: e -> c -> c
    member :: e -> c -> Bool

-- c -> e 表示c决定e
-- 例如：Set Int 决定元素类型是 Int

-- 定义大小类型类
class Sizeable a where
    size :: a -> Int
    isEmpty :: a -> Bool
    isEmpty x = size x == 0

-- 实现实例
instance Sizeable [a] where
    size = length

instance Sizeable (Maybe a) where
    size Nothing  = 0
    size (Just _) = 1

instance Sizeable (Either a b) where
    size (Left _)  = 1
    size (Right _) = 1

-- 验证类型类
class Validatable a where
    validate :: a -> Maybe String  -- Nothing表示有效

-- 用户数据
data User = User
    { userName :: String
    , userAge  :: Int
    }

instance Validatable User where
    validate (User name age)
        | null name        = Just "Name cannot be empty"
        | age < 0          = Just "Age cannot be negative"
        | age > 150        = Just "Age is too high"
        | otherwise        = Nothing

-- 编码类型类
class Encodable a where
    encode :: a -> String
    decode :: String -> Maybe a

-- 实现Bool编码
instance Encodable Bool where
    encode True  = "1"
    encode False = "0"
    decode "1" = Just True
    decode "0" = Just False
    decode _   = Nothing

-- 实现Int编码
instance Encodable Int where
    encode = show
    decode s = case reads s of
        [(n, "")] -> Just n
        _         -> Nothing

-- 向量类型类
class Vector v where
    zero :: v
    add :: v -> v -> v
    scale :: Double -> v -> v
    dot :: v -> v -> Double

-- 二维向量
data Vec2 = Vec2 Double Double

instance Vector Vec2 where
    zero = Vec2 0 0
    add (Vec2 x1 y1) (Vec2 x2 y2) = Vec2 (x1 + x2) (y1 + y2)
    scale s (Vec2 x y) = Vec2 (s * x) (s * y)
    dot (Vec2 x1 y1) (Vec2 x2 y2) = x1 * x2 + y1 * y2

{-# LANGUAGE TypeFamilies #-}

-- 关联类型
class Container c where
    type Element c
    empty :: c
    insert :: Element c -> c -> c
    getElements :: c -> [Element c]

-- 实现
instance Container [a] where
    type Element [a] = a
    empty = []
    insert = (:)
    getElements = id

instance Container (Maybe a) where
    type Element (Maybe a) = a
    empty = Nothing
    insert x _ = Just x
    getElements Nothing  = []
    getElements (Just x) = [x]

{-# LANGUAGE TypeFamilies #-}

-- 关联数据类型
class Expression e where
    data Value e
    evaluate :: e -> Value e

-- 实现
instance Expression Int where
    data Value Int = IntValue Int
    evaluate = IntValue

instance Expression Bool where
    data Value Bool = BoolValue Bool
    evaluate = BoolValue

-- 指定最小实现
class Eq a where
    (==) :: a -> a -> Bool
    (/=) :: a -> a -> Bool
    
    x == y = not (x /= y)
    x /= y = not (x == y)
    
    {-# MINIMAL (==) | (/=) #-}
    -- 只需实现其中一个

-- 类型类名：大写开头，形容词或名词
class Serializable a where ...
class Comparable a where ...
class Container a where ...

-- 方法名：小写开头，动词
class Serializable a where
    serialize :: a -> String
    deserialize :: String -> Maybe a

-- 好：单一职责
class Show a where
    show :: a -> String

-- 不好：太多不相关方法
class BadClass a where
    show :: a -> String
    eq :: a -> a -> Bool
    add :: a -> a -> a

-- 好：提供合理的默认实现
class Eq a where
    (==) :: a -> a -> Bool
    (/=) :: a -> a -> Bool
    x /= y = not (x == y)  -- 默认实现