让Monad来得更猛烈些吧_Haskell笔记11

Posted 2021-04-25 ayqy

tags:

篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了让Monad来得更猛烈些吧_Haskell笔记11相关的知识，希望对你有一定的参考价值。

感谢支持ayqy个人订阅号，每周义务推送1篇（only unique one）原创精品博文，话题包括但不限于前端、Node、android、数学（WebGL）、语文（课外书读后感）、英语（文档翻译）
如果觉得弱水三千，一瓢太少，可以去 http://blog.ayqy.net 看个痛快

写在前面

最早接触过IO Monad，后来又了解了Maybe Monad和List Monad，实际上还有很多Monad（比如Writer Monad、Reader Monad、State Monad等），位于mtl package，可以通过ghc-pkg命令来查看：

$ ghc-pkg list | grep mtl
mtl-2.2.1

P.S.Haskell Platform默认包含mtl package，不必手动安装

一.Writer Monad

追踪执行过程

在理解递归算法的时候，有一个强烈的需求，就是想要记录中间过程。当时是这样做的：

import Debug.Trace
d f = trace ("{" ++ show f ++ "}") f

通过trace :: String -> a -> a来添加日志：

When called, trace outputs the string in its first argument, before returning the second argument as its result.

接受一个字符串和值，打印输出字符串，再原样返回输入的值，例如：

> x `add` y = trace (show x ++ " + " ++ show y) (x + y)
> add 3 $ add 1 2
1 + 2
3 + 3
6

成功追踪到了执行过程，但需要修改源码，把每个函数都换成带日志的版本太麻烦，所以通过工具函数d来做（想知道什么就d什么）：

> d (1 + 2) + 3
{3}
6

以Haskell经典快排为例：

quickSort [] = []
quickSort (x:xs) = quickSort ltX ++ [x] ++ quickSort gtX
  where ltX = [a | a <- xs, a <= x]
        gtX = [a | a <- xs, a > x]

添加日志，看左边的处理过程（d ltX）：

quickSortWithLog [] = []
quickSortWithLog (x:xs) = quickSortWithLog (d ltX) ++ [x] ++ quickSortWithLog gtX
  where ltX = [a | a <- xs, a <= x]
        gtX = [a | a <- xs, a > x]

试玩一下：

> quickSortWithLog [9, 0, 8, 10, -5, 2, 13, 7]
{[0,8,-5,2,7]}
{[-5]}
{[]}
[-5,0{[2,7]}
{[]}
,2{[]}
,7,8,9{[]}
,10{[]}
,13]

从日志得知，第一趟左边是[0,8,-5,2,7]（pivot是9），继续下去是[-5]（pivot是0），然后左边就是[]了（pivot是-5），（0的）另一边的第一趟左边是[2,7]，继续下去左边就是[]了。原始数组的左边处理完毕，右边类似，不再赘述

勉强能解决问题，但存在几个缺陷：

日志输出混在结果里，日志看起来不很直观
日志会影响原结果输出，缺少隔离
只能打印输出，没办法收集起来进一步处理，不够灵活

那么，想要追踪执行过程的话，有没有更优雅的方式？

Writer登场

能否在运算的同时，自动维护一份操作日志？

如果把附加的日志信息看做context，似乎与Monad有些关系，比如可以在值参与运算的同时，自动收集日志（维护这个context）

这就是Writer的由来：

Writer则是加进一个附加值的context，好比log一般

Writer可以让我们在计算的同时搜集所有log纪录，并汇集成一个log并附加在结果上

Writer长这样：

type Writer w = WriterT w Identity
newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }

从类型声明来看，Writer是对元组（(a, w)）的包装，m被指定成了Identity：

newtype Identity a = Identity { runIdentity :: a }
instance Applicative Identity where
  pure     = Identity
instance Monad Identity where
  m >>= k  = k (runIdentity m)

看起来没什么用，仔细看一下：声明了一个叫做Identity的包装类型，还实现了Monad，return的行为是把给定值包起来，>>=的行为是对左侧包起来的值应用右侧函数。还是没发现有什么用……实际上，它相当于Monad界的id :: a -> a，能够把一个值包成Monad参与运算，此外什么也不做，就应用场景而言，就像id一样，有些时候就是需要个什么都不做的Monad（就像有时候需要个什么都不做的函数一样）

Identity allows us to define just monad transformers and then define their corresponding monads just as SomeT Identity.

P.S.关于Identity的更多讨论，见Why is Identity monad useful?

接下来看WriterT的Monad实现：

instance (Monoid w, Monad m) => Monad (WriterT w m) where
    return a = writer (a, mempty)
    m >>= k  = WriterT $ do
        ~(a, w)  <- runWriterT m
        ~(b, w') <- runWriterT (k a)
        return (b, w `mappend` w')
    fail msg = WriterT $ fail msg

writer :: (Monad m) => (a, w) -> WriterT w m a
writer = WriterT . return

其中a是值的类型，w是附加的Monoid的类型。从Monad实现来看，从左侧取出值a和附加信息w，将右侧函数应用到a上，并从结果取出值b和附加信息w'，结果值为b，附加信息为w `mappend` w'，最后用return包装结果返回m类型的值，作为WriterT值构造器的参数

注意，关键点就是在值运算的同时，对附加信息做w `mappend` w'，以此保留日志context，实现自动维护操作日志

令m = Identity的话（Writer就是这么定义的），具体过程相当于：

(WriterT (Identity (a, w))) >>= f = let (WriterT (Identity (b, w'))) = f a in WriterT (Identity (b, w `mappend` w'))

P.S.~(a, w)中的~表示惰性模式匹配（具体见Haskell/Laziness | Lazy pattern matching）：

prepending a pattern with a tilde sign delays the evaluation of the value until the component parts are actually used. But you run the risk that the value might not match the pattern — you’re telling the compiler ‘Trust me, I know it’ll work out’. (If it turns out it doesn’t match the pattern, you get a runtime error.)

试玩一下：

> runWriterT $ (return 1 :: WriterT String Identity Int)
Identity (1,"")
> let (WriterT (Identity (a, w))) = WriterT (Identity (1,"")) in (a, w)
(1,"")
> (WriterT (Identity (1,"abc")) :: WriterT String Identity Int) >>= \a -> return (a + 1)
WriterT (Identity (2,"abc"))

Writer没有直接暴露出值构造器，但可以通过writer函数来构造Writer，例如：

> writer (1,"abc") :: Writer String Int
WriterT (Identity (1,"abc"))

更进一步地，可以用更清晰的do表示法来描述：

do {
  a <- writer (1, "one")
  b <- writer (2, "two")
  return (a + b)
} :: Writer String Int

-- 得到的结果
WriterT (Identity (3,"onetwo"))

日志黏在一起了，换用数组来盛放：

do {
  a <- writer (1, ["one"])
  b <- writer (2, ["two"])
  return (a + b)
} :: Writer [String] Int

-- 得到的结果
WriterT (Identity (3,["one","two"]))

可以从中分离出计算结果和日志：

> fst . runWriter $ WriterT (Identity (3,["one","two"]))
3
> snd . runWriter $ WriterT (Identity (3,["one","two"]))
["one","two"]
> mapM_ putStrLn $ snd . runWriter $ WriterT (Identity (3,["one","two"]))
one
two

上面提到的几个缺陷似乎都完美解决了，还有个问题，如果只想插入一句无关的日志呢？

当然可以。tell可以用来插入不含值的额外信息：

tell :: MonadWriter w m => w -> m ()

类似于I/O场景里的print：

print :: Show a => a -> IO ()

作用也完全一致，不含值，仅记录一条信息，例如Writer：

logNumber :: Int -> Writer [String] Int
logNumber x = writer (x, [show x])

multWithLog :: Writer [String] Int
multWithLog = do
  a <- logNumber 3
  b <- logNumber 5
  tell ["*"]
  return (a*b)

能够以类似后缀表达式的形式，把操作数和操作符记录下来：

> multWithLog
WriterT (Identity (15,["3","5","*"]))

具体过程相当于：

> writer (3, ["3"]) >>= \a -> (writer (5, ["5"])) >>= \b -> (writer ((), ["*"])) >> return (a * b) :: Writer [String] Int
WriterT (Identity (15,["3","5","*"]))

回过头看追踪执行过程这件事，Writer的解决方案是给参与运算的值添上日志context，在运算过程中持续维护这份日志（通过内部的mappend），这样运算结果的context就带有完整的操作日志：

我们不过是把普通的value重写成Monadic value，剩下的就靠>>=跟Writer来帮我们处理一切

所以要想把普通函数变成带日志的版本，只要把参数（和运算中的常量）包装成Writer就好了

Difference list

上面我们用了List来盛放日志，隐约有点不安

因为List的++运算默认右结合（即向List头部插入），效率较高。如果频繁向List尾部插入的话，每次都需要遍历构建左边的List，效率很低。那么，有没有更高效的List？

有，叫做Difference list，能够进行高效的append操作。其实现思路非常巧妙：

首先，把每个List都转换成函数：

-- [1,2,3]
\xs -> [1,2,3] ++ xs
-- []
\xs -> [] ++ xs

注意：关键点是函数体里只对List做prepend，这样就保证了++运算的效率（头部插入效率很高）

自然地，List的append操作就变成了函数组合：

f = \xs -> "dog" ++ xs
g = \xs -> "meat" ++ xs
f `append` g = \xs -> f (g xs)
-- 展开f `append` g，得到
\xs -> "dog" ++ ("meat" ++ xs)

给Difference list（是个接受一个List参数的函数）传入空List就能取出结果List：

> f `append` g $ []
"dogmeat"

所以，这样定义DiffList：

newtype DiffList a = DiffList { getDiffList :: [a] -> [a] }

toDiffList xs = DiffList (xs++)
fromDiffList (DiffList f) = f []

再实现Monoid：

instance Monoid (DiffList a) where
  mempty = DiffList (\xs -> [] ++ xs)
  (DiffList f) `mappend` (DiffList g) = DiffList (\xs -> f (g xs))

试玩：

> fromDiffList $ (toDiffList [1, 2, 3]) `mappend` (toDiffList [3, 2, 1])
[1,2,3,3,2,1]

那么，性能差异到底有多少？简单测试一下：

countdown n = if (n == 0) then do {tell ["0"]} else do {countdown (n - 1); tell [show n]} :: Writer [String] ()
countdown' n = if (n == 0) then do {tell (toDiffList ["0"])} else do {countdown' (n - 1); tell (toDiffList [show n])} :: Writer (DiffList String) ()

倒着数数的场景，利用Writer记录倒数过程中的每个数，区别在于countdown用List盛放日志，而countdown'用了DiffList

多数一会儿，比如五十万个数：

> mapM_ putStrLn . snd . runWriter $ countdown 500000
> mapM_ putStrLn . fromDiffList . snd . runWriter $ countdown' 500000

就肉眼可见的效率而言，countdown越跑越慢，countdown'始终流畅输出

P.S.更科学的测试方法，见Performance | 5 Benchmarking libraries

P.S.DiffList的完整实现，见spl/dlist

P.S.另外，Haskell Platform默认不带dlist package（所以默认也没有内置的DiffList），需要手动装，见本文开头

二.Reader Monad

Reader Monad实际上就是Function Monad，函数也是Monad，这怎么理解？

一个函数也可以被想做是包含一个context的。这个context是说我们期待某个值，他还没出现，但我们知道我们会把他当作函数的参数，调用函数来得到结果。

也就是说(->) r，之前已经知道了它是Functor，也是Applicative。竟然还是Monad，其具体实现如下：

instance Monad ((->) r) where
  f >>= k = \ r -> k (f r) r

return没有额外实现，所以是Applicative的pure：

instance Applicative ((->) a) where
  pure = const

const                   :: a -> b -> a
const x _               =  x

接受一个任意值（x），返回一个函数（\_ -> x），该函数接受一个参数，忽略掉并返回之前传入的任意值。这样做是为了把一个值包进函数context，使之能够参与函数运算：

要让一个函数能够是某个定值的唯一方法就是让他完全忽略他的参数。

>>=从实现上看会生成一个新函数（\ r -> k (f r) r），该函数接受一个参数（r），这个参数会被传递给左侧的monadic value（也是个函数，f），再把返回值（f r）传递给右侧的函数（k），返回一个monadic value（仍然是函数，k (f r)），接受参数（r），最后返回一个monadic value

P.S.把r作为参数传递给f看起来比较奇怪，这是因为f是个monadic value，具有context（是个函数），要从函数context里取出值，必须喂给它参数。k (f r)同理，把从f取出的值喂给k，返回一个具有函数context的东西，最后把参数r喂给它，得到最终结果

好了，function现在是Monad了，那它有什么用？

palyAGame x = do
  f <- (/0.5) . (subtract 3.9343) . (*5) . (+52.8)
  g <- (*10)
  return (f - g)

心里想一个数字,用它加上52.8,再乘以5,然后减去3.9343,再除以0.5,最后再减去心里想的那个数的十倍

看一下翻译的过程，我们把计算公式分为x相关的两部分，最后做减法。先试玩一下：

> palyAGame 201807 01
520.1314

注意，除了x外，我们还多输入了一个参数，因为结果被return包进了\_ -> x，所以需要随便填个参数才能取出结果

回想一下Function Monad的实际作用：

把所有的函数都黏在一起做成一个大的函数，然后把这个函数的参数都喂给全部组成的函数，这有点取出他们未来的值的意味

P.S.“取出他们未来的值”指的是最后的f - g，调皮的描述

实际上，更科学的描述是这样的：

The Reader monad (also called the Environment monad). Represents a computation, which can read values from a shared environment, pass values from function to function, and execute sub-computations in a modified environment.

其中，共享环境指的是Maintaining variable bindings，即do block里的每一个monadic value，都共享这个大函数的参数，在function之间传值的含义类似于“取出他们未来的值”，至于在篡改过的环境中进行子计算，可能指的是依赖注入之类的应用场景（具体见What is the purpose of the Reader Monad?）

P.S.能够从共享环境中读取值，这也是称之为Reader Monad的原因

三.State Monad

除日志追踪、共享环境外，还有一类最常见的问题是状态维护

然而，有一些领域的问题根本上就是依赖于随着时间而改变的状态。虽然我们也可以用 Haskell 写出这样的程序，但有时候写起来蛮痛苦的。这也是为什么 Haskell 要加进 State Monad 这个特性。这让我们在 Haskell 中可以容易地处理状态性的问题，并让其他部份的程序还是保持纯粹性。

这就是State Monad的存在意义，想让状态维护变得更容易，同时不影响其它纯的部分

从实现角度看，State Monad是个函数，接受一个状态，返回一个值和新状态

s -> (a,s)
-- 即
state -> (result, newState)

类似于Writer Monad，结果值与context附加的额外信息（这里是newState）是分离的，通过二元组组织起来

具体实现如下：

type State s = StateT s Identity
newtype StateT s m a = StateT { runStateT :: s -> m (a,s) }

instance (Monad m) => Monad (StateT s m) where
  return a = StateT $ \ s -> return (a, s)
  m >>= k  = StateT $ \ s -> do
      ~(a, s') <- runStateT m s
      runStateT (k a) s'
  fail str = StateT $ \ _ -> fail str

return把接受到的值放进一个s -> (a,s)的状态操作函数，再包装成StateT

>>=从左侧取出状态操作函数，传入s取出新状态s'和计算结果a，然后把右侧的函数应用到计算结果a上，又得到一个monadic value，再通过runStateT取出里面的状态操作函数，应用到新状态s'上，得到(a,s)二元组并返回。这样lambda的类型就是标准的s -> (a,s)，最后，塞给StateT，构造出新的monadic value

State Monad能让状态维护操作更简洁地表达，那么，这个东西能把状态维护操作简化到什么程度呢？且看随机数的示例

随机数与State Monad

就场景而言，随机数需要维护状态（随机数种子），非常适合用State Monad来处理

具体的，之前在随机数的场景，通过给random函数换不同的随机数种子来生成随机数：

random :: (Random a, RandomGen g) => g -> (a, g)

例如：

> random (mkStdGen 7) :: (Bool, StdGen)
(True,320112 40692)

要生成3个随机数的话，最直接的方法是：

random3'' = let (r1, g1) = random (mkStdGen 7); (r2, g2) = random g1; (r3, g3) = random g2 in [(r1, g1), (r2, g2), (r3, g3)] :: [(Bool, StdGen)]
> random3''
[(True,320112 40692),(False,2071543753 1655838864),(True,33684305 2103410263)]

当然，可以封装得稍微优雅一些：

random3 i = collectNext $ collectNext $ [random $ mkStdGen i]
  where collectNext xs@((i, g):_) = [random g] ++ xs

> reverse $ random3 7 :: [(Bool, StdGen)]
[(True,320112 40692),(False,2071543753 1655838864),(True,33684305 2103410263)]

看起来舒服一些了，但感觉还是很麻烦。换用State Monad：

randomSt :: (RandomGen g, Random a) => State g a
randomSt = state random

threeCoins :: State StdGen (Bool,Bool,Bool)
threeCoins = do
  a <- randomSt
  b <- randomSt
  c <- randomSt
  return (a,b,c)

看起来相当优雅，random函数恰好满足s -> (a,s)的形式，所以直接丢给state :: MonadState s m => (s -> (a, s)) -> m a构造State Monad值即可。试玩一下：

> runState threeCoins (mkStdGen 7)
((True,False,True),33684305 2103410263)

结果(a, s)中的状态s是第4个随机数种子（算上传入的mkStdGen 7），因为这个种子是最新的状态（其余中间状态都被丢掉了）

是的，Moand又简化了一个状态维护的通用场景，State Monad帮我们自动完成了中间状态的维护，让一切变得尽可能地简洁

四.Error Monad

最后，异常处理也是一个重要场景，同样可以借助Monad来简化

Building computations from sequences of functions that may fail or using exception handling to structure error handling.

我们已经知道了Maybe是Monad，能够用来表达可能会产生错误的计算，那么Either呢？是不是也可以？

当然。实际上，Either就是Error Monad（也称之为Exception monad）实例：

class (Monad m) => MonadError e m | m -> e where
    throwError :: e -> m a
    catchError :: m a -> (e -> m a) -> m a

instance MonadError e (Either e) where
    throwError             = Left
    Left  l `catchError` h = h l
    Right r `catchError` _ = Right r

（摘自Control.Monad.Except）

P.S.注意，Control.Monad.Error和Control.Monad.Trans.Error都已经过时了，建议使用Control.Monad.Except，具体见Control.Monad.Error

throwError没什么好说的，约定Left x表示错误（Right x表示正常结果），catchError能够用来捕获错误，如果没发生错误就直接什么都不做。所以一般模式是这样：

do { action1; action2; action3 } `catchError` handler

例如：

do {
  x <- (Left "error occurred")
  return x
} `catchError` error

捕获错误，再直接用error丢出去，所以得到了报错：

*** Exception: error occurred

上面do block中的操作实际上依赖的是Either自身的Monad实现：

instance Monad (Either e) where
    Left  l >>= _ = Left l
    Right r >>= k = k r

等价于：

> ((Left "error occurred") >>= (\x -> return x) :: Either String Int) `catchError` error
*** Exception: error occurred
> ((throwError "error occurred") >>= (\x -> return x) :: Either String Int) `catchError` error
*** Exception: error occurred

也就是说，Error Monad只是帮那些能表达错误的类型（如Either、Maybe）实现了额外的throwError和catchError，并没有做侵入式修改，但有了这两个行为，我们确实可以优雅地处理错误了，这与上面介绍的几个Monad不同

除了Either，另一个实现了MonadError的重要实例是ExceptT（当然，不止这2个）：

instance Monad m => MonadError e (ExceptT e m) where
    throwError = ExceptT.throwE
    catchError = ExceptT.catchE

包起来之后，就可以用ExceptT身上定义的throw和catch了，所以ExceptT能给其它Monad添上错误处理能力，其实现如下：

newtype ExceptT e m a = ExceptT (m (Either e a))

runExceptT :: ExceptT e m a -> m (Either e a)
runExceptT (ExceptT m) = m

throwE :: (Monad m) => e -> ExceptT e m a
throwE = ExceptT . return . Left

catchE :: (Monad m) =>
    ExceptT e m a               -- ^ the inner computation
    -> (e -> ExceptT e' m a)    -- ^ a handler for exceptions in the inner
                                -- computation
    -> ExceptT e' m a
m `catchE` h = ExceptT $ do
    a <- runExceptT m
    case a of
        Left  l -> runExceptT (h l)
        Right r -> return (Right r)

其实就是把其它Monad的值（a）包进了Either，并添上异常信息（e），同时保证Monad类型正确（仍然是m）

throwE把错误信息用Left转成Either，再用return包装成想要的Monad，最后塞给ExceptT构造出ExceptT值

catchE通过runExceptT取出左侧Either，看一眼是否发生了错误，再决定要不要丢给右侧的handler

全弄明白了，那现在尝试给I/O操作添上异常处理：

getString :: ExceptT String IO String
getString = do {
  line <- liftIO getLine;
  if (null line) then
    throwError "empty input"
  else
    return line
} `catchError` (\e -> return "Error occurred, use default string")

safeIO = do
  -- 放心用Right匹配，因为getString有错误处理
  (Right line) <- runExceptT getString
  putStrLn line

注意其中的liftIO :: MonadIO m => IO a -> m a，用来把IO提升到要求的Monad上下文（在上例中是ExceptT）里：

Lift a computation from the IO monad.

而runExceptT用于取出被包在Except里的，例如：

> runExceptT (liftIO getLine :: ExceptT String IO String)
aaa
Right "aaa"

试玩一下：

> safeIO

Error occurred, use default string
> safeIO
abc
abc

符合预期，输入非法的话，就用默认的字符串

P.S.另外，还在ExceptT的基础上定义了Except：

type Except e = ExceptT e Identity

except :: Either e a -> Except e a
except m = ExceptT (Identity m)
runExcept :: Except e a -> Either e a
runExcept (ExceptT m) = runIdentity m

具体见Control.Monad.Trans.Except