Monad #

class Applicative f => Monad f where
    return :: a -> f a
    (>>=)  :: f a -> (a -> f b) -> f b
    (>>)   :: f a -> f b -> f b

-- Applicative：函数应用
(<*>) :: f (a -> b) -> f a -> f b

-- Monad：可以基于前一个结果选择下一个操作
(>>=) :: f a -> (a -> f b) -> f b

-- Maybe是Monad
instance Monad Maybe where
    return = Just
    Nothing >>= _ = Nothing
    Just x  >>= f = f x

-- 使用
Just 5 >>= \x -> Just (x * 2)  -- Just 10
Nothing >>= \x -> Just (x * 2) -- Nothing

instance Monad Maybe where
    return = Just
    Nothing >>= _ = Nothing
    Just x  >>= f = f x

-- 使用：链式安全操作
safeDiv :: Int -> Int -> Maybe Int
safeDiv _ 0 = Nothing
safeDiv x y = Just (x `div` y)

-- 链式计算
calc :: Int -> Int -> Int -> Maybe Int
calc x y z = 
    safeDiv x y >>= \result ->
    safeDiv result z

-- 使用do语法
calc' :: Int -> Int -> Int -> Maybe Int
calc' x y z = do
    result <- safeDiv x y
    safeDiv result z

-- 示例
calc 100 5 2  -- Just 10
calc 100 0 2  -- Nothing

instance Monad [] where
    return x = [x]
    xs >>= f = concat (map f xs)

-- 使用：列表推导
pairs :: [Int] -> [Int] -> [(Int, Int)]
pairs xs ys = do
    x <- xs
    y <- ys
    return (x, y)

-- 等价于
pairs' xs ys = [(x, y) | x <- xs, y <- ys]

-- 示例
pairs [1, 2] [3, 4]  -- [(1, 3), (1, 4), (2, 3), (2, 4)]

instance Monad IO where
    return = pure
    (>>=) = bindIO

-- 使用
main :: IO ()
main = do
    putStrLn "Enter name:"
    name <- getLine
    putStrLn ("Hello, " ++ name)

instance Monad (Either e) where
    return = Right
    Left e  >>= _ = Left e
    Right x >>= f = f x

-- 使用：错误处理链
validate :: Int -> Either String Int
validate x
    | x < 0     = Left "Negative"
    | x > 100   = Left "Too large"
    | otherwise = Right x

process :: Int -> Either String String
process x = do
    a <- validate x
    b <- validate (a * 2)
    return (show b)

-- 示例
process 30  -- Right "60"
process (-1)  -- Left "Negative"

instance Monad ((->) r) where
    return = const
    f >>= g = \x -> g (f x) x

-- 使用
addAndMultiply :: Int -> Int
addAndMultiply = do
    x <- (+1)
    y <- (*2)
    return (x + y)

-- 等价于
addAndMultiply' = \r -> let x = r + 1
                             y = r * 2
                         in x + y

-- return x >>= f == f x

-- 验证
return 5 >>= (\x -> Just (x * 2))  -- Just 10
(\x -> Just (x * 2)) 5  -- Just 10

-- m >>= return == m

-- 验证
Just 5 >>= return  -- Just 5
[1, 2, 3] >>= return  -- [1, 2, 3]

-- (m >>= f) >>= g == m >>= (\x -> f x >>= g)

-- 验证
(Just 5 >>= (\x -> Just (x * 2))) >>= (\y -> Just (y + 1))
-- Just 11
Just 5 >>= (\x -> (\x -> Just (x * 2)) x >>= (\y -> Just (y + 1)))
-- Just 11

-- do语法是Monad的语法糖
do
    x <- action1
    y <- action2
    action3 x y

-- 等价于
action1 >>= \x ->
action2 >>= \y ->
action3 x y

-- 无绑定的操作
do
    action1
    action2

-- 等价于
action1 >> action2

do
    x <- action
    let y = x * 2
    return y

-- 等价于
action >>= \x ->
let y = x * 2
in return y

import Control.Monad

-- sequence：将Monad列表转为列表的Monad
sequence :: Monad m => [m a] -> m [a]

-- 使用
sequence [Just 1, Just 2, Just 3]  -- Just [1, 2, 3]
sequence [Just 1, Nothing, Just 3] -- Nothing
sequence [putStrLn "a", putStrLn "b"]  -- 打印 a b，返回 [(), ()]

import Control.Monad

-- mapM：映射后序列
mapM :: Monad m => (a -> m b) -> [a] -> m [b]

-- forM：mapM的参数翻转
forM :: Monad m => [a] -> (a -> m b) -> m [b]

-- 使用
mapM print [1, 2, 3]  -- 打印 1 2 3，返回 [(), (), ()]

forM [1, 2, 3] $ \x -> do
    putStrLn $ "Processing " ++ show x
    return (x * 2)
-- 打印处理信息，返回 [2, 4, 6]

import Control.Monad

-- filterM：Monad版本的filter
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]

-- 使用
filterM (\x -> return (x > 2)) [1, 2, 3, 4, 5]  -- [3, 4, 5]

-- IO版本
filterM doesFileExist ["a.txt", "b.txt", "c.txt"]
-- 返回存在的文件列表

import Control.Monad

-- foldM：Monad版本的fold
foldM :: Monad m => (b -> a -> m b) -> b -> [a] -> m b

-- 使用
safeSum :: [Int] -> Maybe Int
safeSum = foldM (\acc x -> 
    if x < 0 
        then Nothing 
        else Just (acc + x)) 0

-- 示例
safeSum [1, 2, 3]  -- Just 6
safeSum [1, -1, 3] -- Nothing

import Control.Monad

-- when：条件为True时执行
when :: Monad m => Bool -> m () -> m ()

-- unless：条件为False时执行
unless :: Monad m => Bool -> m () -> m ()

-- 使用
main :: IO ()
main = do
    when True $ putStrLn "Yes"
    unless False $ putStrLn "Not false"

import Control.Monad

-- join：展平嵌套Monad
join :: Monad m => m (m a) -> m a

-- 使用
join (Just (Just 5))  -- Just 5
join (Just Nothing)   -- Nothing
join [[1, 2], [3, 4]] -- [1, 2, 3, 4]

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

complexCalc :: Int -> Int -> Int -> Maybe Int
complexCalc a b c = do
    x <- safeDiv a b
    y <- safeDiv x c
    z <- safeDiv y 2
    return (z + 1)

-- 使用
complexCalc 100 5 2  -- Just 6
complexCalc 100 0 2  -- Nothing

-- 简单的状态Monad
newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
    fmap f (State g) = State $ \s ->
        let (x, s') = g s
        in (f x, s')

instance Applicative (State s) where
    pure x = State $ \s -> (x, s)
    State f <*> State g = State $ \s ->
        let (h, s') = f s
            (x, s'') = g s'
        in (h x, s'')

instance Monad (State s) where
    return = pure
    State f >>= g = State $ \s ->
        let (x, s') = f s
        in runState (g x) s'

-- 使用
type Counter = State Int

increment :: Counter ()
increment = State $ \s -> ((), s + 1)

getCount :: Counter Int
getCount = State $ \s -> (s, s)

runCounter :: Counter a -> (a, Int)
runCounter = flip runState 0

-- 示例
example :: Counter Int
example = do
    increment
    increment
    increment
    getCount

-- runCounter example = (3, 3)

-- Writer Monad
newtype Writer w a = Writer { runWriter :: (a, w) }

instance Monoid w => Functor (Writer w) where
    fmap f (Writer (x, w)) = Writer (f x, w)

instance Monoid w => Applicative (Writer w) where
    pure x = Writer (x, mempty)
    Writer (f, w1) <*> Writer (x, w2) = Writer (f x, w1 <> w2)

instance Monoid w => Monad (Writer w) where
    return = pure
    Writer (x, w1) >>= f = 
        let (y, w2) = runWriter (f x)
        in Writer (y, w1 <> w2)

tell :: Monoid w => w -> Writer w ()
tell w = Writer ((), w)

-- 使用
type Log = Writer [String]

process :: Int -> Log Int
process x = do
    tell ["Starting with " ++ show x]
    let result = x * 2
    tell ["Result is " ++ show result]
    return result

-- runWriter (process 5) = (10, ["Starting with 5", "Result is 10"])