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作るの楽しいなー。
最後に
あれ、これだと例外処理とかしてないしアレなんじゃね？