newtype Writer w a = Writer { runWriter :: (a, w) }
instance (Monoid w) => Monad (Writer w) where
return x = Writer (x, mempty)
(Writer (x,v)) >>= f = let (Writer (y, v')) = f x in Writer (y, v `mappend` v')
这里旧的定义是指API更改之前的定义,也就是Learn You a Haskell for Great Good!(中文版Haskell趣学指南)这本书中的定义。
newtype Writer w a = Writer { runWriter :: (a, w) } Writer 类型是个 newtype,也就是对现有类型的封装。该类型有两个类型参数:表示状态的类型参数 w 以及表示结果的类型参数 a。 Writer 类型封装的是一对值:(a,w),包括结果值 a 和状态值 w。通过 runWriter 字段可以从 Writer 类型中取出这对值。
instance (Monoid w) => Monad (Writer w) where (Writer w) 类型是 Monad 类型类的一个实例,前提是 w 类型是 Monoid 类型类的一个实例。 对比 Monad 类型类的定义,可知 return 函数的类型签名为: return :: x -> Writer w x 大致相当于 x -> (x,w) 而 bind 函数的类型签名为: (>>=) :: Writer w a -> (a -> Writer w a) -> Writer w a 大致相当于 (a,w) -> (a -> (a,w)) -> (a,w)
return x = Writer (x, mempty) return 函数将结果值设为 x, 状态值设为单位元。
(Writer (x,v)) >>= f = let (Writer (y, v')) = f x in Writer (y, v `mappend` v') 对比函数签名,可知 f 的类型为 a -> Writer w a,大致相当于 a -> (a,w)。 bind组合函数首先计算 f x,也就是用原来的结果值 x 来调用 f,其结果为新的结果值 y 以及新的状态值 v'。 然后将结果值设为新的结果值 y,状态值则设为原来的状态值 v 与新的状态值 v' 联结后的值。
新的定义
newtype WriterT w m a = WriterT { runWriterT :: m (a, w) }
instance (Monoid w, Monad m) => Monad (WriterT w m) where
return a = WriterT $ return (a, mempty)
m >>= k = WriterT $ do
~(a, w) <- runWriterT m
~(b, w') <- runWriterT (k a)
return (b, w `mappend` w')
type Writer w = WriterT w Identity
import Control.Monad.Trans.Writer
gcd' :: Int -> Int -> Writer [String] Int
gcd' a b
| b == 0 = do
tell ["Finished with " ++ show a]
return a
| otherwise = do
tell [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)]
gcd' b (a `mod` b)
main = mapM_ putStrLn . snd . runWriter $ gcd' 8 3
{-
8 mod 3 = 2
3 mod 2 = 1
2 mod 1 = 0
Finished with 1
=}
gcd
import Control.Monad.Trans.Writer
newtype DiffList a = DiffList { getDiffList :: [a] -> [a] }
toDiffList :: [a] -> DiffList a
toDiffList xs = DiffList (xs++)
fromDiffList :: DiffList a -> [a]
fromDiffList (DiffList f) = f []
instance Monoid (DiffList a) where
mempty = DiffList (\xs -> [] ++ xs)
(DiffList f) `mappend` (DiffList g) = DiffList (\xs -> f (g xs))
gcd'' :: Int -> Int -> Writer (DiffList String) Int
gcd'' a b
| b == 0 = do
tell (toDiffList ["Finished with " ++ show a])
return a
| otherwise = do
result <- gcd'' b (a `mod` b)
tell (toDiffList [show a ++ " mod " ++ show b ++ " = " ++ show (a `mod` b)])
return result
main = mapM_ putStrLn . fromDiffList . snd . runWriter $ gcd'' 8 3
{-
Finished with 1
2 mod 1 = 0
3 mod 2 = 1
8 mod 3 = 2
=}