模式匹配 #

-- 基本模式匹配
isZero :: Int -> Bool
isZero 0 = True
isZero _ = False

-- 函数定义顶部
head' :: [a] -> a
head' (x:_) = x

-- case表达式
describe x = case x of
    0 -> "zero"
    1 -> "one"
    _ -> "other"

-- let绑定中
let (a, b) = (1, 2) in a + b

-- 从上到下匹配
-- 第一个匹配的模式会被使用
describe :: Int -> String
describe 0 = "zero"
describe 1 = "one"
describe 2 = "two"
describe _ = "other"

-- Maybe类型匹配
maybeToList :: Maybe a -> [a]
maybeToList Nothing  = []
maybeToList (Just x) = [x]

-- Either类型匹配
safeDivide :: Int -> Int -> Either String Int
safeDivide _ 0 = Left "Division by zero"
safeDivide x y = Right (x `div` y)

-- 定义数据类型
data Shape = Circle Double | Rectangle Double Double

-- 面积计算
area :: Shape -> Double
area (Circle r)     = pi * r * r
area (Rectangle w h) = w * h

-- 周长计算
perimeter :: Shape -> Double
perimeter (Circle r)     = 2 * pi * r
perimeter (Rectangle w h) = 2 * (w + h)

-- 嵌套Maybe
fromMaybe' :: a -> Maybe a -> a
fromMaybe' defaultVal Nothing  = defaultVal
fromMaybe' _ (Just x)          = x

-- 嵌套列表
deepHead :: [[a]] -> a
deepHead ((x:_):_) = x
deepHead _        = error "empty"

-- 精确数值匹配
fibonacci :: Int -> Int
fibonacci 0 = 0
fibonacci 1 = 1
fibonacci n = fibonacci (n-1) + fibonacci (n-2)

-- 范围模式（GHC扩展）
{-# LANGUAGE PatternSynonyms #-}

-- 数值守卫
classify :: Int -> String
classify n
    | n < 0     = "negative"
    | n == 0    = "zero"
    | n > 0     = "positive"

-- 字符匹配
isVowel :: Char -> Bool
isVowel 'a' = True
isVowel 'e' = True
isVowel 'i' = True
isVowel 'o' = True
isVowel 'u' = True
isVowel _  = False

-- 字符串模式
prefixMatch :: String -> String
prefixMatch ('h':'t':'t':'p':rest) = "HTTP: " ++ rest
prefixMatch ('f':'t':'p':rest)    = "FTP: " ++ rest
prefixMatch s                      = "Other: " ++ s

-- Bool匹配
not' :: Bool -> Bool
not' True  = False
not' False = True

and' :: Bool -> Bool -> Bool
and' True True  = True
and' _    _     = False

or' :: Bool -> Bool -> Bool
or' False False = False
or' _     _      = True

-- 不关心的值用下划线表示
head'' :: [a] -> a
head'' (x:_) = x

-- 多个通配符
snd' :: (a, b) -> b
snd' (_, y) = y

-- 始终匹配
const' :: a -> b -> a
const' x _ = x

-- 不使用参数时用通配符避免警告
printDouble :: Int -> IO ()
printDouble n = putStrLn (show (n * 2))

-- 更好的做法
printDouble' :: Int -> IO ()
printDouble' n = print (n * 2)

-- 元组中的嵌套通配符
third :: (a, b, c) -> c
third (_, _, z) = z

-- 列表中的嵌套通配符
second :: [a] -> Maybe a
second (_:x:_) = Just x
second _       = Nothing

-- 保持整个值
firstChar :: String -> Maybe (Char, String)
firstChar s@(x:_) = Just (x, s)
firstChar []       = Nothing

-- 使用
-- firstChar "hello" = Just ('h', "hello")

-- 避免重复计算
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
stripPrefix prefix whole@(x:xs)
    | prefix `isPrefixOf` whole = Just (drop (length prefix) whole)
    | otherwise                 = Nothing

-- 避免匹配后再次构建
sortAndNub :: Ord a => [a] -> [a]
sortAndNub xs@(h:t)
    | null xs   = []
    | otherwise = h : sortAndNub (filter (>= h) t)
  where
    smaller = filter (< h) xs
    larger  = filter (> h) xs

-- 多层As模式
processPair :: (Int, Int) -> String
processPair pair@(a, b)
    | a == b    = "equal: " ++ show pair
    | a < b     = "first smaller: " ++ show pair
    | otherwise = "first larger: " ++ show pair

-- 列表As模式
nonEmptyInit :: [a] -> Maybe [a]
nonEmptyInit all@(x:xs)
    | null xs   = Nothing
    | otherwise = Just (init all)

-- head和tail
head''' :: [a] -> a
head''' (x:_) = x

tail' :: [a] -> [a]
tail' (_:xs) = xs

-- 初始化和最后一个
init' :: [a] -> [a]
init' [_]    = []
init' (x:xs) = x : init' xs

last' :: [a] -> a
last' [x]    = x
last' (_:xs) = last' xs

-- 精确长度
secondElement :: [a] -> Maybe a
secondElement (_:x:_) = Just x
secondElement _       = Nothing

-- 三元组
swapThird :: (a, b, c) -> (c, b, a)
swapThird (x, y, z) = (z, y, x)

-- 列表范围
take' :: Int -> [a] -> [a]
take' n _  | n <= 0 = []
take' _ []           = []
take' n (x:xs)       = x : take' (n-1) xs

-- 使用范围创建
rangePattern :: [Int]
rangePattern = [1..5]  -- [1,2,3,4,5]

-- 生成器中的模式
pairs :: [(Int, Int)]
pairs = [(x, y) | x <- [1, 2], y <- [3, 4]]
-- [(1,3),(1,4),(2,3),(2,4)]

-- 带条件的模式
nonEmptyPairs :: [[a]] -> [(a, a)]
nonEmptyPairs xss = [(x, y) | x:xs <- xss, y:yss <- xss, x /= y]

-- 二元组
fst''' :: (a, b) -> a
fst''' (x, _) = x

snd''' :: (a, b) -> b
snd''' (_, y) = y

-- 交换
swap' :: (a, b) -> (b, a)
swap' (x, y) = (y, x)

-- 嵌套匹配
associate :: ((a, b), c) -> (a, b, c)
associate ((x, y), z) = (x, y, z)

-- 解构复杂结构
process :: ((Int, Int), String) -> Int
process ((a, b), s) = a + b + length s

-- zip使用模式
zip' :: [a] -> [b] -> [(a, b)]
zip' []     _      = []
zip' _      []     = []
zip' (x:xs) (y:ys) = (x, y) : zip' xs ys

-- unzip
unzip' :: [(a, b)] -> ([a], [b])
unzip' []         = ([], [])
unzip' ((x, y):ps) = (x:xs, y:ys)
  where
    (xs, ys) = unzip' ps

-- 定义记录
data Person = Person
    { name :: String
    , age  :: Int
    } deriving (Show)

-- 模式匹配记录
getName :: Person -> String
getName (Person n _) = n

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

-- 匹配同时保留原始值
showPerson :: Person -> String
showPerson p@(Person n a) = 
    n ++ " is " ++ show a ++ " years old"

-- 创建并匹配
createAndShow :: String -> Int -> String
createAndShow n a = showPerson (Person n a)

-- 嵌套记录类型
data Company = Company
    { companyName :: String
    , address     :: Address
    } deriving (Show)

data Address = Address
    { street :: String
    , city  :: String
    } deriving (Show)

-- 嵌套匹配
getCity :: Company -> String
getCity (Company _ (Address _ c)) = c

-- 二叉树定义
data Tree a = Leaf | Node a (Tree a) (Tree a)
    deriving (Show)

-- 计算深度
treeDepth :: Tree a -> Int
treeDepth Leaf         = 0
treeDepth (Node _ l r) = 1 + max (treeDepth l) (treeDepth r)

-- 前序遍历
preorder :: Tree a -> [a]
preorder Leaf         = []
preorder (Node x l r) = x : preorder l ++ preorder r

-- 中序遍历
inorder :: Tree a -> [a]
inorder Leaf         = []
inorder (Node x l r) = inorder l ++ [x] ++ inorder r

-- 后序遍历
postorder :: Tree a -> [a]
postorder Leaf         = []
postorder (Node x l r) = postorder l ++ postorder r ++ [x]

-- 简单表达式类型
data Expr = Lit Int
          | Add Expr Expr
          | Mul Expr Expr
          | Sub Expr Expr
    deriving (Show)

-- 求值
eval :: Expr -> Int
eval (Lit n)       = 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

-- 化简
simplify :: Expr -> Expr
simplify (Add (Lit 0) e) = simplify e
simplify (Add e (Lit 0)) = simplify e
simplify (Mul (Lit 1) e) = simplify e
simplify (Mul e (Lit 1)) = simplify e
simplify (Mul (Lit 0) _) = Lit 0
simplify (Mul _ (Lit 0)) = Lit 0
simplify e = e

-- 颜色类型
data Color = Red | Green | Blue | RGB Int Int Int

-- 模式匹配处理
colorToRGB :: Color -> (Int, Int, Int)
colorToRGB Red       = (255, 0, 0)
colorToRGB Green     = (0, 255, 0)
colorToRGB Blue      = (0, 0, 255)
colorToRGB (RGB r g b) = (r, g, b)

isBright :: Color -> Bool
isBright (RGB r g b) = r > 128 || g > 128 || b > 128
isBright _           = False