最近話題になっていたextensible-effectsですが、少しだけ触ってみたのでサンプルとして置いておきます。
すごくざっくりいうと、本来ならモナド変換子が入れ子になるようなデータを上手くフラットな階層のない構造をもつデータとして扱えるものです。
現時点では Reader, Writer, State のサポートがされているくらいなのでとりあえず使ってみようと思います。
サンプルと解説(コードは一番下に掲載しました)
以下ではTodoリストをもつ Worker という型を定義していくつかの操作をしています。
まず example1 より上では、 Worker のTodoリストをいじっています。こちらはそもそもモナド変換子が入れ子になるような構造ではないので迷うことは何もないと思います。
example2 では、タスクを処理するという操作を考えています。どちらも Writer モナドを使ってログを残すようにしています。
例えば doTask のtype signatureを見れば doTask :: (...) => Eff r () となっており、これは Writer と State を組み合わせているにも拘わらず Eff r () という、階層のないモナドに落ちていることが分かると思います。
extensible-effectsを用いると、このようにReader, Writer, Stateの処理を全てEff r ()の中で行なうことができるので、これらがたくさん入り交じるような場面ではすごく便利になると言えるでしょう。
extensible-effectsについてのコメント
- 型注釈めんどくさい：確かに面倒なんですけどこれは同時に利点でもあります。
Member (M a) rとかけば、"モナドMの機能を持ったaをMemberにもつのか"とかいうことがすぐに分かります。そういう意味ではとても分かりやすいのではないかと。 - エラーがめんどくさい：型が曖昧になるのでエラーも曖昧になります。そういう時はとりあえずtype signatureを
Eff r ()にしてしまって、あとはエラーに言われたとおりに型注釈を加えてあげると良いです。 - 適度に型を制限しないとコンパイルが通らないことがある：例えば
askとしたときに、どのReaderに対してのaskなのかが分かりにくいなどの理由でコンパイラに怒られることがあります。そのときはnewtype HOGE = HOGE aなどとしてHOGE a <- askとするか、またはa <- ask; f (a :: Piyo)とかしてあげれば上手く行きます。
大体上のようなことに気をつければ、あとは今までどおり(ただし階層はフラットなのでliftとかはいらないし楽です)モナディックな処理を書いてあげれば動くと思います。
値のやりとりに対してモナド変換子がたくさん入れ子になるよりはずっと書きやすくなると思います。ただし型が曖昧になりやすいので、構造を明示してデータを扱いたいときにはちょっと微妙という気はします。あとはパフォーマンスやライブラリがどれだけ整備されるかによるかと思いますが、もしかしたら来年辺りに流行るかもしれませんね？
{-# LANGUAGE FlexibleContexts, DeriveDataTypeable #-}
import Control.Eff
import Control.Eff.Reader.Lazy
import Control.Eff.State.Lazy
import Control.Eff.Writer.Lazy
import Data.Typeable (Typeable)
import Control.Monad
type Task = String
newtype Worker = Worker { todo :: [Task] }
deriving (Eq, Show, Typeable)
-- State版
resetTodo :: (Member (State Worker) r) => Eff r ()
resetTodo = put $ Worker ["EOF"]
-- Reader版
nextTask :: (Member (Reader Worker) r) => Eff r Task
nextTask = do
Worker u <- ask
return $ head u
-- State版
nextTask' :: (Member (State Worker) r) => Eff r Task
nextTask' = do
Worker u <- get
return $ head u
-- ここではクロージャーっぽいことをしている
updateHead :: (Member (State Worker) r) => (Task -> Task) -> Eff r ()
updateHead f = do
Worker ts <- get
put $ Worker $ go f ts
where
go :: (s -> s) -> [s] -> [s]
go _ [] = []
go f (a:as) = f a:as
example1 = do
let w = Worker ["todo1", "todo2", "todo3", "EOF"]
putStrLn $ run $ runReader nextTask w
-- output: todo1
print $ run $ runState w nextTask'
-- output: (Worker {todo = ["todo1","todo2","todo3","EOF"]},"todo1")
putStrLn $ run $ evalState w nextTask'
-- output: todo1
print $ run $ runState w resetTodo
-- output: (Worker {todo = ["EOF"]},())
putStrLn $ run . runReader nextTask
$ run . execState w
$ updateHead (++ ": 1st task")
-- output: todo1: 1st task
-- Taskを1つだけ処理する
doTask :: (Member (Writer String) r, Member (State Worker) r) => Eff r ()
doTask = do
Worker ts <- get
when (length ts >= 2) $ do
put $ Worker $ tail ts
tell $ "task was done -> " ++ (head ts) ++ ".\n"
-- Taskを全て処理する
doTaskAll :: (Member (Writer String) r, Member (State Worker) r) => Eff r ()
doTaskAll = do
doTask
Worker ts <- get
when (length ts >= 2) $ doTaskAll
example2 = do
let w = Worker ["todo1", "todo2", "todo3", "EOF"]
print $ run $ runWriter (++) "" $ execState w doTask
-- output: ("task was done -> todo1.\n",Worker {todo = ["todo2","todo3","EOF"]})
print $ run $ runWriter (++) "" $ execState w doTaskAll
-- output: ("task was done -> todo1.\ntask was done -> todo2.\ntask was done -> todo3.\n",Worker {todo = ["EOF"]})
print $ run $ execState w $ runWriter (++) "" $ doTaskAll
-- output: Worker {todo = ["EOF"]}
main = do
example1
example2