State, Reader 和 Writer Monad

最近又在学习 Monad，这里重新学习一下 State，以及学习功能更受限的 Reader，Writer，不考虑 Monad Transformer 的话题。

State

关于 State Monad 的引入已经学习过很多次了，最典型的例子是使用种子的随机数生成器，其相关操作均满足seed => (returnValue, newSeed)（seed 即 state）的形式，而将其定义为 Monad，能将种子或状态的传递过程隐藏起来，避免类似这样的难看代码：

1
2
3
4
5
6
7
8
9
10
11
12
-- 假设我们有一个 nextInt 函数，根据种子去获取一个随机整数，假设种子是字符串
nextInt :: String -> (Int, String)
nextInt seed = undefined

-- 现在，我们想定义这样一个函数，去根据一个种子去获取 3 个整数
-- 这里故意去使用这种嵌套 let 的形式，并且故意使用 lambda
next3Int :: String -> ((Int, Int, Int), String)
next3Int = \s0 ->
  let (x1, s1) = nextInt s0
   in let (x2, s2) = nextInt s1
       in let (x3, s3) = nextInt s2
           in ((x1, x2, x3), s3)

观察函数 next3Int，可以发现其形式似乎是递归的，考虑把第一层以外的 let 抽象为（不使用闭包的）函数，可以得到：

1
2
3
4
5
6
7
next3Int = \s0 -> let (x1, s1) = nextInt s0 in f x1 s1
  where
    f :: a -> (String -> ((a, Int, Int), String))
    f x1 = \s1 ->
      let (x2, s2) = nextInt s1
       in let (x3, s3) = nextInt s2
           in ((x1, x2, x3), s3)

观察这里的函数f，可以发现，其接受了第一个 nextInt 的返回值x1后，获得了另一个形式和 nextInt 一致的函数f x1，并且整个函数的返回结果也为f x1应用 s0 的结果…这里是一个这样的逻辑：nextInt -> f -> next3Int，定义type State s a = s -> (a, s)，令Int = a, (Int, Int, Int) = b, String = s, 有 State s a -> (a -> State s b) -> State s b，这就是 State 的组合方式，有趣的地方是，这玩意函数体和上面的 next3Int 的形式完全一样：

1
2
bind :: State s a -> (a -> State s b) -> State s b
bind x f = \s -> let (x1, s1) = x s in f x1 s1

这个bind的逻辑可以这样描述：现在有一个初始状态，将其应用到第一个 State，得到结果和新的状态，将结果应用给函数 f，得到新的 State（这允许函数 f 能看到这个结果），再将新的状态应用到这个新的 State。

next3Int 可以使用 bind 去描述，在某些语言里写惯了 flatMap 的话这个还是蛮容易接受的：

1
2
3
4
5
6
next3Int :: String -> ((Int, Int, Int), String)
next3Int = 
  nextInt `bind` \x ->
    nextInt `bind` \y ->
      nextInt `bind` \z ->
        \s -> ((x, y, z), s)  -- (\s -> ((x, y, z), s)) :: State (Int, Int, Int) String，这里已经不需要再执行操作了，因此不改变状态，直接组合结果 x，y，z 即可，这其实就是 return $ ((x, y, z), )

定义

将上面这个形式去抽象，就得到了 Haskell 中State的定义，其中(State s)将成为 Monad 的实例，>>=即为bind。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
  -- State 的 fmap 就是在 State 执行后改变返回值，不改变当前状态
  -- 可以从 Functor laws 去出发——fmap 不改变容器或上下文本身，即这里的 State s
  fmap :: (a -> b) -> State s a -> State s b
  fmap fn (State x) = State $ \s -> 
    let (x', s') = x s
     in (fn x', s')

instance Applicative (State s) where
  pure :: a -> State s a
  pure x = State (x, )
  -- 先用原状态 s 计算 f，得到函数 f'和状态 s1，再用状态 s1 计算 x 得到值 x'和状态 s2
  -- 最终结果为 f' x'，状态为 s2
  (<*>) :: State s (a -> b) -> State s a -> State s b
  (State f) <*> (State x) = State $ \s -> 
    let (f', s1) = f s
        (x', s2) = x s1
     in (f' x', s2)

instance Monad (State s) where
  (>>=) :: State s a -> (a -> State s b) -> State s b
  (State x) >>= f = State $ \s ->
    let (x', s1) = x s
     in runState (f x') s1

操作

但上面的方法还不足以让 State 能满足生产实践，还缺少两个重要的原语——获取状态和设置状态，使用这两个原语，可以定义更多操作。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
-- 从 bind（或 do）的上下文中，用户只能看到 State 的返回值，因此必须把状态当作返回值去返回
get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put x = State $ \_ -> ((), x)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

incAndGet :: Num s => State s s
incAndGet = modify (+ 1) >>= const get

getAndInc :: Num s => State s s 
getAndInc = do
  num <- get
  modify (+ 1)
  return num

用例

State 可以用来模拟全局变量，下面是一个非常简单的交互式控制台程序，其维护两个计数器，提供 inc 和 show 命令；这里的 State Global (IO ()) 可以看作是Global -> (Global, IO ())，区别在于用户不需要显式地通过递归去把结果的 Global 去返回了：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
{-# LANGUAGE OverloadedRecordDot #-}

data Global = Global {
  counterA :: Int,
  counterB :: Int
}

inputHandler :: String -> State Global (IO ())
inputHandler "incA" = do
  modify (\g -> g{counterA = g.counterA + 1})
  Global{counterA=res} <- get
  return $ do
    putStrLn $ "increase counterA, res: " ++ show res
inputHandler "incB" = do
  modify (\g -> g{counterB = g.counterB + 1})
  Global{counterA=res} <- get
  return $ do
    putStrLn $ "increase counterB, res: " ++ show res
inputHandler "show" = do
  Global{counterA, counterB} <- get
  return $ do
    putStrLn $ "counterA: " ++ show counterA ++ ", counterB: " ++ show counterB
inputHandler cmd = do
  return . putStrLn $ "Invalid Command: " ++ cmd

loop :: Global -> IO Global
loop g = do
  putStr "> "
  hFlush stdout -- 没有这一行的话编译运行的时候 > 会在下一行输出，这是因为通过编译运行和通过 ghci 运行时缓冲区配置不同导致的
  input <- getLine
  let (action, newGlobal) = runState (inputHandler input) g
  action
  loop newGlobal

main :: IO ()
main = do
  putStrLn "Hello, World! Valid Command: incA, incB, show"
  void $ loop Global {
    counterA = 0,
    counterB = 0
  }

Reader

动机

State 虽好，但给了使用者太多的自由度——用户既能读也能写，这既增加了对其的理解和维护负担（想想 Scala 的 var 和 val，js 的 let 和 const），也可能导致更多逻辑上的 bug。

Reader 和 Writer 可以认为是 State 增加了相应约束——Reader 只允许读取，Writer 只允许写入。Reader 非常适合用来保存配置信息，或者进行依赖注入。

定义

Reader 的定义去参考 State 的话是容易想到的——State 允许状态改变，但 Reader 不允许状态改变，从 State 的上下文来看，这就是说对s -> (a, s)，返回值元组第二个参数即新的状态必定是和原状态一致，这样我们大可以省略掉第二个元素；而这就是 Reader 的定义：

1
2
3
4
5
6
7
8
9
10
11
12
newtype Reader r a = Reader { runReader :: r -> a }

instance Functor (Reader r) where
  fmap :: (a -> b) -> Reader r a -> Reader r b
  fmap fn (Reader r) = Reader $ \x -> fn $ r x

instance Applicative (Reader r) where
  pure :: a -> Reader r a
  pure x = Reader $ const x
  (<*>) :: Reader r (a -> b) -> Reader r a -> Reader r b
  (Reader f) <*> (Reader x) = Reader $ \r ->
    f r $ x r

操作和用例

Reader 的原语只有一个，称为ask，即获取当前配置：

1
2
ask :: Reader r r
ask = Reader id

但 Reader 所保存的值通常并非是原子的，很可能是一个记录，这时候提供从记录中获取部分字段的方法也是比较有意义的，这里有一个新方法称为asks去解决该问题，下面是定义和用例：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
asks :: (r -> a) -> Reader r a
asks f = fmap f ask

data Config = Config {
  host :: String,
  port :: Int,
  appName :: String
}

-- 实际上等价于 Config -> String，避免了显式地传递配置
hostAndPort :: Reader Config String
hostAndPort = do
  -- 当然，也可以直接用记录解构语法
  h <- asks host
  p <- asks (show . port)
  return $ h ++ p

但上面仍有一个问题——这里每次都是把整个配置全都传递给各个函数，对特定函数，其中可能有很多不需要使用的配置；这会影响程序的耦合性（最小知道原则！），这时候我们可以把 Reader 所保存的信息也给修改；该操作称为 withReader，下面是定义和用例：

1
2
withReader :: (r -> r') -> Reader r' a -> Reader r a
withReader f (Reader r') = Reader $ \r -> r' $ f r

这个定义有点反直觉，但我们手动把 newtype 解包装的话查看签名(r -> r') -> (r' -> a) -> (r -> a)，就会发现这里只有一种组合方式——(r'->a).(r->r')=(r->a)，至于为何如此，写一个用例就能感觉到了：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
data DbConfig = DbConfig {
  address :: String,
  port :: String,
  passwd :: String,
  dbType :: String
}

data Config = Config {
  dbConfig :: DbConfig,
  hostUrl :: String,
  appName :: String
  -- ... others
}

-- 假设我们需要一个方法去根据 DbConfig 去生成 JDBC URl，但不想要任何多余信息：
jdbcUrl :: Reader DbConfig String
jdbcUrl = undefined

-- 然后我们有个需求，要获取字符串形式的一些配置信息，其中包括生成的 jdbcUrl：
formatConfig :: Reader Config String
formatConfig = do
  url <- asks hostUrl
  jdbc <- withReader dbConfig jdbcUrl
  name <- asks appName
  -- ...
  return $ "url: " ++ url ++ ", jdbcUrl: " ++ jdbc -- ++ ...

withReader 也可以用来临时地去修改 r 的值（作用范围显然仅限于第二个参数这个 Reader 中）的同时保持 r 的类型不变，这个操作也叫 local，其函数体和 withReader 一致，但作用域更狭窄，因此应尽量使用它：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
local :: (r -> r) -> Reader r a -> Reader r a
local f (Reader r') = Reader $ \r -> r' $ f r 

-- 假设现在有两种颜色
data Color = Red | Blue

render :: Color -> String -> String
render c s = undefined

-- 根据当前配置去渲染
colored :: String -> Reader Color String
colored str = do
  color <- ask
  return $ render color str
  
-- 现在想要获得与配置渲染的字体以及渲染配置颜色相反的字体
coloredAndRevertColored :: String -> Reader Color (String, String)
coloredAndRevertColored str = do
  -- 在这个简单情景下显然有更容易的方式…
  color <- local revert ask
  originalColor <- ask
  return (render color str, render originalColor str)
  where
    revert Red = Blue
    revert Blue = Red

Writer

Writer 限制无法读，只能写（实际上是“拼接”），从type State s a = s -> (a, s) 出发，就是说这里的函数参数 s 是无法获取到的，因此得到这样的定义，w 为写出的内容，a 为副产品，w 的维护将被隐藏：

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

为什么连函数都丢掉了，直接是(w, a)呢？因为 Haskell 是惰性求值的，用 Scala 的话来说，这里是=> (=> w, => a)（是这样吗？），没有什么问题。

下面是 Writer 的 Monad 实例的定义，这里展示了 Writer 和 State，Reader 一个非常不同的区别——Writer 的类型参数 w 必须是幺半群 Monoid（即（集合，集合上元素的二元运算，单位元）这样一个三元组，典型例子如（字符串，字符串拼接，空字符串），（自然数，加法，零）），不然 pure 没法定义了；这显然也影响了 Writer Monad 的运算的定义——去使用该二运运算去“拼接”每一次运算的 w 作为最终结果：

好奇有没有不使用幺半群的解决方案，这样或许会得到一个不同的 Writer Monad 实现？

1
2
3
4
5
6
7
8
9
10
11
12
13
14
instance Functor (Writer w) where
  fmap :: (a -> b) -> Writer w a -> Writer w b
  fmap f (Writer (w, a)) = Writer (w, f a)

instance Monoid w => Applicative (Writer w) where
  pure :: a -> Writer w a
  pure x = Writer (mempty, x)
  (<*>) :: Writer w (a -> b) -> Writer w a -> Writer w b
  (Writer (w0, f)) <*> (Writer (w1, x)) = Writer (mappend w0 w1, f x)

instance Monoid w => Monad (Writer w) where
  (>>=) :: Writer w a -> (a -> Writer w b) -> Writer w b
  (Writer (w, x)) >>= f = Writer (mappend w w', x')
    where Writer (w', x') = f x

Writer 的原语称为 tell（和 Reader 的 ask 对应），它的实现是显然的：

1
2
tell :: w -> Writer w ()
tell w = Writer (w, ())

基于 Writer 的 w 是幺半群这个特性，很容易想到，它可以用来进行累加和累乘，Control.Monad.Writer包下为这两种情形定义了相应的幺半群 Sum 和 Product：

1
2
3
4
5
6
7
8
9
10
11
plusWriter :: Writer (Sum Int) String
plusWriter = do
  tell $ Sum 3
  tell $ Sum 4
  return "seven" -- (7, "seven")

productWriter :: Writer (Product Int) String
productWriter = do
  tell $ Product 3
  tell $ Product 4
  return "12" -- (12, "12")
Haskell Monad

本博客所有文章除特别声明外，均采用 CC BY-NC-SA 4.0 协议 ，转载请注明出处！