Haskell で RAII 的な処理を行うモナドを作ってみた

ふと Haskell で RAII が行いたくなったので，モナドで実装してみました：

module RAII (
  RAII(), unsafeExtractRAII, unextractRAII,
  runRAII, scoped, unsafeReleaseRAII', unsafeReleaseRAII,
  wrapRAII, liftIO, onDisposed, disposedWith, disposedWith_,
 ) where

import Control.Applicative
import Control.Monad.IO.Class
import Control.Exception.Base


-- Haskell 上で RAII (Resource Acquisition Is Initialization) を実現する為のモナド
newtype RAII a = RAII { unsafeExtractRAII :: IO ( a, IO () ) }

-- データコンストラクタ RAII は公開しない
-- パターンマッチで unsafeExtractRAII を取り出されると RAII の意味論を破壊される恐れがあるため
-- 代わりに unsafeExtractRAII と unextractRAII の二者を用意．
-- どちらも危険性の高い関数なので，取り扱いの際は自己責任で．
unextractRAII :: IO ( a, IO () ) -> RAII a
unextractRAII = RAII


-- 破棄関数の起動

-- RAII モナドを IO アクションに変換する
-- 変換された IO アクションを実行すると， RAII モナドに関連付けられたアクションに続き，
-- RAII モナドに関連付けられた破棄関数が呼び出される．
runRAII :: RAII a -> IO a
runRAII (RAII x) = do { (a, action) <- x; action; return a }

-- runRAII の一般化版，特に理由がなければ こちらを使うのが楽
-- 特に RAII モナドを戻り値に使う場合に有効
scoped :: MonadIO m => RAII a -> m a
scoped = liftIO . runRAII


-- RAII モナドを破棄関数を呼び出さない IO アクションに変換する
-- （ただし，途中で例外が投げられた場合には破棄関数が呼び出される）
unsafeReleaseRAII' :: RAII a -> IO a
unsafeReleaseRAII' (RAII x) = do { (a, _) <- x; return a }

-- MonadIO に一般化された unsafeReleaseRAII
unsafeReleaseRAII :: MonadIO m => RAII a -> m a
unsafeReleaseRAII = liftIO . unsafeReleaseRAII'


-- 構築

-- 単純構築
wrapRAII :: a -> IO () -> RAII a
wrapRAII a action = RAII $ return ( a, action )

-- IO からの変換
-- 終了時のアクションは何もなし
instance MonadIO RAII where
  liftIO x = RAII $ do { a <- x; return ( a, return () ) }

-- 終了時アクションからの変換
-- 値は何も束縛しない
onDisposed :: IO () -> RAII ()
onDisposed action = RAII $ return ( (), action )

-- 破棄関数からの変換（ willBeDisposedWith の略）
-- do { a <- liftIO x; onDisposed $ dispose a; return a } と同じ
disposedWith :: IO a -> ( a -> IO () ) -> RAII a
x `disposedWith`  dispose = RAII $ do { a <- x; return ( a, dispose a ) }
-- 引数を取らない版， do { a <- liftIO x; onDisposed $ action; return a } と同じ
-- x の計算中に例外が投げられた場合には action は実行されない
disposedWith_ :: IO a -> IO () -> RAII a
x `disposedWith_` action  = RAII $ do { a <- x; return ( a, action ) }


-- 合成
-- 例外安全を重視
instance Monad RAII where
  return a = RAII $ return ( a, return () )
  
  RAII x >>= f = RAII $
    bracketOnError x snd $ \( a, action1 ) -> do
      ( b, action2 ) <- unsafeExtractRAII $ f a
      return ( b, action2 >> action1 )
  
  RAII x >> RAII y = RAII $ do
    bracketOnError x snd $ \( _, action1 ) -> do
      ( b, action2 ) <- y
      return ( b, action2 >> action1 )

-- IO の他に Functor と Applicative も instance 宣言させておく
instance Functor RAII where
  fmap f (RAII x) = RAII $ do
    ( a, action ) <- x
    return ( f a, action )
  
  a <$ RAII x = RAII $ do
    ( _, action ) <- x
    return ( a, action )

instance Applicative RAII where
  pure = return
  
  RAII u <*> RAII x = RAII $ do
    bracketOnError u snd $ \( f, action1 ) -> do
      ( a, action2 ) <- x
      return ( f a, action2 >> action1 )

  RAII x <* RAII y = RAII $ do
    bracketOnError x snd $ \( a, action1 ) -> do
      ( _, action2 ) <- y
      return ( a, action2 >> action1 )

  (*>) = (>>)

https://gist.github.com/1408713

使い道は，

import RAII
import Control.Monad
import System.IO

openFileRAII :: FilePath -> IOMode -> RAII Handle
openFileRAII path mode = do
  h <- liftIO $ do
    openFile path mode
  
  onDisposed $ do
    hClose h
  
  return h
  
-- もしくは
-- openFileRAII path mode = openFile path mode `disposedWith` hClose


main = do
  runRAII $ do   -- scoped でもよい
    h1 <- openFileRAII "hoge" ReadMode
    scoped $ do
      h2 <- openFileRAII "fuga" ReadMode
      liftIO $ do
        -- h1 や h2 を使って処理
        -- ...
        -- 終了, h2 が解放される
    -- h1 を使って更に処理を続行できる
    -- ...
    -- 終了， h1 はここで解放される

という風に，主に関数内部で onDisposed や `disposedWith` を使って RAII a を生成，
これを変数に bind して使い，使い終わったら runRAII や scoped を呼んで破棄し IO モナドに戻す感じ．
RAII らしく，処理途中で例外が投げられた場合にも破棄関数はきちんと呼ばれます((ただし `disposedWith_` の左辺の処理中に例外が投げられた場合，右辺に示された破棄関数は呼ばれません（これは，左辺の値が決まらないと破棄関数を呼びようがない `disposedWith` と動作を揃える為です）．))が，
h <- runRAII $ openFileRAII "hoge" ReadMode 等のバグったコード(( runRAII により即座に hClose が呼ばれ， h にはクローズ済みのハンドルが束縛される))を受け入れてしまうので，
原則的に破棄済みのオブジェクトにアクセス出来ない*1 C++ の RAII に比べると，数段格は落ちます．

まぁ正直 bracket を使えばいい気もしますが，
do 記法を使えるのはそれはそれで便利なので，これも悪くないんじゃないか，とか．

追記

scope 関数を MonadIO に一般化させて名前を scoped に変えたら，一気に可読性が上がった感が．
ひょっとしなくても， MonadIO って凄く便利なクラス？

*1: Dangling Reference さえ無ければ．生ポインタは爆発していいと思う