PR

エラー・モナドと他のモナドをモナド変換子で合成する

 エラー・モナド単体では,Maybeモナドに比べてそれほど便利だとは思えないかもしれません。エラー・モナドの真価は,他のモナドに対してエラー処理の能力を追加するモジュールとして扱えるところにあります( 参考リンク)。これは

  • 第15回で紹介したStateTやListTのように,エラー・モナドをモナド変換子にしたErrorTを用いて既存のモナドmと合成したErrorT mモナドを作成する
  • StateTやListTといったモナド変換子nTを用いて,エラー・モナドeと合成したnT eモナドを作成する

といった方法で実現できます。

 まず,Control.Monad.Errorモジュールで提供されているErrorTモナド変換子の使い方を見ていきましょう。ErrorTモナド変換子は,Either型によるエラー・モナドをモナド変換子にしたものです。

newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }

 ListTやStateTと同様に,ErrorTモナド変換子は型構成子上の表現「ErrorT e m a」とは逆の「m (Either e a)」の形で,合成の対象であるモナドmに包まれた値を保持します。

 ErrorTモナド変換子のFunctor,Monad,MonadPlus,MonadErrorの各インスタンスの定義は以下の通りです。

instance (Monad m) => Functor (ErrorT e m) where
    fmap f m = ErrorT $ do
        a <- runErrorT m
        case a of
            Left  l -> return (Left  l)
            Right r -> return (Right (f r))

instance (Monad m, Error e) => Monad (ErrorT e m) where
    return a = ErrorT $ return (Right a)
    m >>= k  = ErrorT $ do
        a <- runErrorT m
        case a of
            Left  l -> return (Left l)
            Right r -> runErrorT (k r)
    fail msg = ErrorT $ return (Left (strMsg msg))

instance (Monad m, Error e) => MonadPlus (ErrorT e m) where
    mzero       = ErrorT $ return (Left noMsg)
    m `mplus` n = ErrorT $ do
        a <- runErrorT m
        case a of
            Left  _ -> runErrorT n
            Right r -> return (Right r)

~ 略 ~

instance (Monad m, Error e) => MonadError e (ErrorT e m) where
    throwError l     = ErrorT $ return (Left l)
    m `catchError` h = ErrorT $ do
        a <- runErrorT m
        case a of
            Left  l -> runErrorT (h l)
            Right r -> return (Right r)

 runErrorTを使って取り出したモナドmの内部での計算として,Eitherモナドの再定義を行っているのがわかります。

 ただし,モナドmにErrorTモナド変換子を適用して「ErrorT m(m Either)」という合成モナドを作ることで,合成前のモナドmに対する演算が使えなくなってしまっては,合成を行う目的を果たせません。そこで合成前のモナドmに対する演算を合成後のモナドでも利用できるよう,MonadTransクラスなどのインスタンスも定義されています。

instance (Error e) => MonadTrans (ErrorT e) where
    lift m = ErrorT $ do
        a <- m
        return (Right a)

instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
    liftIO = lift . liftIO

~ 略 ~

instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where
    get = lift get
    put = lift . put

 では,ErrorTモナド変換子を使ってエラー・モナドと他のモナドを合成する例を見ていきましょう。以下に示したのは「エラー・モナドとStateモナドを合成したErrorT State(State Either)モナド」や「エラー・モナドとSTモナドを合成したErrorT ST(ST Either)モナド」といった単純合成の例です。

module ErrorMonadTrans where
import Control.Monad.Error
import Control.Monad.List
import Control.Monad.State

import Control.Monad.ST
import Data.STRef

stateError :: Error e => ErrorT e (State String) Int
stateError = do
    put "ushi"
    return 2009

stateError' :: ErrorT String (State String) Int
stateError' = stateError

stateError'' :: ErrorT IOError (State String) Int
stateError'' = stateError

runStateError init m = runState (runErrorT m) init


stError :: Error e => ErrorT e (ST s) (STRef s String)
stError = do
    ref <- lift $ newSTRef "ushi"
    return ref

stError' :: Error e => ErrorT e (ST s) String
stError' = do
    ref <- stError
    lift $ writeSTRef ref "nezumi"
    val <- lift $ readSTRef ref
    return val

stError'' :: ErrorT String (ST s) String
stError'' = stError'

stError''' :: ErrorT IOError (ST s) String
stError''' = stError'


causeError :: (Error a, MonadError a m) => m b
causeError = throwError noMsg

causeError' :: (Error a, MonadError a m) => m b
causeError' = throwError $ strMsg "error occur."

causeError'' :: (Error a, MonadError a m, Num b) => m b
causeError'' = do
    return (-1)
    throwError noMsg
    throwError $ strMsg "error occur."

*ErrorMonadTrans> runStateError "nezumi" $ stateError'
(Right 2009,"ushi")
*ErrorMonadTrans> runStateError "nezumi" $ stateError''
(Right 2009,"ushi")
*ErrorMonadTrans> runStateError "nezumi" $ stateError'
(Right 2009,"ushi")
*ErrorMonadTrans> runStateError "nezumi" $ stateError' >> causeError
(Left "","ushi")
*ErrorMonadTrans> runStateError "nezumi" $ stateError' >> causeError'
(Left "error occur.","ushi")
*ErrorMonadTrans> runStateError "nezumi" $ stateError'' >> causeError'
(Left user error (error occur.),"ushi")
*ErrorMonadTrans> runStateError "nezumi" $ stateError' `mplus` causeError
(Right 2009,"ushi")
*ErrorMonadTrans> runStateError "nezumi" $ causeError'' `mplus` stateError'
(Right 2009,"ushi")
*ErrorMonadTrans> runStateError "nezumi" $ (stateError' >> causeError') `mplus` causeError''
(Left "","ushi")
*ErrorMonadTrans> runStateError "nezumi" $ (stateError' >> causeError') `catchError` (\_ -> return 2009)
(Right 2009,"ushi")
*ErrorMonadTrans> runST $ runErrorT stError''
Right "nezumi"
*ErrorMonadTrans> runST $ runErrorT $ stError'' >> causeError
Left ""
*ErrorMonadTrans> runST $ runErrorT $ stError''' >> causeError
Left user error
*ErrorMonadTrans> runST $ runErrorT $ stError'' `mplus` causeError'
Right "nezumi"
*ErrorMonadTrans> runST $ runErrorT $ causeError' `mplus` stError'''
Right "nezumi"
*ErrorMonadTrans> runST $ runErrorT $ (causeError >> stError'') `catchError` (\_ -> return "ushi")
Right "ushi"
*ErrorMonadTrans> runST $ runErrorT $ (causeError' >> stError') `catchError` (\str -> return $ "caught error: " ++ str)
Right "caught error: error occur."

 元になったStateモナドやSTモナド,Either型で定義されたエラー・モナドとほぼ同じ感覚で合成したモナドを使えることがわかります。

 今度は逆に,エラー・モナドに対してモナド変換子を使う場合を見てみましょう。

 ErrorTモナド変換子だけでは,エラー・モナドの利用可能な範囲や使い勝手が制限されてしまいます。実際のプログラミングでは,EitherモナドやErrorTモナド変換子を使って合成した「ErrorT m(m Either)モナド」のように,コード内ですでに利用しているエラー・モナドに対して後から他のモナドの能力を追加したくなることもあるでしょう。また,ErrorTモナド変換子を使って合成するよりも他のモナド変換子を使ってエラー・モナドと合成したほうが,コード内の記述がより明確になることもあります。

 そうした場合,ErrorTではない他のモナド変換子を使って他のモナドの能力を追加したほうがよいでしょう。

 ただ,ErrorT以外のモナド変換子を使う場合に心配なのは,エラー処理のために用意されているthrowErrorメソッドやcatchErrorメソッドがモナドの合成によって使いにくくなってしまうことです。この問題を解決するため,mtlパッケージでは各モナド変換子を定義しているモジュールでそれぞれのモナド変換子型に対するインスタンスを用意しています。

 Control.Monad.State.LazyおよびControl.Monad.ST.Strictで定義されているStateTモナド変換子でのインタンスの定義は以下の通りです。

instance (MonadError e m) => MonadError e (StateT s m) where
    throwError       = lift . throwError
    m `catchError` h = StateT $ \s -> runStateT m s
        `catchError` \e -> runStateT (h e) s

 また,Control.Monad.ListではListTモナド変換子に対するインスタンスが用意されています。

instance (MonadError e m) => MonadError e (ListT m) where
    throwError       = lift . throwError
    m `catchError` h = ListT $ runListT m
        `catchError` \e -> runListT (h e)

 catchErrorの定義に第15回で紹介したliftが用いられていないのは,型の異なる二つの引数を必要とするためです。liftは一つの引数しか扱えません。

Prelude Control.Monad.Error> :t lift
lift :: (MonadTrans t, Monad m) => m a -> t m a
Prelude Control.Monad.Error> :t catchError
catchError :: (MonadError e m) => m a -> (e -> m a) -> m a

 このため,catchErrorは,run*Tとデータ構成子を使って新たにモナドを構成し直すよう記述されているのです。

 ListTモナド変換子を使って合成したモナドがcatchErrorメソッドやthrowErrorメソッドをきちんと利用できるかどうか,実際に試してみましょう。上で定義したErrorMonadTransモジュールに以下の関数を加え,それぞれの関数を使った式を処理系に評価させることにします。

runStateErrorList val = runStateError val . runListT

stateErrorList :: ListT (ErrorT String (State String)) Int
stateErrorList = do
    val <-get
    put $ val ++ ": ushi"
    return 2009

stateErrorList'  = stateErrorList
                   `catchError`
                   (\_ -> return 1997 `mplus` return 2009)

stateErrorList'' = stateErrorList >> causeError
                   `catchError`
                   (\_ -> return 1997 `mplus` return 2009)

*ErrorMonadTrans> runStateErrorList "eto" stateErrorList
(Right [2009],"eto: ushi")
*ErrorMonadTrans> runStateErrorList "eto" $ stateErrorList >> causeError'
(Left "error occur.","eto: ushi")
*ErrorMonadTrans> runStateErrorList "eto" stateErrorList'
(Right [2009],"eto: ushi")
*ErrorMonadTrans> runStateErrorList "eto" stateErrorList''
(Right [1997,2009],"eto: ushi")

 throwErrorがエラーを発生させ,catchErrorでエラーからの回復が行われているのを確認できました。