代数数据类型 #

-- 使用data关键字定义
data Bool = True | False

-- Bool是类型名
-- True和False是数据构造器

-- 语法
data 类型名 = 构造器1 | 构造器2 | ...

-- 示例
data Direction = North | East | South | West

-- 使用
move :: Direction -> String
move North = "向北"
move East  = "向东"
move South = "向南"
move West  = "向西"

-- 枚举类型
data Day = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday

-- 模式匹配
isWeekend :: Day -> Bool
isWeekend Saturday = True
isWeekend Sunday = True
isWeekend _ = False

nextDay :: Day -> Day
nextDay Monday    = Tuesday
nextDay Tuesday   = Wednesday
nextDay Wednesday = Thursday
nextDay Thursday  = Friday
nextDay Friday    = Saturday
nextDay Saturday  = Sunday
nextDay Sunday    = Monday

-- 构造器可以携带数据
data Shape
    = Circle Double           -- 半径
    | Rectangle Double Double -- 宽 高
    | Triangle Double Double Double -- 三边

-- 计算面积
area :: Shape -> Double
area (Circle r) = pi * r * r
area (Rectangle w h) = w * h
area (Triangle a b c) = 
    let s = (a + b + c) / 2
    in sqrt (s * (s - a) * (s - b) * (s - c))

-- Maybe类型定义
data Maybe a = Nothing | Just a

-- 使用
safeDiv :: Int -> Int -> Maybe Int
safeDiv _ 0 = Nothing
safeDiv x y = Just (x `div` y)

-- 处理Maybe
fromMaybe :: a -> Maybe a -> a
fromMaybe def Nothing  = def
fromMaybe _   (Just x) = x

-- Either类型定义
data Either a b = Left a | Right b

-- 使用
safeDivEither :: Int -> Int -> Either String Int
safeDivEither _ 0 = Left "Division by zero"
safeDivEither x y = Right (x `div` y)

-- 处理Either
either :: (a -> c) -> (b -> c) -> Either a b -> c
either f _ (Left x)  = f x
either _ g (Right y) = g y

-- 积类型
data Point = Point Double Double

-- 使用
distance :: Point -> Point -> Double
distance (Point x1 y1) (Point x2 y2) = 
    sqrt ((x2 - x1)^2 + (y2 - y1)^2)

-- 创建
origin = Point 0 0
p1 = Point 3 4

-- 带类型参数的积类型
data Pair a b = Pair a b

-- 使用
pairSum :: Pair Int Int -> Int
pairSum (Pair x y) = x + y

-- 多态函数
swapPair :: Pair a b -> Pair b a
swapPair (Pair x y) = Pair y x

-- 多字段
data Person = Person String Int String
    -- 姓名 年龄 邮箱

-- 使用
getName :: Person -> String
getName (Person name _ _) = name

getAge :: Person -> Int
getAge (Person _ age _) = age

getEmail :: Person -> String
getEmail (Person _ _ email) = email

-- 记录语法
data Person = Person
    { personName  :: String
    , personAge   :: Int
    , personEmail :: String
    }

-- 创建
john :: Person
john = Person 
    { personName = "John"
    , personAge = 30
    , personEmail = "john@example.com"
    }

-- 自动生成访问函数
-- personName :: Person -> String
-- personAge :: Person -> Int
-- personEmail :: Person -> String

-- 更新记录
olderJohn :: Person
olderJohn = john { personAge = 31 }

-- 更新多个字段
updatedJohn :: Person
updatedJohn = john 
    { personAge = 31
    , personEmail = "john.doe@example.com"
    }

-- 模式匹配记录
showPerson :: Person -> String
showPerson Person { personName = name, personAge = age } = 
    name ++ " is " ++ show age ++ " years old"

-- 简写形式（变量名与字段名相同）
showPerson' :: Person -> String
showPerson' Person { personName, personAge } = 
    personName ++ " is " ++ show personAge ++ " years old"

-- 自定义列表
data List a = Nil | Cons a (List a)

-- 使用
listToList :: List a -> [a]
listToList Nil = []
listToList (Cons x xs) = x : listToList xs

listToList' :: [a] -> List a
listToList' [] = Nil
listToList' (x:xs) = Cons x (listToList' xs)

-- 二叉树
data Tree a = Leaf | Node a (Tree a) (Tree a)

-- 创建树
sampleTree :: Tree Int
sampleTree = Node 5 
    (Node 3 (Node 1 Leaf Leaf) (Node 4 Leaf Leaf))
    (Node 7 (Node 6 Leaf Leaf) (Node 8 Leaf Leaf))

-- 遍历
inorder :: Tree a -> [a]
inorder Leaf = []
inorder (Node x left right) = inorder left ++ [x] ++ inorder right

-- 深度
depth :: Tree a -> Int
depth Leaf = 0
depth (Node _ left right) = 1 + max (depth left) (depth right)

-- 数学表达式
data Expr 
    = Lit Int
    | Add Expr Expr
    | Mul Expr Expr
    | Sub Expr Expr
    | Div Expr Expr

-- 求值
eval :: Expr -> Maybe Int
eval (Lit n) = Just n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Mul e1 e2) = (*) <$> eval e1 <*> eval e2
eval (Sub e1 e2) = (-) <$> eval e1 <*> eval e2
eval (Div e1 e2) = 
    case eval e2 of
        Just 0  -> Nothing
        Just n2 -> (`div` n2) <$> eval e1
        Nothing -> Nothing

-- Maybe类型
data Maybe a = Nothing | Just a

-- 使用不同类型
maybeInt :: Maybe Int
maybeInt = Just 5

maybeString :: Maybe String
maybeString = Just "hello"

maybeNothing :: Maybe a
maybeNothing = Nothing

-- Either类型
data Either a b = Left a | Right b

-- 使用
eitherIntString :: Either Int String
eitherIntString = Left 42

eitherStringInt :: Either String Int
eitherStringInt = Right 100

-- 幻影类型（类型参数不在构造器中使用）
data Tagged tag a = Tagged a

-- 使用类型标记
data USD
data EUR

type Money currency = Tagged currency Double

usd :: Money USD
usd = Tagged 100.0

eur :: Money EUR
eur = Tagged 85.0

-- 编译时区分不同货币
-- addMoney :: Money a -> Money a -> Money a

-- 使用!标记严格字段
data StrictPair = StrictPair !Int !Int

-- 惰性版本
data LazyPair = LazyPair Int Int

-- 严格字段在构造时立即求值

{-# LANGUAGE BangPatterns #-}

-- 所有字段严格
data StrictData = StrictData
    { field1 :: !Int
    , field2 :: !String
    }

-- 或使用严格模式
strictFunction :: StrictData -> Int
strictFunction (StrictData !x !y) = x + length y

-- 自动派生类型类实例
data Color = Red | Green | Blue
    deriving (Show, Eq, Ord, Enum, Bounded)

-- Show
show Red  -- "Red"

-- Eq
Red == Green  -- False

-- Ord
Red < Green  -- True

-- Enum
succ Red  -- Green

-- Bounded
minBound :: Color  -- Red
maxBound :: Color  -- Blue

{-# LANGUAGE DeriveFunctor #-}

-- 自动派生Functor
data Tree a = Leaf a | Node (Tree a) (Tree a)
    deriving (Show, Functor)

-- 使用
tree = Node (Leaf 1) (Leaf 2)
fmap (*2) tree  -- Node (Leaf 2) (Leaf 4)

data Person = Person
    { name :: String
    , age  :: Int
    } deriving (Show, Eq, Ord)

-- Show
show (Person "John" 30)  -- "Person {name = \"John\", age = 30}"

-- Eq
Person "John" 30 == Person "John" 30  -- True

-- Ord（按字段顺序比较）
Person "Alice" 25 < Person "Bob" 30  -- True

-- 门状态
data DoorState = Opened | Closed | Locked
    deriving (Show, Eq)

-- 门
data Door = Door
    { doorState :: DoorState
    , doorCode  :: Maybe String
    }

-- 操作
openDoor :: Door -> Maybe Door
openDoor door@Door { doorState = Closed } = 
    Just door { doorState = Opened }
openDoor _ = Nothing

closeDoor :: Door -> Door
closeDoor door = door { doorState = Closed }

lockDoor :: String -> Door -> Maybe Door
lockDoor code door@Door { doorState = Closed } = 
    Just door { doorState = Locked, doorCode = Just code }
lockDoor _ _ = Nothing

-- 运算符
data Op = Add | Sub | Mul | Div
    deriving (Show, Eq)

-- 表达式
data Calc 
    = Number Double
    | Binary Op Calc Calc
    deriving (Show)

-- 求值
calc :: Calc -> Maybe Double
calc (Number n) = Just n
calc (Binary Add c1 c2) = (+) <$> calc c1 <*> calc c2
calc (Binary Sub c1 c2) = (-) <$> calc c1 <*> calc c2
calc (Binary Mul c1 c2) = (*) <$> calc c1 <*> calc c2
calc (Binary Div c1 c2) = 
    case calc c2 of
        Just 0 -> Nothing
        Just n -> (/ n) <$> calc c1
        Nothing -> Nothing

-- 简化的JSON类型
data Json
    = JsonNull
    | JsonBool Bool
    | JsonNumber Double
    | JsonString String
    | JsonArray [Json]
    | JsonObject [(String, Json)]
    deriving (Show, Eq)

-- 示例
sampleJson :: Json
sampleJson = JsonObject
    [ ("name", JsonString "John")
    , ("age", JsonNumber 30)
    , ("active", JsonBool True)
    , ("tags", JsonArray [JsonString "haskell", JsonString "functional"])
    ]