组合两个 Monad 的 Monad

本文为 Monad Transformers 的学习笔记。

困境

有时候需要校验输入内容。比如验证是否为符合要求的密码

1
2
3
4
5
6
7
8
import Data.Char
import Data.Maybe

isValid :: String -> Bool
isValid s = length s >= 8
            && any isAlpha s
            && any isNumber s
            && any isPunctuation s

获取输入

1
2
3
4
5
-- 因为需要携带值，所以这里使用 Maybe String 而不是 Bool
getPassphrase :: IO (Maybe String)
getPassphrase = do s <- getLine
                   if isValid s then return $ Just s
                                else return Nothing

校验

1
2
3
4
5
6
askPassphrase :: IO ()
askPassphrase = do putStrLn "请输入密码："
                   maybe_value <- getPassphrase
                   if isJust maybe_value -- 这里手动判断是否合法
                     then do putStrLn maybe_value ++ " 是个不错的密码" 
                     else return ()

代码中使用 isJust 判断是否合法。在数量比较少的情况下不是什么问题。通常使用 Maybe Monad 是不需要手动判断是否为 Just 。因为有 >>= 。

所以这里是否能使用 Maybe Monad 来避免手动检查呢。

假设去点 isJust 的三行判断代码。从新编写一个函数

1
2
3
4
askPassphrase :: IO ()
askPassphrase = do putStrLn "请输入密码："
                   maybe_value <- getPassphrase
                   maybe_value >>= f

这个 f 的类型是什么呢？

首先 askPassphrase 的类型是 IO () 。所以 f 需要返回 IO ()

而 f 又接受一个 String 类型的参数。

所以 f 的类型应该是

1
f :: String -> IO ()

但是这样不能用于 maybe_value >>= f 因为 >>= 的类型是

1
2
Prelude> :t (>>=)
(>>=) :: Monad m => m a -> (a -> m b) -> m b

所以要使用 >>= ，f 的类型必须是

1
f :: String -> Maybe String

显然两个类型冲突了，所以写不出来。

所以需要一个能够转换 Maybe Monad 和 IO Monad 的类型。

这个就是 Monad Transformers

定义

定义 Maybe Monad 的 Monad Transformer MaybeT

1
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }

其中 m 可以为任意 Monad

Monad Transformer 本身也是 Monad 。所以需要实现 return 和 >>=

1
2
3
instance Monad m => Monad (MaybeT m) where
    return  = MaybeT . return . Just
    -- return a = MaybeT . return . Just a

Just 将 a 转化为 Maybe a 类型

return 将 Maybe a 转化为 m (Maybe a) 类型

MaybeT 将 m (Maybe a) 转化为 MaybeT m (Maybe a) 类型。

接着实现 >>=

1
2
3
4
5
6
7
-- (>>=) 定义中的 m 为 MaybeT m
(>>=) :: MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b

x >>= f = MaybeT $ do maybe_value <- runMaybeT x
                      case maybe_value of
                           Nothing    -> return Nothing
                           Just value -> runMaybeT $ f value

为了使用方便，顺便实现相应的 MonadPlus 和 MonadTrans

1
2
3
4
5
6
7
8
9
instance Monad m => MonadPlus (MaybeT m) where
    mzero     = MaybeT $ return Nothing
    mplus x y = MaybeT $ do maybe_value <- runMaybeT x
                            case maybe_value of
                                 Nothing    -> runMaybeT y
                                 Just _     -> return maybe_value

instance MonadTrans MaybeT where
    lift = MaybeT . (liftM Just)

改写

有了 MaybeT 代码可以这么写

1
2
3
4
5
6
7
8
9
getValidPassphrase :: MaybeT IO String
getValidPassphrase = do s <- lift getLine -- 将 IO String 提升为 Maybe (IO String)
                        guard (isValid s) -- MonadPlus 类型类使我们能够使用 guard. 这里 s 为 String 类型
                        return s

askPassphrase :: MaybeT IO ()
askPassphrase = do lift $ putStrLn "输入新密码:" -- 将 IO () 提升为 Maybe (IO ())
                   value <- getValidPassphrase -- value 为 String 类型
                   lift $ putStrLn "储存中..."

没有了检查的过程，因为全都藏在 MaybeT 的 >>= 里面了。