当我们谈论Monad的时候（二）

Welcome to Haskell

在上一篇文章中，我通过几个Java的例子简单的说明了Monad的本质和一些工程中常见的用途。接下来的文章就不再侧重于工程了，而是要慢慢向理论转换。而作为过渡，我选择了Haskell来代替Java进行说明。本篇文章默认读者已经对Haskell的基本语法有所了解，因此对此类内容我不会再做赘述。

我们先来改写之前的Monad： Optional 和 List 。先来看 Optional ，由于它只有两种“状态”，因此在Haskell中可以这么表示

data Optional a = Value a | Empty 
    deriving Show

然后我们来实现它的 fmap 函数

omap :: (a -> b) -> Optional a -> Optional b
omap f (Value a) = Value (f a)
omap f Empty     = Empty

omap (+3) (Value 4)
-- Value 7

对于列表的实现也是类似的。不过由于列表可以是任意长的，因此需要定义一个链状的结构

data List a = Nil | Cons a (List a)

infixr 5 `Cons`

在Haskell中，用 ` 包裹的函数可以作为中缀函数使用（比如加法等等），而 infixr 规定了 Cons` 是右结合的。所以对于列表 [ 1, 2, 3 ] ，用 List 表示就是 1 `Cons` 2 `Cons` 3 `Cons` Nil ，等同于 Cons 1 (Cons 2 (Cons 3 Nil)) 。如果你还是无法理解这个列表，不妨把这种形式想象成链表： Cons 的第一个参数就是当前结点的值，第二个参数就是下一个结点；列表的最后总是连接尾结点 Nil 。

对于列表， fmap 的作用就是遍历每一个列表元素，并对它们应用传入的函数 f 。通过模式匹配和递归，不难写出对应的 lmap

lmap :: (a -> b) -> List a -> List b
lmap _ Nil = Nil
lmap f (Cons x xs) = f x `Cons` lmap f xs

为了便于调试，可以给 List 实现 Show ，这样就可以打印出比较可读的列表了。

ljoin :: String -> List String -> String
ljoin _ Nil = ""
ljoin _ (Cons x Nil) = x
ljoin mid (Cons x xs) = x ++ mid ++ ljoin mid xs

instance (Show a) => Show (List a) where
    show Nil = "[]"
    show xs = "[ " ++ ljoin ", " (lmap show xs) ++ " ]"

1 `Cons` 2 `Cons` Nil
-- [ 1, 2 ]

Functor的实现

Haskell使用Typeclass来描述Functor，对应于Java中的接口，不过表达能力要更强。标准库对Functor的定义如下：

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

没有具体定义的 fmap 就是我们需要实现的函数。使用 instance 可以将之前声明的 Optional 定义为Functor。

instance Functor Optional where
    fmap = omap

同样，列表也可以这样声明为Functor

instance Functor List where
    fmap = lmap

Applicative

但是我们没法直接声明 Monad 的instance，因为在Haskell中， Functor 与 Monad 之间还有一个 Applicative 。那么Appliacative是什么呢？Applicative是对“应用”的抽象，它允许在容器中“存放”一个函数。

还是用例子来说明。上一篇文章的最后，我举了一个多参函数的例子。当时我们封装了一个函数 liftM2 用来处理2参数的函数。但是如果按照这个方法，我们对每一个数量的参数都需要写一个 liftM* 函数，非常麻烦。而对于容器外面的普通函数，我们就不会遇到这个问题，因为函数都是柯里化的。所以，为什么不把柯里化引入Functor呢？换言之，就是要允许在Functor中“存放”函数，而这个Functor就是Applicative。

为了把函数放进Functor，我们需要考察函数的性质。对于函数来说，最重要的就是“应用”。因此，Applicative有别于Functor的重要一点就是要求实现表达“应用”的函数。Haskell是这么表达这个函数的

(<*>) :: f (a -> b) -> f a -> f b

好吧，它的名字确实有一点怪。Haskell中全符号的、被小括号包裹的函数默认是中缀的，比如这个函数的调用就是中缀形式 f <*> xs 。 <*> 接受一个容器内的函数和值，并将运算之后的结果重新放在容器中。比如

(Value (+3)) <*> Value 2
-- Value 5

同样，柯里化的操作也是OK的

(Value (*)) <*> Value 2 <*> Value 3
-- Value 6

此外，为了将函数“装”进容器，还需要一个包装函数的函数。在Haskell中是这么表示的

pure :: a -> f a

因此就可以如此表示了

pure (*) <*> Value 2 <*> Value 3

总结一下，就可以得到Haskell对Applicative的定义了

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

实现Applicative

实现Applicative的方法和 fmap 大同小异，唯一的区别就是还需要对函数进行模式匹配。

instance Applicative Optional where
    pure = Value
    
    Empty     <*> _         = Empty
    _         <*> Empty     = Empty
    (Value f) <*> (Value x) = Value (f x)

对于 Optional ， pure 的实现就是构造函数 Value 。而 <*> 就是对函数与值都进行模式匹配，在有值的情况下将值应用给函数。

对于列表来说，情况可能稍微复杂一点。因为 <*> 的参数可能是多个函数和多个值。因此我们可以遍历所有可能的 函数-值 组合，因此我们只需要两次 lmap 。比如对于给定的函数列表 fx 与值列表 xs ， lmap (`lmap` xs) fx 先遍历 fx 再遍历 xs 。但是它还有一个问题

fx = (+1) `Cons` (*2) `Cons` Nil
xs = 1 `Cons` 2 `Cons` Nil
lmap (`lmap` xs) fx
-- [ [ 2, 3 ], [ 2, 4 ] ]

两次 lmap 的结果，使结果变成了 List (List Integer) ，而 <*> 应该返回的是 List Integer 。因此我们还需要再设计一个 join 函数，来将结果转化为 List Integer 。对于 List ，这个函数通常叫 concat

lappend :: List a -> List a -> List a
lappend Nil ys = ys
lappend (Cons x xs) ys = Cons x (lappend xs ys)

lconcat :: List (List a) -> List a
lconcat Nil = Nil
lconcat (Cons x xs) = lappend x (lconcat xs)

因此，我们就能完整实现 List 的 Applicative 示例了

instance Applicative List where
    pure x = x `Cons` Nil    
    fx <*> xs = lconcat $ lmap (`lmap` xs) fx

实现Monad

在Haskell中， Monad 是采用上一篇中提到的 flatMap 形式定义的

class Applicative m => Monad m where
    (>>=)       :: forall a b. m a -> (a -> m b) -> m b

>>= 就是 flatMap 函数。它的行为就是取第一个参数 m a 的值，将其应用在第二个参数的函数（这个函数也叫monadic map）。由于这个函数并不是在容器中的，因此 >>= 的实现比起Applicative要更容易些。对于 Optional ，我们只需要对 m a 进行模式匹配

instance Monad Optional where
    (Value val) >>= f = f val
    Empty       >>= _ = Empty

对于列表，我们也只需要遍历一次了。

instance Monad List where
    xs >>= f = lconcat $ lmap f xs

至此，我们就在Haskell中完成了Monad的实现。

Do-notation

Do表记（do-notation）是Haskell给Monad操作提供的语法糖。在不使用Do表记情况下，使用Monad的代码是相当混乱的。比如

list1 :: List Integer
list1 = 1 `Cons` 2 `Cons` Nil

list2 :: List Integer
list2 = 3 `Cons` 4 `Cons` Nil

result = list1 >>=
  \x -> list2 >>=
  \y -> let z = x + y in
    if odd z then return (x, y) else Nil
-- reuslt = [ (1,4), (2,3) ]

这段代码计算两个列表所有数字和为奇数的取法。但是这段代码的可读性实在有限， >>= 之后使用λ函数的语法是相当反直觉的，和一般编程语言中“赋值”的书写方向完全相反。而在Do表记下，这段代码可以修改为

result = do
    x <- list1
    y <- list2
    let z = x + y
    if odd z then
      return (x, y)
    else
      Nil

写出来的代码就十分清爽了，颇有命令式语言的味道。在IO操作中，这个优势还可以变得更加的明显。Haskell采用Monad实现IO相关的API，这个Monad就称为 IO Monad 。通过Do表记可以写出很多符合直觉的代码，比如

main :: IO ()
main = do
  putStrLn "Hello"
  putStr "Plz enter your name: "
  hFlush stdout
  input <- getLine
  putStrLn $ "Hi " ++ input

-- Hello
-- Plz enter your name: KAAAsS
-- Hi KAAAsS

不过这段代码和之前有一个不同。Haskell中的IO函数都会返回一个IO Monad，而上面的代码中，我们并没有对每一条都使用之前的结果。对于部分IO Monad（如 putStrLn 返回的），我们直接就抛弃了这些返回值。因此如果把语法糖展开，这段代码将会变成这样

main = 
  putStrLn "Hello" 
  >>= \_ -> putStr "Plz enter your name: "
  >>= \_ -> hFlush stdout
  >>= \_ -> getLine
  >>= \input -> putStrLn $ "Hi " ++ input

为了防止这种无意义的λ参数频繁出现，因此Haskell中还提供了丢弃上个结果的 >> 函数，它的实现是这样的

(>>)        :: forall a b. m a -> m b -> m b
m >> k = m >>= \_ -> k

因此这段代码可以改写为

main =
  putStrLn "Hello" >>
  putStr "Plz enter your name: " >>
  hFlush stdout >>
  getLine >>= \ input ->
    putStrLn $ "Hi " ++ input

再论Applicative

不知道你在实现和使用Monad的时候有没有发现，Monad好像几乎不怎么依赖于Applicative的实现。事实上，在Monad定义中直接使用Applicative的地方只有 return 函数

class Applicative m => Monad m where
    (>>=)       :: forall a b. m a -> (a -> m b) -> m b

    m >> k = m >>= \_ -> k

    return      :: a -> m a
    return      = pure

那Haskell为什么要规定必须先实现Applicative才能实现Monad呢？这其实是一个历史问题，而且只有GHC版本在7.10之后才有这个要求。虽然Monad本身在1996年就由Philip Wadler提议加入Haskell，但是Applicative其实是2007年于 Functional Pearl: applicative programming with effects 提出的，因此Applicative引入Haskell的时间其实要远远晚于Monad。而由于要保持兼容性，所以在很长一段时间内Applicative与Monad的定义都是不相干的。这个不仅仅表现在它们Typeclass的定义上，在很多标准库函数上也出现了“分歧”。包括：

1. return （Monad）和 pure （Applicative）函数实际上是一致的
2. >> （Monad）和 *> （Applicative）实际上是一致的
3. liftM 、 liftA 和 fmap 是一致的
4. liftM* （如 liftM2 ）和 liftA* （如 liftA2 ）是一致的
5. <*> 和 ap 是一致的
6. Traversable 实际上只要求Applicative，但是实现上却要求Monad

这么多明明相同的东西却有那么多不同的表示方法（甚至写的烂的话，它们的行为还会不同），可想而知这会给编码造成多大的混乱。因此在2014年，Haskell社区提出了AMP将这些问题都做了统一，之后由GHC 7.10对相关提议做出了实现。

不过，这也只解释了为什么如今Haskell的Applicative和Monad是这种状态。那么，是什么原因使Haskell冒着把标准库搞乱的风险也要引入Applicative呢？

引入Applicative的意义

上下文无关

引入Applicative的意义有很多，其中一点就是，Applicative和Monad的侧重点不同。Applicative和Monad都能实现运算的组合与排序，因此它们都能对运算进行建模，但是Applicative在运算的过程中并没有上下文。

上下文指的就是之前产生的运算结果，也就是Do表记中的类似“变量”的东西。而没了上下文，这就意味着Applicative失去了根据之前运算结果进行下一步运算的能力。在调用形式上看， >>= 的左侧是之前的运算结果，而右侧通过λ参数将这个结果引入了进来，以供之后使用。但是 <*> 的左侧与右侧并没有联系，因此之后的运算是无法依赖于之前的运算的。

比如对于列表推导式 [ x + y | x <- [1..3], y <- [1..x] ] ，它计算 y 的时候需要就需要先对 x 进行计算。因此使用Applicative是没有办法表达的

(+) <$> [1..3] <*> [1..x]
-- error: Variable not in scope: x

而Monad是可以完成这个计算的，在形式上，这个 x 是由λ函数的参数引入的

[1..3]
    >>= \x -> [1..x]
    >> \y -> return (x + y)

不过这个例子并不能完全说明“不能用之前的计算结果”，或者“之前的计算结果无法影响之后的计算”。为了更好的理解Applicative运算是固定不变的，我们再举一个实现 if 的例子

ifA :: Applicative f => f Bool -> f a -> f a -> f a
ifA t c a = g <$> t <*> c <*> a
    where g b x y = if b then x else y

ifA (Value True) (Value 666) (Value 233)
-- Value 666
ifA (Value False) (Value 666) (Value 233)
-- Value 233

这么看起来似乎第一个 Optional Bool 真的能影响之后的计算流程？但是实际上，无论 Optional Bool 是真是假，这个 ifA 的计算流程都是不会改变的，看这个例子

ifA (Value True) (Value 666) Empty
-- Empty
ifA (Value False) (Value 666) Empty
-- Empty

回想 Optional 关于 <*> 的实现，就不难理解结果为什么是 Empty 了。而使用Monad，则可以解决这个问题

ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM mbool th el = do
  bool <- mbool
  if bool then th else el

ifM (Value True) (Value 666) Empty
-- Value 666
ifM (Value False) (Value 666) Empty
-- Empty

从这个例子不难看出，Applicative的计算流程是固定的，它没有执行计算的“上下文”。而Monad的计算流程是可变的，这也意味着它的计算有“上下文”。一般的计算场景中都是有上下文的，比如IO运算。但是这种没有依赖的计算场景其实也是存在的，比如并发、Parser。试想这个场景

(\a b -> merge a b) <$> doTaskA <*> doTaskB

由于 doTaskA 与 doTaskB 不存在依赖关系，因此可以并行的对其进行计算（或者说，可以用来表示并行的计算任务）。

特例

此外，Applicative是一个比Monad更初级的结构。因此毫无疑问，存在是Applicative但不是Monad的情况。而对Applicative的刻画增强了Haskell的表达能力，比如 Traversable 其实只需要Applicative就可以实现了。这里举一个是Applicative但不是Monad的例子： ZipList 。我们之前实现的 List 在处理多参数时会遍历所有可能组合（笛卡尔积），而 ZipList 更贴近使用习惯，它会按照同一个位置的元素来遍历多个列表。 ZipList 的定义本质上就是 List

newtype ZipList a = ZipList { getZipList :: List a }
                  deriving Show

instance Functor ZipList where
  fmap f (ZipList xs) = ZipList $ lmap f xs

之后我们来实现Applicative。这里用到了一个技巧，Haskell的Applicative实际上是很灵活的，它允许我们在声明时选择 <*> 或 liftA2 进行声明。 liftA2 的作用就是上一篇中提到的 liftM2 。

class Functor f => Applicative f where
    {-# MINIMAL pure, ((<*>) | liftA2) #-}

    pure :: a -> f a

    (<*>) :: f (a -> b) -> f a -> f b
    (<*>) = liftA2 id

    liftA2 :: (a -> b -> c) -> f a -> f b -> f c
    liftA2 f x = (<*>) (fmap f x)

    (*>) :: f a -> f b -> f b
    a1 *> a2 = (id <$ a1) <*> a2

    (<*) :: f a -> f b -> f a
    (<*) = liftA2 const

MINIMAL 注释就是用来说明这一点。由于“按位置遍历”的操作用 liftA2 很容易就能表达，因此我们可以直接使用 liftA2 来定义。

repeatList :: a -> List a
repeatList x = xs
  where xs = x `Cons` xs

zipListWith :: (a -> b -> c) -> List a -> List b -> List c
zipListWith f Nil           _             = Nil
zipListWith f _             Nil           = Nil
zipListWith f (x `Cons` xs) (y `Cons` ys) = f x y `Cons` zipListWith f xs ys

instance Applicative ZipList where
    pure x = ZipList (repeatList x)
    liftA2 f (ZipList xs) (ZipList ys) = ZipList (zipListWith f xs ys)

简单测试一下

import Data.Semigroup

incList :: Integer -> List Integer
incList i = i `Cons` incList (i + 1)

a = ZipList ('a' `Cons` 'b' `Cons` 'c' `Cons` 'd' `Cons` Nil)
b = ZipList ('5' `Cons` '6' `Cons` '7' `Cons` Nil)
c = ZipList (incList 1)

(\a b -> (a, b)) <$> a <*> b
-- ZipList {getZipList = [ ('a','5'), ('b','6'), ('c','7') ]}
(\a b c -> stimes c [a, b]) <$> a <*> b <*> c
-- ZipList {getZipList = [ "a5", "b6b6", "c7c7c7" ]}

可以看到， ZipList 的行为和 List 是有很大区别的。而且 ZipList 实际上是没有合法的Monad实现的。这里的合法不是说你实现Monad会报错，而是说 你写的任意Monad都不符合Monad必须符合的定律 。至于这个定律是什么，在讲原理的文章中我会详细说明。

Monad的三种定义

之前提到了AMP更改了Monad的定义，而在AMP真正实现之前，Monad的定义是这样的

class Monad m where
    return :: a -> m a
    
    (>>=) :: m a -> (a -> m b) -> m b
    
    (>>) :: m a -> m b -> m b
    m >> n = m >>= \_ -> n
    
    fail :: String -> m a

而这个定义已经是Monad的完备定义了。引入AMP后，由于 return 已经被Applicative的 pure 实现，因此只需要实现 >>= 。

class Applicative m => Monad m where
    (>>=)       :: forall a b. m a -> (a -> m b) -> m b

    m >> k = m >>= \_ -> k

    return      :: a -> m a
    return      = pure

不过上一篇文章中提到，通过 join 也可以定义Monad。而且在范畴论中，Monad也是这么定义的。所以实际上这个定义也可以定义一个Monad

class Applicative m => Monad m where
    join :: m (m a) -> m a

后记

这篇文章其实已经远远超出我预计的篇幅了。就这些内容能写这么多，我是没有想到的。原本这篇文章是想简单讲讲Monad的实现，之后再写点Haskell中常见的Monad的。但是由于上一篇文章的Applicative拖到了这篇，导致可以讲的内容大大增加。所以最终这篇文章就变成几乎纯实现Monad的介绍了，而关于Monad的应用、副作用等等的话题就要另开一篇了。不过这样的好处是，我在下一篇可以讲更多有意思的Monad了，说不定还能讲讲Arrow Type和Monad，为更后面的范畴论做些预备。

Reference

1. Prelude – Hackage（ http://hackage.haskell.org/package/base-4.14.0.0/docs/Prelude.html ）
2. Brent Yorgey, The Typeclassopedia
3. Applicative Programming with Effects（ http://www.staff.city.ac.uk/~ross/papers/Applicative.html ）
4. Functor-Applicative-Monad Proposal（ https://wiki.haskell.org/Functor-Applicative-Monad_Proposal ）
5. Difference between Monad and Applicative in Haskell（ https://stackoverflow.com/questions/23342184/difference-between-monad-and-applicative-in-haskell ）