Applicative #

class Functor f => Applicative f where
    pure  :: a -> f a
    (<*>) :: f (a -> b) -> f a -> f b

-- Functor：函数在普通世界
fmap  :: (a -> b) -> f a -> f b

-- Applicative：函数在Functor世界
(<*>) :: f (a -> b) -> f a -> f b

-- Maybe是Applicative
instance Applicative Maybe where
    pure = Just
    Nothing <*> _ = Nothing
    Just f  <*> x = fmap f x

-- 使用
Just (*2) <*> Just 5  -- Just 10
Nothing <*> Just 5    -- Nothing
Just (*2) <*> Nothing -- Nothing

instance Applicative Maybe where
    pure = Just
    Nothing <*> _ = Nothing
    Just f  <*> x = fmap f x

-- 使用
pure 5 :: Maybe Int  -- Just 5
Just (+1) <*> Just 4  -- Just 5
Just (+) <*> Just 3 <*> Just 5  -- Just 8

instance Applicative [] where
    pure x = [x]
    fs <*> xs = [f x | f <- fs, x <- xs]

-- 使用
pure 5 :: [Int]  -- [5]
[(+1), (*2)] <*> [1, 2, 3]  -- [2, 3, 4, 2, 4, 6]
[(+), (*)] <*> [1, 2] <*> [3, 4]
-- [4, 5, 5, 6, 3, 4, 6, 8]

instance Applicative (Either e) where
    pure = Right
    Left e  <*> _ = Left e
    Right f <*> x = fmap f x

-- 使用
Right (+) <*> Right 3 <*> Right 5  -- Right 8
Left "error" <*> Right 5  -- Left "error"

instance Applicative IO where
    pure = return
    f <*> x = do
        f' <- f
        x' <- x
        return (f' x')

-- 使用
main :: IO ()
main = do
    result <- (++) <$> getLine <*> getLine
    putStrLn result

instance Applicative ((->) r) where
    pure = const
    f <*> g = \x -> f x (g x)

-- 使用
((+) <*> (*2)) 5  -- 15 (5 + 10)
((,) <*> show) 42  -- (42, "42")

-- 使用pure和<*>
pure f <*> x <*> y <*> z

-- 示例
pure (+) <*> Just 3 <*> Just 5  -- Just 8
pure (*) <*> Just 2 <*> Just 3 <*> Just 4  -- Just 24

-- 更简洁的写法
f <$> x <*> y <*> z

-- 示例
(+) <$> Just 3 <*> Just 5  -- Just 8
(*) <$> Just 2 <*> Just 3 <*> Just 4  -- Just 24

-- 对比
pure (+) <*> Just 3 <*> Just 5
(+) <$> Just 3 <*> Just 5  -- 更简洁

-- 三参数函数
sum3 :: Int -> Int -> Int -> Int
sum3 a b c = a + b + c

-- 使用
sum3 <$> Just 1 <*> Just 2 <*> Just 3  -- Just 6

-- 构造数据类型
data Person = Person String Int

Person <$> Just "John" <*> Just 30  -- Just (Person "John" 30)

-- pure id <*> v == v

-- 验证
pure id <*> Just 5  -- Just 5
pure id <*> [1, 2, 3]  -- [1, 2, 3]

-- pure (.) <*> u <*> v <*> w == u <*> (v <*> w)

-- 验证
pure (.) <*> Just (*2) <*> Just (+1) <*> Just 5
-- Just 12
Just (*2) <*> (Just (+1) <*> Just 5)
-- Just 12

-- pure f <*> pure x == pure (f x)

-- 验证
pure (*2) <*> pure 5 :: Maybe Int  -- Just 10
pure ((*2) 5) :: Maybe Int  -- Just 10

-- u <*> pure y == pure ($ y) <*> u

-- 验证
Just (*2) <*> pure 5  -- Just 10
pure ($ 5) <*> Just (*2)  -- Just 10

import Control.Applicative

-- liftA：提升单参数函数
liftA :: Applicative f => (a -> b) -> f a -> f b
liftA = fmap

-- liftA2：提升双参数函数
liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
liftA2 f x y = f <$> x <*> y

-- liftA3：提升三参数函数
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 f x y z = f <$> x <*> y <*> z

-- 使用
liftA2 (+) (Just 3) (Just 5)  -- Just 8
liftA2 (,) (Just 1) (Just 2)  -- Just (1, 2)

-- <*：丢弃右边值
(<*) :: Applicative f => f a -> f b -> f a

-- *>：丢弃左边值
(*>) :: Applicative f => f a -> f b -> f b

-- 使用
Just 1 <* Just 2  -- Just 1
Just 1 *> Just 2  -- Just 2
[1, 2] <* [3, 4]  -- [1, 1, 2, 2]
[1, 2] *> [3, 4]  -- [3, 4, 3, 4]

import Data.Traversable

-- sequenceA：将Applicative列表转为列表的Applicative
sequenceA :: Applicative f => [f a] -> f [a]

-- 使用
sequenceA [Just 1, Just 2, Just 3]  -- Just [1, 2, 3]
sequenceA [Just 1, Nothing, Just 3] -- Nothing
sequenceA [[1, 2], [3, 4]]  -- [[1, 3], [1, 4], [2, 3], [2, 4]]

data User = User
    { userName :: String
    , userAge  :: Int
    } deriving (Show)

validateName :: String -> Maybe String
validateName name
    | null name  = Nothing
    | otherwise  = Just name

validateAge :: Int -> Maybe Int
validateAge age
    | age < 0    = Nothing
    | age > 150  = Nothing
    | otherwise  = Just age

validateUser :: String -> Int -> Maybe User
validateUser name age = User 
    <$> validateName name 
    <*> validateAge age

-- 使用
validateUser "John" 30  -- Just (User "John" 30)
validateUser "" 30      -- Nothing
validateUser "John" (-1) -- Nothing

newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }

instance Functor Parser where
    fmap f (Parser p) = Parser $ \s ->
        fmap (\(x, s') -> (f x, s')) (p s)

instance Applicative Parser where
    pure x = Parser $ \s -> Just (x, s)
    Parser pf <*> Parser px = Parser $ \s ->
        case pf s of
            Nothing -> Nothing
            Just (f, s') -> fmap (\(x, s'') -> (f x, s'')) (px s')

-- 组合解析器
parseTwoChars :: Parser (Char, Char)
parseTwoChars = (,) <$> parseChar <*> parseChar
  where
    parseChar = Parser $ \s ->
        case s of
            (c:cs) -> Just (c, cs)
            []     -> Nothing

-- 使用Applicative进行并行计算
parallelSum :: IO Int -> IO Int -> IO Int
parallelSum a b = (+) <$> a <*> b

-- 使用
main :: IO ()
main = do
    result <- parallelSum 
        (heavyComputation 1)
        (heavyComputation 2)
    print result
  where
    heavyComputation n = return (n * 100)

data Config = Config
    { configHost :: String
    , configPort :: Int
    , configDebug :: Bool
    } deriving (Show)

getHost :: IO String
getHost = return "localhost"

getPort :: IO Int
getPort = return 8080

getDebug :: IO Bool
getDebug = return False

getConfig :: IO Config
getConfig = Config <$> getHost <*> getPort <*> getDebug

main :: IO ()
main = do
    config <- getConfig
    print config
-- Config {configHost = "localhost", configPort = 8080, configDebug = False}