モナドトランスフォーマーとmonad-control

Haskell

アドベントカレンダーのいいネタが無いなあと思っていたところ、ちょうど週末にあたらしいmonad-controlがリリースされたので、これを紹介したいなと思いました。

その前に、モナドトランスフォーマーというかっこいい名前の代物の話をちょっとだけしましょう。

モナドトランスフォーマーと例外処理

Haskellerの皆さんはきっと息をするかのように自然にモナドを使っていることと思います。標準で提供されているモナドは単機能なので、組み合わせたくなってきます。必然的に皆モナドトランスフォーマーに手を伸ばすわけです。実際のアプリケーションのコードを書くと、多くのモナドではベースモナドがIOになるでしょうから、今度は自作したカスタムモナドスタックでIOが投げる例外をハンドルしたくなるわけです。

ここでふとControl.Exception.catchの型をみると

Prelude> :t Control.Exception.catch
Control.Exception.catch
  :: Exception e => IO a -> (e -> IO a) -> IO a

catchに渡すアクションはIO aで、例外ハンドラはException e => e -> IO aという型です。

一方あなたの書いたアプリケーションは例えばこんな感じになっていることでしょう。

newtype MyAppT m a = MyAppT { runMyAppT :: StateT MyAppState (ReaderT MyAppEnv m) a }
  deriving (Functor, Applicative, Monad, MonadIO, ...)

runMyApp :: Monad m => MyAppT m a -> MyAppState -> MyAppEnv -> m a
runMyApp act st = runReaderT (runStateT (runMyAppT act) st)

app :: MonadIO m => MyAppT m a
app = do
  liftIO $ putStrLn "Hello, MyApp!"
  ...

main :: IO ()
main = do
  env <- setupMyAppEnv -- getArgsなどして必要な環境を作る
  runMyApp app initialMyAppState env -- 初期状態と一緒に渡してappを走らせる

このアプリ内で例外を扱いたい場合、catchの型は

catch :: Exception e => IO a -> (e -> IO a) -> IO a

ではなく

catch :: (Exception e, MonadIO m) => MyAppT m a -> (e -> MyAppT m a) -> MyAppT m a

より一般的には

catch :: (Exception e, MonadIO m) => m a -> (e -> m a) -> m a

みたいな一般的な型になっていると便利です。これを統一的に扱う仕組みがmonad-controlというわけです。

monad-control

最新のmonad-controlでは主要なパッケージが3つに分かれています。

  • monad-controlパッケージ
    • MonadTransControlクラスとMonadBaseControlクラスおよびそれらのインスタンスを提供
  • transformers-baseパッケージ
    • MonadBaseControlクラスの親となるMonadBaseクラスとそのインスタンスを提供
  • lifted-baseパッケージ
    • Control.ExceptionやControl.ConcurrentあるいはSystem.Timeoutの関数をmonad-controlで一般化した関数を提供

先の例に適用するとこんな感じになります。

newtype MyAppT m a = MyAppT
  { runMyAppT :: ReaderT MyAppEnv (StateT MyAppState m) a
  } deriving ( Functor
             , Applicative
             , Monad
             , MonadIO
             , MonadState MyAppState
             , MonadReader MyAppEnv
             , MonadBase base
             )

instance MonadTrans MyAppT where
  lift = MyAppT . lift . lift

instance MonadTransControl MyAppT where
  newtype StT MyAppT a = StMyApp { unStMyApp :: (a, MyAppState) }
  liftWith f = MyAppT . ReaderT $ \r -> StateT $ \s ->
    liftM (\x -> (x, s))
          (f $ \t -> liftM StMyApp
            (runStateT (runReaderT (runMyAppT t) r) s))
  restoreT = MyAppT . ReaderT . const . StateT . const . liftM unStMyApp

instance MonadBaseControl base m => MonadBaseControl base (MyAppT m) where
  newtype StM (MyAppT m) a = StMMyAppT { unStMMyAppT :: ComposeSt MyAppT m a }
  liftBaseWith = defaultLiftBaseWith StMMyAppT
  restoreM = defaultRestoreM unStMMyAppT

どうしてこれでうまくいくかは、MonadTransControlのIdentityTに対するインスタンスと、上のコードをじっくり読めばわかります。

簡単に解説すると、MonadTransControlクラスのliftWith :: Monad m => (Run t -> m a) -> t m aはモナドスタックt m aを一つpopした型m aを弄れるようにする役割を持ち、MonadBaseControlのliftBaseWith :: (RunInBase m b -> b a) -> m aは、スタックの最下部までpopしたベースモナドの型b aを弄れるようにする役割を持っています。デフォルトではMonadBaseControlの関数はMonadTransControlの関数を使って定義するので、自作のモナドトランスフォーマーは両方のインスタンスを定義してあげましょう。

これで準備は整いました。lifted-baseを使うと先のコードで上げられた例外を、MyAppT m aの中で綺麗にキャッチできるようになりました。めでたしめでたし。

import Control.Exception.Lifted (catch)

-- この例を実際に書くときはbracketを使おう
app :: MonadIO m => MyAppT m ()
app = do
  liftIO $ putStrLn "Hello, MyApp!"
  liftIO $ do
        h <- openFile "/home/maoe/NoSuchFile" ReadMode
        hGetContents h
        hClose h
    `catch` \(e :: SomeException) -> putStrLn $ "Caught " ++ show e

参考リンク

  • モナドトランスフォーマーの使い方
  • monad-control
    • 面倒になって端折ってしまった導入の動機付けとカラクリはmonad-controlに丁寧に解説されています。
      • ただし想定しているmonad-controlが古いインタフェースなので、実際のコードを書くときは上のコードを参考にすると良いと思います。