extensible-effects入門者がextensible-effectsをやってみた軌跡

Posted on 2017/07/07
Tags: [Haskell]

今回の成果はこちらです 👍

extensible-effectsって?

 MonadTransのモナドスタックを代替するものです。 例えばこんな感じのMonad文脈を

f :: StateT Foo (ReaderT Bar IO) Int
f = return 10

こんな感じに書けます。

f :: (Member (State Foo) r, Member (Reader Bar) r, SetMember Lift (Lift IO))
     => Eff r Int
f = return 10

何が嬉しいの?

 MonadTransliftの繰り返し由来のパフォーマンスダウンや liftの繰り返しがなくなるそうです。

……が、大体の(非決定的な)MonadTransインスタンスがこんな感じになってくれているおかげで

instance MonadState s m => MonadState s (MaybeT m)
instance MonadReader r m => MonadReader r (MaybeT m)

僕は全くliftの繰り返しをしなければいけない事態になったことがないのでした 🐕

例えば上のUndecidableInstancesは、以下を可能にするよ。(liftIOが1つ、くらいしかない)

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Applicative (Alternative)
import Control.Arrow ((>>>))
import Control.Monad (MonadPlus, mzero)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader, ReaderT, runReaderT, ask)
import Control.Monad.State.Lazy (MonadState, StateT, runStateT, get, put)
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)

data MyState = MyState
  { foo :: Int
  } deriving (Show)

initialMyState :: MyState
initialMyState = MyState 10

data MyROM = MyROM
  { bar :: Int
  } deriving (Show)

defaultMyROM = MyROM 20

newtype Mine a = Mine
  { _runMine :: MaybeT (StateT MyState (ReaderT MyROM IO)) a
  } deriving ( Functor, Applicative, Monad
             , Alternative, MonadPlus
             , MonadState MyState
             , MonadReader MyROM
             , MonadIO
             )

runMine :: Mine a -> IO (Maybe a, MyState)
runMine = _runMine
            >>> runMaybeT
            >>> flip runStateT initialMyState
            >>> flip runReaderT defaultMyROM

k :: Mine ()
k = do
  MyState foo' <- get
  MyROM bar'   <- ask
  let result = foo' + bar'
  put $ MyState result
  liftIO $ print result
  mzero -- Mine's mzero is MaybeT's Nothing

main :: IO ()
main = do
  (result, s) <- runMine k
  print s
  print result
--- vvv output vvv
-- 30
-- MyState {foo = 30}
-- Nothing

おっと、effの話だった 😆


はい、effはモナドスタックを使ったアプローチよりもパフォーマンスがいいらしい? し、面白そうなのでやってみました。

その1

 まずFlexibleContextsします。

その2 - 型制約Member m rでmを文脈に引き込む

 Effを使う時は、多分基本的に関数の型はこんな感じの形をしてます。

effContext :: (Member (State Foo) r, Member (Reader Bar) r) => Eff r a

この関数の型制約(Member (State Foo) r, Member (Reader Bar) r)State FooReader BarEff rで使えるようにします。

例えばこんな感じ

effContext' :: (Member (State Int) r, Member (Reader Char) r) => Eff r Int
effContext' = do
  x <- ask
  y <- get
  let result = ord x + y
  put result
  return result

lift無しでaskgetも使えてます ❗ ❗

その3 - 具体型

 ところでさっきのeffContext'、こうやっていたいんですが

main :: IO ()
main = do
  let x = run . runState 10 $ runReader effContext' 'a'
  print x

eff独特のやばみのエラーが出るので、型付けしてあげます。

main :: IO ()
main = do
  let x = run . runState 10
          $ flip runReader 'a' (effContext' :: Eff (Reader Char :> State Int :> Void) Int)
  print x
-- vvv output vvv
-- (107,107)

 Eff (Reader Char :> State Int :> Void) Intという型が見てとれると思いますが、これはrunReader, runState, runと連動していて、

runReader ::    Eff (Reader Char :> State Int :> Void) Int -> Char
             -> Eff (               State Int :> Void) Int
runState  :: Int -> Eff (State Int :> Void) Int
                 -> Eff (             Void) Int
run :: Eff Void Int -> Int

という感じで、runFooはa :> b :> .. :> Voida(一番左)を引っぺがす役割りになっています 👍
まあEffa :> b :> .. :> vって幽霊型らしいんですけどね。 すげええ。

そしてrun :: Eff Void (Int, Int) -> (Int, Int)Eff Voidを引っぺがして、通常の世界に戻ってきます。


 ここまでのまとめのコードです。

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}

import Control.Eff (Member, Eff, (:>), run)
import Control.Eff.Reader.Lazy (Reader, ask, runReader)
import Control.Eff.State.Lazy (State, get, put, runState)
import Data.Char (ord)
import Data.Void (Void)

effContext' :: (Member (State Int) r, Member (Reader Char) r) => Eff r Int
effContext' = do
  x <- ask
  y <- get
  let result = ord x + y
  put result
  return result


main :: IO ()
main = do
  let x = run -- run :: Eff Void (Int, Int) -> (Int, Int)
          . runState 10
          $ flip runReader 'a' -- runReader :: Eff (Reader Char :> State Int :> Void) Int -> Char -> Eff (State Int :> Void) Int
              (effContext' :: Eff (Reader Char :> State Int :> Void) Int)
  print x

その3.5 - めんどいWriter

 実はeffのState, Reader そして Writerは、effによって独自に定義されているんですよね。 そしてWriterMonoid w => MonadWriter w (Writer w)インスタンスになっていなくって、Monoid周りがすごくめんどくなってる。 (いつものようにrunWriterするだけじゃ足りない)

型を見るとすごくて、なんか関数と初期値を引数に要求されてる。

-- (w -> b -> b)
-- b
runWriter :: Typeable w => (w -> b -> b) -> b -> Eff (Writer w :> r) a -> Eff r (b, a)

どうするかというと、こんな感じにやってあげるか

effWriterContext :: Member (Writer [String]) r => Eff r ()
effWriterContext = do
  tell ["wakaba"]
  tell ["hinata"]
main :: IO ()
main = do
  let x = run $ runWriter (++) [] (effWriterContext :: Eff (Writer [String] :> Void) ())
  print x
-- vvv output vvv
-- (["wakaba","hinata"],())

runMonoidWriterという補助関数を使ってあげます。

main :: IO ()
main = do
  let x = run $ runMonoidWriter (effWriterContext :: Eff (Writer [String] :> Void) ())
  print x

まとめ。

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}

import Control.Eff (Member, Eff, (:>), run)
import Control.Eff.Writer.Lazy (Writer, tell, runWriter, runMonoidWriter)
import Data.Void (Void)

effWriterContext :: Member (Writer [String]) r => Eff r ()
effWriterContext = do
  tell ["wakaba"]
  tell ["hinata"]

main :: IO ()
main = do
  --let x = run $ runWriter (++) [] (effWriterContext :: Eff (Writer [String] :> Void) ())
  let x = run $ runMonoidWriter (effWriterContext :: Eff (Writer [String] :> Void) ())
  print x

その3.7 - チガウ

 もう気づかれたかもしれませんが、我々の知るrunStateとは引数の順序が違うんですよね。 ナンデ!? 「s -> (a, s)の抽象」という役割を離れたから!?

その4 - IOとか

 ところでMember t rtには、我々のよく親しんだIOMaybeは設定できません。 runIOrunMaybeがeffにないので 😢

 そこでSetMemberという、(:>)の連鎖の中の、唯一のLift mを解凍できる型で、それを設定してあげます。 Lift mrunLiftによって、(:>)の連鎖の中に1つだけ許されます。 (Lift IO :> Lift Maybe :> Voidとかはだめで、Lift IO :> Voidは良い)

こんな感じ。

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}

import Control.Eff (Member, SetMember, Eff, (:>))
import Control.Eff.Lift (Lift, lift, runLift)
import Control.Eff.Reader.Lazy (Reader, ask, runReader)
import Control.Eff.State.Lazy (State, get, put, runState)
import Control.Eff.Writer.Lazy (Writer, tell, runWriter, runMonoidWriter)
import Data.Char (ord)
import Data.Void (Void)

effContext'' :: ( Member (Writer [String]) r
                , SetMember Lift (Lift IO) r
                ) => Eff r ()
effContext'' = do
  input <- lift getLine
  tell [input]
  return ()


main :: IO ()
main = do
  x <- runLift $ runMonoidWriter (effContext'' :: Eff (Writer [String] :> Lift IO :> Void) ())
  print x
-- vvv input vvv
-- aaa
-- vvv output vvv
-- (["aaa"],())

以上、進捗でした。

ところで

 MaybeT IO aみたいなものを使いたいんだけど、どうすればいいんだろう。 もういっそSetMember Lift (Lift IO) r => MaybeT (Eff r) a使っちゃう?? 😆

参考ページ



この記事はこちらから修正リクエストを送ることができます。
extensible-effects入門者がextensible-effectsをやってみた軌跡 - github
ゴミ箱ボタンの左にある、鉛筆ボタンを押してね!