Freeモナドを使って何かしてみたかったので…。

仕様

Go言語にはdeferという構文があります。
これは、

file, err := os.Open(filename)
if err != nil {
	return err
}
//ここは関数を抜けるときに呼ばれる
defer file.Close()

という風に、リソースの開放などを比較的取得と近い位置で行うことが出来る構文です。
（D言語にも同じようなものがあったような気がします ⇒ http://www.kmonos.net/alang/d/exception-safe.html）

今回はHaskellでこの構文のようなものを作ってみたいと思います、Freeモナドを使って。

完成イメージはこんな感じ。

hello :: Defer IO ()
hello = do
  h <- liftIO $ openFile "hello.txt" ReadMode
  defer $ liftIO $ hClose h
  liftIO $ hGetLine h >>= putStrLn

openFileで開いたハンドルを次の行でdeferを使って閉じています。
まあ、この程度じゃあまりありがたみとかないんですけど。

実装

めんどくさいので一気に貼ります。

defer.hs

{-# LANGUAGE DeriveFunctor, LambdaCase #-}
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Free

import System.IO

type Defer m = FreeT (DeferF m) m

data DeferF m cont
 = Defer (Defer m ()) cont
 | Scope (Defer m ()) cont deriving (Functor)

defer :: Monad m => Defer m a -> Defer m ()
defer d = liftF $ Defer (d >> return ()) ()

scope :: Monad m => Defer m a -> Defer m ()
scope d = liftF $ Scope (d >> return ()) ()

runDefer :: Monad m => Defer m a -> m a
runDefer = runDefer' []
  where
  runDefer' :: Monad m => [Defer m ()] -> Defer m a -> m a
  runDefer' xs = runFreeT >=> \case
    Free (Defer x next) -> runDefer' (x:xs) next
    Free (Scope x next) -> runDefer' [] x >> runDefer' xs next
    Pure x -> (unless (null xs) $ runDefer' [] $ mapM_ id xs) >> return x

-- ここからは試し

hello :: Defer IO ()
hello = do
  h <- liftIO $ openFile "hello.txt" ReadMode
  defer $ liftIO $ hClose h
  liftIO $ hGetLine h >>= putStrLn

main = runDefer hello

補足とすれば、scopeというものを作って、そこでdefer実行のタイミングを調整できるようにもしました。

にしても、FreeモナドでDSL作るの楽しいなー。

最後に

あれ、これだと例外処理とかしてないしアレなんじゃね？