Haskell語言學習筆記（24）MonadWriter, Writer, WriterT

MonadWriter 類型類

class (Monoid w, Monad m) => MonadWriter w m | m -> w where
    writer :: (a,w) -> m a
    writer ~(a, w) = do
      tell w
      return a

    tell   :: w -> m ()
    tell w = writer ((),w)

    listen :: m a -> m (a, w)
    pass   :: m (a, w -> w) -> m a

listens :: MonadWriter w m => (w -> b) -> m a -> m (a, b)
listens f m = do
    ~(a, w) <- listen m
    return (a, f w)

censor :: MonadWriter w m => (w -> w) -> m a -> m a
censor f m = pass $ do
    a <- m
    return (a, f)

instance (Monoid w, Monad m) => MonadWriter w (Lazy.WriterT w m) where
    writer = Lazy.writer
    tell   = Lazy.tell
    listen = Lazy.listen
    pass   = Lazy.pass

instance (Monoid w, Monad m) => MonadWriter w (Strict.WriterT w m) where
    writer = Strict.writer
    tell   = Strict.tell
    listen = Strict.listen
    pass   = Strict.pass

• class (Monoid w, Monad m) => MonadWriter w m | m -> w where
  MonadWriter 是個類型類，它爲 WriterT, RWST 等具備 Writer 功能的 Monad 定義了通用接口。
  所謂 Writer 功能是指將程序的行爲記錄下來，也能夠理解爲日誌。
  MonadWriter 包含四個函數：writer, tell, listen, pass。
  writer (a,w) 記錄輸出信息 w，返回結果值 a。
  tell w 記錄輸出信息 w，返回結果值 ()。
  listen m 將結果值設置爲由結果值和輸出信息組成的二元組 (a, w)，輸出信息不變。
  pass m 將結果值解析爲結果值 a 和函數 f 組成的二元組，設置結果值 a, 而後對輸出信息 w 調用函數 f。
  另外同一個模塊中還定義了 listens 和 censor 函數。
  listens f m 將結果值設置爲由結果值和輸出信息（調用函數 f 修改後的返回值）組成的二元組 (a, f w)，輸出信息不變。
  censor f m 對輸出信息 w 調用函數 f，結果值不變。
  What's the 「|」 for in a Haskell class definition?

• instance (Monoid w, Monad m) => MonadWriter w (Lazy.WriterT w m) where
  writer = Lazy.writer
  對於 WriterT 這個Monad轉換器來講，writer等函數的定義均由 WriterT 模塊來提供。注意這裏點運算符的含義不是函數的合成而是受限名字。
  Hackage - Where is the MonadReader implementation for ReaderT defined?

WriterT Monad轉換器

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

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')

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

• newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
  WriterT 類型是個 newtype，也就是對現有類型的封裝。該類型有三個類型參數：內部 Monad 類型參數 m，輸出信息類型參數 w 以及結果類型參數 a。
  WriterT 類型封裝的是一對封裝在內部 Monad m 中的值：m (a,w)，包括結果值 a 和輸出信息 w。經過 runWriterT 字段能夠從 Writer 類型中取出這對值。
• instance (Monoid w, Monad m) => Monad (WriterT w m) where
  若是 w 是個 Monoid 而且 m 是個 Monad，那麼 WriterT w m 也是一個 Monad。
  對比 Monad 類型類的定義，可知 return 函數的類型簽名爲：
• return :: a -> WriterT w m a
  大體至關於 a -> m (a,w)
  而 bind 函數的類型簽名爲：
  (>>=) :: WriterT w m a -> (a -> Writer w m a) -> Writer w m a
  大體至關於 m (a,w) -> (a -> m (a,w)) -> m (a,w)
• return a = writer (a, mempty)
  writer = WriterT . return
  return 函數將結果值設爲 a, 輸出信息設爲單位元，而後調用 writer 函數依次把這對值封裝進了內部 Monad m 和 Monad 轉換器 WriterT 之中。
• m >>= k = WriterT $ do
  對比函數簽名，可知 m 的類型爲 Writer w m a，大體至關於 m (a,w)。
  而 k 的類型爲 a -> WriterT w m a，大體至關於 a -> m (a,w)。
• ~(a, w) <- runWriterT m
  這裏首先利用 runWriterT 字段和 <- 運算符取出封裝在 WriterT Monad m 中的一對值：結果值 a 和輸出信息 w。
• ~(b, w') <- runWriterT (k a)
  根據 k 的類型 a -> WriterT w m a，可知 k a 的類型爲 WriterT w m a，即 k a 也是一個 WriterT Monad。
  這裏再次利用 runWriterT 字段和 <- 運算符取出封裝在 WriterT Monad (k a) 中的一對值：新的結果值 b 和新的輸出信息 w'。
• return (b, w `mappend` w')
  最後將結果值設爲新的結果值 b，輸出信息則設爲原來的輸出信息 w 與新的輸出信息 w' 聯結後的值。
  return 函數讓這對值從新進入內部 Monad m 之中。

證實 WriterT r m 符合Monad法則：
1. return a >>= f ≡ f a
return a >>= f
≡ writer (a, mempty) >>= f
≡ (WriterT . return) (a, mempty) >>= f
≡ WriterT (m (a, mempty)) >>= f
≡ WriterT $ do {~(a, w)  <- runWriterT (WriterT (m (a, mempty))); ~(b, w') <- runWriterT (f a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- m (a, mempty)); ~(b, w') <- runWriterT (f a); return (b, w <> w')}
≡ WriterT $ do {~(b, w') <- runWriterT (f a); return (b, empty <> w')}
≡ WriterT $ do {~(b, w') <- runWriterT (f a); return (b, w')}
≡ WriterT $ runWriterT (f a)
≡ f a
2. m >>= return ≡ m
m = WriterT (n (a w))
m >>= return
≡ WriterT (n (a w)) >>= return
≡ WriterT $ do {~(a, w)  <- runWriterT (WriterT (n (a, w))); ~(b, w') <- runWriterT (return a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- n (a, w)); ~(b, w') <- runWriterT (WriterT (m (a, mempty))); return (b, w <> w')}
≡ WriterT $ do {~(b, w') <- runWriterT (WriterT (m (a, mempty))); return (b, w <> w')}
≡ WriterT $ do {~(b, w') <- (m (a, mempty)); return (b, w <> w')}
≡ WriterT $ do {return (a, w <> empty)}
≡ WriterT $ do {return (a, w)}
≡ WriterT (n (a w))
≡ m
3. (m >>= f) >>= g ≡ m >>= (\x -> f x >>= g)
假設 m = WriterT (n (a1, w1)), f a1 = WriterT (n (a2, w2)), g a2 = WriterT (n (a3, w3))
(m >>= f) >>= g
≡ (WriterT $ do {~(a, w)  <- runWriterT m; ~(b, w') <- runWriterT (f a); return (b, w <> w')}) >> g
≡ WriterT $ do {~(a, w)  <- runWriterT (WriterT $ do {~(a, w)  <- runWriterT m; ~(b, w') <- runWriterT (f a); return (b, w <> w')}); ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- do {~(a, w)  <- runWriterT m; ~(b, w') <- runWriterT (f a); return (b, w <> w')}; ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- do {~(a, w)  <- runWriterT (WriterT (n (a1, w1))); ~(b, w') <- runWriterT (f a); return (b, w <> w')}; ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- do {~(a, w)  <- n (a1, w1); ~(b, w') <- runWriterT (f a); return (b, w <> w')}; ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- do {~(b, w') <- runWriterT (f a1); return (b, w1 <> w')}; ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- do {~(b, w') <- runWriterT (WriterT (n (a2, w2))); return (b, w1 <> w')}; ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- do {~(b, w') <- n (a2, w2); return (b, w1 <> w')}; ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- n (a2, w1 <> w2); ~(b, w') <- runWriterT (g a); return (b, w <> w')}
≡ WriterT $ do {~(b, w') <- runWriterT (g a2); return (b, (w1 <> w2) <> w')}
≡ WriterT $ do {~(b, w') <- runWriterT (WriterT (n (a3, w3))); return (b, (w1 <> w2) <> w')}
≡ WriterT $ do {~(b, w') <- n (a3, w3); return (b, (w1 <> w2) <> w')}
≡ WriterT (n (a3, (w1 <> w2) <> w3))
m >>= (\x -> f x >>= g)
≡ WriterT $ do {~(a, w)  <- runWriterT m; ~(b, w') <- runWriterT ((\x -> f x >>= g) a); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- runWriterT m; ~(b, w') <- runWriterT (f a >>= g); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- runWriterT m; ~(b, w') <- runWriterT (WriterT $ do {~(a, w)  <- runWriterT (f a); ~(b, w') <- runWriterT (g a); return (b, w <> w')}); return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- runWriterT m; ~(b, w') <- do {~(a, w)  <- runWriterT (f a); ~(b, w') <- runWriterT (g a); return (b, w <> w')}; return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- runWriterT (WriterT (n (a1, w1))); ~(b, w') <- do {~(a, w)  <- runWriterT (f a); ~(b, w') <- runWriterT (g a); return (b, w <> w')}; return (b, w <> w')}
≡ WriterT $ do {~(a, w)  <- n (a1, w1); ~(b, w') <- do {~(a, w)  <- runWriterT (f a); ~(b, w') <- runWriterT (g a); return (b, w <> w')}; return (b, w <> w')}
≡ WriterT $ do {~(b, w') <- do {~(a, w)  <- runWriterT (f a1); ~(b, w') <- runWriterT (g a); return (b, w <> w')}; return (b, w1 <> w')}
≡ WriterT $ do {~(b, w') <- do {~(a, w)  <- runWriterT (WriterT (n (a2, w2))); ~(b, w') <- runWriterT (g a); return (b, w <> w')}; return (b, w1 <> w')}
≡ WriterT $ do {~(b, w') <- do {~(a, w)  <- n (a2, w2); ~(b, w') <- runWriterT (g a); return (b, w <> w')}; return (b, w1 <> w')}
≡ WriterT $ do {~(b, w') <- do {~(b, w') <- runWriterT (g a2); return (b, w2 <> w')}; return (b, w1 <> w')}
≡ WriterT $ do {~(b, w') <- do {~(b, w') <- runWriterT (WriterT (n (a3, w3))); return (b, w2 <> w')}; return (b, w1 <> w')}
≡ WriterT $ do {~(b, w') <- do {~(b, w') <- n (a3, w3); return (b, w2 <> w')}; return (b, w1 <> w')}
≡ WriterT $ do {~(b, w') <- n (a3, w2 <> w3); return (b, w1 <> w')}
≡ WriterT (n (a3, w1 <> (w2 <> w3))
根據 Monoid 的法則：(x <> y) <> z = x <> (y <> z)
WriterT (n (a3, (w1 <> w2) <> w3))
≡ WriterT (n (a3, w1 <> (w2 <> w3))

lift 函數

instance (Monoid w) => MonadTrans (WriterT w) where
    lift m = WriterT $ do
        a <- m
        return (a, mempty)

證實 WriterT 中 lift 函數的定義符合 lift 的法則。
1. lift . return ≡ return
lift . return $ a
≡ lift (m a)
≡ WriterT $ do {a <- m a; return (a, mempty)}
≡ WriterT $ m (a, mempty)
≡ return a
2. lift (m >>= f) ≡ lift m >>= (lift . f)
假設 m = n a 而且 f a = n b
因而 m >>= f = n b
lift (m >>= f)
≡ lift (n b)
≡ WriterT $ do {a <- n b; return (a, empty)}
≡ WriterT $ n (b, empty)
lift m >>= (lift . f)
≡ (WriterT $ do {a <- n a; return (a, empty)}) >>= (\x -> WriterT $ do {a <- f x; return (a, empty)})
≡ (WriterT $ n (a empty)) >>= (\x -> WriterT $ do {a <- f x; return (a, empty)})
≡ WriterT $ do {runWriterT $ WriterT $ do {a <- f a; return (a, empty <> empty)}}
≡ WriterT $ do {runWriterT $ WriterT $ do {a <- n b; return (a, empty)}}
≡ WriterT $ do {runWriterT $ WriterT $ n (b empty)}
≡ WriterT $ n (b empty)

WriterT Monad轉換器的函數

tell :: (Monad m) => w -> WriterT w m ()
tell w = writer ((), w)

listen :: (Monad m) => WriterT w m a -> WriterT w m (a, w)
listen m = WriterT $ do
    ~(a, w) <- runWriterT m
    return ((a, w), w)

listens :: (Monad m) => (w -> b) -> WriterT w m a -> WriterT w m (a, b)
listens f m = WriterT $ do
    ~(a, w) <- runWriterT m
    return ((a, f w), w)

pass :: (Monad m) => WriterT w m (a, w -> w) -> WriterT w m a
pass m = WriterT $ do
    ~((a, f), w) <- runWriterT m
    return (a, f w)

censor :: (Monad m) => (w -> w) -> WriterT w m a -> WriterT w m a
censor f m = WriterT $ do
    ~(a, w) <- runWriterT m
    return (a, f w)

execWriterT :: (Monad m) => WriterT w m a -> m w
execWriterT m = do
    (_, w) <- runWriterT m
    return w

mapWriterT :: (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT f m = WriterT $ f (runWriterT m)

Prelude Control.Monad.Writer> runWriterT $ tell "abc"
((),"abc")
Prelude Control.Monad.Writer> runWriterT $ tell "abc" >> tell "def"
((),"abcdef")
Prelude Control.Monad.Writer> runWriterT $ tell "abc" >> return 3
(3,"abc")
Prelude Control.Monad.Writer> runWriterT $ tell "abc" >> listen (tell "def")
(((),"def"),"abcdef")
Prelude Control.Monad.Writer> runWriterT $ listens (++ "def") $ tell "abc"
(((),"abcdef"),"abc")
Prelude Control.Monad.Writer> runWriterT $ pass $ tell "abc" >> return (0, (++ "def"))
(0,"abcdef")
Prelude Control.Monad.Writer> runWriterT $ censor (++ "def") $ tell "abc"
((),"abcdef")

Writer Monad

type Writer w = WriterT w Identity

runWriter :: Writer w a -> (a, w)
runWriter = runIdentity . runWriterT

execWriter :: Writer w a -> w
execWriter m = snd (runWriter m)

mapWriter :: ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
mapWriter f = mapWriterT (Identity . f . runIdentity)

Writer Monad 是 WriterT Monad（轉換器） 的一個特例。

應用實例

import Control.Monad.Trans.Writer
      
logNumber :: Int -> Writer [String] Int  
logNumber x = writer (x, ["Got number: " ++ show x])

logNumber2 :: Int -> Writer [String] Int  
logNumber2 x = do
    tell ["Got number: " ++ show x]
    return x            
      
multWithLog :: Writer [String] Int
multWithLog = do  
    a <- logNumber 3  
    b <- logNumber 5
    tell ["multiplying " ++ show a ++ " and " ++ show b ]
    return (a*b)
    
main :: IO ()
main = print $ runWriter multWithLog -- (15,["Got number: 3","Got number: 5","multiplying 3 and 5"])