[PureScript] 解説！Extensible Effects(拡張可能作用) ～実行は行ったり来たり編～
はじめに
前回の記事では、PureScriptのExtensible Effectsの実装であるRunについて、Runの()の意味や、副作用を+を連結するだけで副作用に関する関数を（合成の順序を意識せず）呼べる理由などを説明しました。
今回の記事では、そのRunの実行がどのように行われるかの説明をしていきます。
Runはどのように実行されていくのか
Runはどう実行されるのでしょうか？
RunはFreeと同じくインタフェース部分と実装を司るハンドラ部分が分かれているので、実行するためにはハンドラと、そのハンドラを利用する関数を書かないといけません。
ハンドラ
まずFreeを使った書き方を載せます。goがハンドラでfoldFreeがハンドラを利用する関数です。
run :: Teletype ~> Effect
run = foldFree go
where
go :: TeletypeF ~> Effect
go (PutStrLn s a) = const a <$> log s
go (GetLine k) = pure (k "fake input")
次に同じことをRunで書きます。
runTeletype :: forall r. Run (TELETYPE + EFFECT + r) ~> Run (EFFECT + r)
runTeletype run = interpret (on _teletype go send) run
where
go :: Teletype ~> Run (EFFECT + r)
go (PutStrLn s a) = liftEffect $ const a <$> log s
go (GetLine k) = pure (k "fake input")
liftEffectというEffectをRun (EFFECT + r)に自然変換する関数は出てくるものの、go関数でパターンマッチしているという構造はほとんど同じですね。
つまりこの部分はFreeの知識がそのまま使えるわけです。
FreeとRunで大きく異なる部分はRunの例の方にあるinterpret (on _teletype go send)の部分でしょう。
ということで次はinterpretの部分を見ていきます。
interpret
interpret (on _teletype go send)
について説明していくわけですが、まずはon関数を見てみましょう。
on関数は多相バリアント(VariantF)に定義されている関数で、引数としては、ラベル(Proxy)、変換関数f、変換関数g、多相バリアントrをとります。
動きとしては
『多相バリアントrが、指定したラベル(上の場合は_teletype)を持っていたら、ラベルに紐づく値に対し関数f(上の場合はgo)を適用し、持っていなかったら多相バリアントrに関数g(上の場合Runに定義されているsend)を適用する』
という動きをします。
onの定義を載せますが、これはあまり真面目に見なくても大丈夫です。
引数を4つとりますが、今回はon _teletype go sendのように3つしか渡していないので、VariantF r2 a → bという関数が返ってくることだけわかれば十分です。
on
∷ ∀ sym f a b r1 r2
. R.Cons sym f r1 r2
⇒ IsSymbol sym
⇒ Proxy sym
→ (f a → b)
→ (VariantF r1 a → b)
→ VariantF r2 a
→ b
on p f g r =
case coerceY r of
VariantFRep v | v.type == reflectSymbol p → f v.value
_ → g (coerceR r)
where
coerceY ∷ VariantF r2 a → VariantFRep f a
coerceY = unsafeCoerce
coerceR ∷ VariantF r2 a → VariantF r1 a
coerceR = unsafeCoerce
続いてinterpret関数です。
階層が深くて難しいため、あとで図解します。
interpret
:: forall m a r
. Monad m
=> (VariantF r ~> m)
-> Run r a
-> m a
interpret = run
run
:: forall m a r
. Monad m
=> (VariantF r (Run r a) -> m (Run r a))
-> Run r a
-> m a
run k = loop
where
loop :: Run r a -> m a
loop = resume (\a -> loop =<< k a) pure
resume
:: forall a b r
. (VariantF r (Run r a) -> b)
-> (a -> b) -- pure
-> Run r a
-> b
resume k1 k2 = resume' (\x f -> k1 (Run <<< f <$> x)) k2 <<< unwrap
interpretの引数(VariantF r ~> m)は自然変換をする関数ですが、mにはMonad mという制約がついています。
今回の例でinterpretに渡していた(on _teletype go send)を見返してみましょう。
goもsendもどちらもRunを返すわけですが、RunはMonadのインスタンスになっているので型がマッチするわけですね。
なぜこの制約がついているかというと、runのloop =<< k aの部分でbind(flipped)が使われているからです。
型のイメージがつきやすいように、mをRun rに固定化したiterpretとrunを書いてみました。
interpret
:: forall m a r
. (VariantF r ~> Run r)
-> Run r a
-> Run r a
interpret = run
run
:: forall m a r
. (VariantF r (Run r a) -> Run r (Run r a))
-> Run r a
-> Run r a
run k = loop
where
loop :: Run r a -> Run r a
loop = resume (\a -> loop =<< k a) pure
続いてinterpretの処理にon _teletype go sendが渡っていく様子を図解します。
処理の図解
上記で最終的にresume'を呼び出す際の第一引数の関数は、次のような関数になることがわかりました。
(\x f -> (\a -> loop =<< ((on _teletype go send) a)) (Run <<< f <$> x))
この関数の処理を順番に見ていきましょう。
まず引数x``fを用いた(Run <<< f <$> x)の部分ですが、これは(map (Run <<< f) x)ということなので、xをRun <<< fを使ってマップしています。定義からしてxはVariantFなのでVariantFのmap関数が使われます。
VariantFのmapは、VariantFを作る元となったFunctorのインスタンスのmap関数を使います。すなわち次のputStrLnやgetLineのようにRunを作っていた場合は、Teletypeのmap関数が使われるということです。
data Teletype a = PutStrLn String a | GetLine (String -> a)
derive instance functorTeletype :: Functor Teletype
type TELETYPE r = (teletype :: Teletype | r)
_teletype = Proxy :: Proxy "teletype"
putStrLn :: forall r. String -> Run (TELETYPE + r) Unit
putStrLn s = lift _teletype (PutStrLn s unit)
getLine :: forall r. Run (TELETYPE + r) String
getLine = lift _teletype (GetLine identity)
続けます。
このmapの結果はVariantF r (Run r a)という型になりますが、それを(\a -> ...)の関数に渡しています。
このaとは上記のVariantFですが、これを関数(on _teletype go send)の引数として呼び出します。
interpretの呼び出しから見てきて、ようやく(on _teletype go send)が使われるところまできました。
on _teletype go sendの結果の型は、go(とsend)が返す型と同一になります。
再度goの定義を見てみると、返されるのは副作用(この場合はTELETYPE)が除去されたRunになっています。
runTeletype :: forall r. Run (TELETYPE + EFFECT + r) ~> Run (EFFECT + r)
runTeletype run = interpret (on _teletype go send) run
where
go :: Teletype ~> Run (EFFECT + r)
go (PutStrLn s a) = liftEffect $ const a <$> log s
go (GetLine k) = pure (k "fake input")
この(on _teletype go send)関数の結果のRunは、逆束縛loop =<<の引数となります。
これはこのRunにbindでloop関数の処理resume (\a -> loop =<< k a) pureを繋いだということです。
つまりRun(の中のFree)のCatListにresume (\a -> loop =<< k a) pureが追加されたということです。この関数を取り出して使えば、もう一度resumeを呼び出すことができるということです。
kはon _teletype go sendだったので、必要なだけこのon関数を再利用できるということです。
interpretについてここまででわかったこと
-
interpretにはon p f gという形でon関数を指定する-
pは多相バリアントのラベル -
fはpに紐づく代数的データ型から、そのラベルを取り除いたRunを返す関数 -
gは多相バリアントをRunに変換する関数
-
-
on関数を再利用できる形でRunを返してくる(bindにおける後続の処理として保持されており、取り出して使うことができる）。
現時点で途轍もなく長い解説になってきていますが、まだ処理は終わっていません。
上記on関数およびbindによって後続の処理を繋ぐ関数は別の関数に渡されており、そっちから呼び出されるからです。
-- k1の中に`on`関数や`loop =<<`の処理がある
resume k1 k2 = resume' (\x f -> k1 (Run <<< f <$> x)) k2 <<< unwrap
ということでresume'関数を見なくてはなりません。
続interpret ～そしてFreeの世界へ～
resume'関数はFreeの関数です。ここでRunの世界からFreeの世界に移っていきます。
resume'の定義を見てみましょう。
resume'
:: forall f a r
. (forall b. f b -> (b -> Free f a) -> r)
-> (a -> r)
-> Free f a
-> r
resume' k j f = case toView f of
Return a -> j a
Bind g i -> k g i
引数kは
(\x f -> (\a -> loop =<< ((on _teletype go send) a)) (Run <<< f <$> x))
で、jはpure(Runのpure)、fはRunがunwrapされたものです（初回の呼び出しでは、何も副作用が除去されていないRunの中身）。
なのでReturnやBindの値は次のように使われることになります。
Return a -> pure a
Bind g i -> (\x f -> (\a -> loop =<< ((on _teletype go send) a)) (Run <<< f <$> x)) g i
渡ってきた関数はここで呼び出されるので、解説のためg,iを代入した形に書き直してみます。
Return a -> pure a
Bind g i -> (\a -> loop =<< ((on _teletype go send) a)) (Run <<< i <$> g)
あとはReturnやBindを取得しているtoViewの処理が分かればよさそうです。
toView :: forall f a. Free f a -> FreeView f a Val
toView (Free v s) =
case v of
Return a ->
case uncons s of
Nothing ->
Return (unsafeCoerceVal a)
Just (Tuple h t) ->
toView (unsafeCoerceFree (concatF ((runExpF h) a) t))
Bind f k ->
Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
where
concatF :: Free f Val -> CatList (ExpF f) -> Free f Val
concatF (Free v' l) r = Free v' (l <> r)
runExpF :: ExpF f -> (Val -> Free f Val)
runExpF (ExpF k) = k
unsafeCoerceFree :: Free f Val -> Free f a
unsafeCoerceFree = unsafeCoerce
unsafeCoerceVal :: Val -> a
unsafeCoerceVal = unsafeCoerce
toViewはFree型の値を引数にとり、FreeView型の値を返してきます。
data FreeView f a b = Return a | Bind (f b) (b -> Free f a)
FreeViewはBindもしくはReturnのどちらかの値となります。
これらはbindやpureといった関数をデータで表したようなものです。
Bindの(f b)はデータ型fとそのデータ型が持つ値の型bを表し、(b -> Free f a)はbをもとに新たなFree f aを返す関数を表します。この(b -> Free f a)型の関数は、Runがbindで繋いでいった後続の処理へ値を渡すための橋渡しをしてくれます（なので呼ばないといけない）。
Returnは単にa型の値を持っているだけのものです。
toViewは中で色々なことをやっていますが、ざっくりと説明するとRunのbind関数で繋いでいった処理を最初の処理から一つずつ返すということをしています。
後続の処理があるうちはBindが返ってきて、末尾まで達するとReturnが返ってきます。
この関数はとても複雑なので本記事ではざっくり説明させてもらいました。
詳細な説明についてはこちらを御覧ください。
toViewおよびBindやReturnの内容がわかったところで、resume'に戻ります。
resume' k j f = case toView f of
Return a -> j a
Bind g i -> k g i
gはVariantF (TELETYPE) (Run r a)のような型の値で、iは後続の処理へ繋ぐための関数です。
kは(\x f -> (\a -> loop =<< ((on _teletype go send) a)) (Run <<< f <$> x))だったので、kの内容にgとiを当てこんでみましょうか。
(\a -> loop =<< (on _teletype go send) a) (Run <<< i <$> g)
-- ↓
loop =<< (on _teletype go send) (Run <<< i <$> g)
goは次のような関数だったので、例えばGetLine kの方にマッチしたらpure (k "fake input")が返ります。
runTeletype :: forall r. Run (TELETYPE + EFFECT + r) ~> Run (EFFECT + r)
runTeletype run = interpret (on _teletype go send) run
where
go :: Teletype ~> Run (EFFECT + r)
go (PutStrLn s a) = liftEffect $ const a <$> log s
go (GetLine k) = pure (k "fake input")
型はRunなのでRunのbindでloopと繋がります。すると新たなRunができあがるので、そのRunを返します。
（Runから副作用は除去された状態です）
シンプルな例で、ハンドラやinterpretを説明したところで、本番にいきます。
副作用が合成された状態での実行
最初の方で提示したサンプルコードは、次のように副作用が合成された状態でした。
これから副作用が合成された状態のRunの内容を解釈して実行していく処理は追っていきますが、とてつもなく複雑なので、実行部分に関わるコードをまとめて載せ、Runの様子がどう変遷していくかというところに着目して解説を試みます。
全体像
こちらが全体像です。
findSameGroupToDoListByUserIdが主な処理で『指定したIDのユーザーと同じグループに属するユーザーに紐づくToDoをすべて取得する』というユースケースです。
これをmain関数で実行しています。
解説から参照しているコードを追いやすくするためにコメントで数字をつけました。
type User = { id :: String, name :: String, groupId :: String }
type UserGroup = { id :: String, userIds :: Array String }
type ToDo = { userName :: String, description :: String, completed :: Boolean }
data UserRepository a
= FindUserById String (User -> a)
| FindGroupById String (UserGroup -> a)
-- [15]
derive instance functorUserRepository :: Functor UserRepository
type USER_REPOSITORY r = (userRepository :: UserRepository | r)
_userRepository = Proxy :: Proxy "userRepository"
-- [2]
findUserById :: forall r. String -> Run (USER_REPOSITORY + r) User
-- [12] ~~~~~~~~~~~~~~~~~~~~~~
findUserById userId = lift _userRepository $ FindUserById userId identity
-- [3]
findGroupById :: forall r. String -> Run (USER_REPOSITORY + r) UserGroup
findGroupById groupId = lift _userRepository $ FindGroupById groupId identity
data ToDoRepository a
= FindToDoListByUserIds (Array String) (Array ToDo -> a)
derive instance functorToDoRepository :: Functor ToDoRepository
type TODO_REPOSITORY r = (toDoRepository :: ToDoRepository | r)
_toDoRepository = Proxy :: Proxy "toDoRepository"
findToDoListByUserIds :: forall r. Array String -> Run (TODO_REPOSITORY + r) (Array ToDo)
findToDoListByUserIds userIds = lift _toDoRepository $ FindToDoListByUserIds userIds identity
-- [1]
findSameGroupToDoListByUserId
:: forall r
. String
-> Run (USER_REPOSITORY + TODO_REPOSITORY + r) (Array ToDo)
findSameGroupToDoListByUserId userId = do
user <- findUserById userId
group <- findGroupById user.groupId
findToDoListByUserIds group.userIds
-- [19]
runUserRepository :: forall r. Run (USER_REPOSITORY + r) ~> Run (r)
-- [20]~~~~~~~~~~~~~~~~~~~~~~~~~~~~
runUserRepository run = interpret (on _userRepository handler send) run
where
-- [21]
handler :: UserRepository ~> Run (r)
handler = case _ of
FindUserById userId next -> do
pure $ next { id: userId, name: "ユーザ1", groupId: "gid" }
FindGroupById groupId next -> do
pure $ next { id: groupId, userIds: ["uid1", "uid2"] }
-- [4]
runToDoRepository :: forall r. Run (TODO_REPOSITORY + r) ~> Run (r)
-- [17]~~~~~~~~~~~~~~~~~~~~~~~
runToDoRepository run = interpret (on _toDoRepository handler send) run
where
-- [26]
handler :: ToDoRepository ~> Run (r)
handler = case _ of
FindToDoListByUserIds userIds next -> do
pure $ next [
{userName: "ユーザ1", description: "エアコンを掃除する", completed: false},
{userName: "ユーザ2", description: "照明を買い替える", completed: true}
]
main :: Effect Unit
main = do
findSameGroupToDoListByUserId "uid1" -- [1]
# runToDoRepository -- [4]
# runUserRepository -- [19]
# extract -- [22]
# logShow
-- [10]
lift
:: forall sym r1 r2 f a
. Row.Cons sym f r1 r2
=> IsSymbol sym
=> Functor f
=> Proxy sym
-> f a
-> Run r2 a
lift p = Run <<< liftF <<< inj p
-- [5]
interpret
:: forall m a r
. Monad m
=> (VariantF r ~> m)
-> Run r a
-> m a
interpret = run
-- [6]
run
:: forall m a r
. Monad m
=> (VariantF r (Run r a) -> m (Run r a))
-> Run r a
-> m a
run k = loop
where
loop :: Run r a -> m a
-- [16]~~~~~~~~~~~~~~~
loop = resume (\a -> loop =<< k a) pure
-- [7]
resume
:: forall a b r
. (VariantF r (Run r a) -> b)
-> (a -> b)
-> Run r a
-> b
-- [14]~~~~~~~~~~~~~~~~~~~~~~~~~
resume k1 k2 = resume' (\x f -> k1 (Run <<< f <$> x)) k2 <<< unwrap
-- [18]
send
:: forall a r
. VariantF r a
-> Run r a
send = Run <<< liftF
-- [22]
extract :: forall a. Run () a -> a
extract = unwrap >>> runFree \_ -> unsafeCrashWith "Run: the impossible happened"
-- [11]
liftF :: forall f. f ~> Free f
liftF f = fromView (Bind (unsafeCoerceF f) (pure <<< unsafeCoerceVal))
-- [8]
resume'
:: forall f a r
. (forall b. f b -> (b -> Free f a) -> r)
-> (a -> r)
-> Free f a
-> r
resume' k j f = case toView f of
Return a -> j a
Bind g i -> k g i -- [13]
-- [9]
toView :: forall f a. Free f a -> FreeView f a Val
toView (Free v s) =
case v of
Return a ->
-- [24]
case uncons s of
Nothing ->
Return (unsafeCoerceVal a)
Just (Tuple h t) ->
-- [25]
toView (unsafeCoerceFree (concatF ((runExpF h) a) t))
Bind f k ->
Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
-- [23]
runFree :: forall f a. Functor f => (f (Free f a) -> Free f a) -> Free f a -> a
runFree k = go
where
go :: Free f a -> a
go f = case toView f of
Return a -> a
Bind g i -> go (k (i <$> g))
前置き
Runの変遷を見ると言いましたが、RunとRunを構成する要素の定義は次のようになっていますが、この定義に従ってRunの値を厳密に表現するのは難しいです。
newtype Run r a = Run (Free (VariantF r) a)
data Free f a = Free (FreeView f Val Val) (CatList (ExpF f))
newtype ExpF f = ExpF (Val -> Free f Val)
data FreeView f a b = Return a | Bind (f b) (b -> Free f a)
data Val
data VariantF :: Row (Type -> Type) -> Type -> Type
data VariantF f a
なので、簡略化した表現を使わせていただきます。
例えばfindUserById[2]で返しているRunの値を次のように表現します。
Run
{ userRepository: (FindUserById userId identity) } -- VariantFの部分
[] -- CatListの部分
Freeの部分は暗黙的な前提として省略しています。
ただしCatListの部分はRunの状態を知るのに重要な部分なので残し、配列の記法で記すこととしました。
また、FreeViewの部分がBindかReturnかは、Runの内容をFreeViewに変換するとき次のように表現することとします。
Bind
{ userRepository: (FindUserById userId identity) } -- VariantFの部分
joinFunction -- VariantF f a の a から Freeに変換する何らかの関数を表す部分
他にも必要に応じて表現は変えていきます。
では準備が整ったので、処理の流れを見ていきましょう。
イクゾー
1. 副作用が合成されたRunを作る
findSameGroupToDoListByUserIdの処理
この関数はRun (USER_REPOSITORY + TODO_REPOSITORY + r) Unitを作ります。
色々な処理があり繋がっているように見えますが、ここで返されるのは冒頭の関数findUserById(Run (USER_REPOSITORY + r) User)[2]で作られたRunです。
このRunはbindにより、findGroupById(Run (USER_REPOSITORY + r) UserGroup)[3]に繋ぐ部分を持っています。
Run
{ userRepository: (FindUserById userId identity) }
[findGroupById]
findGroupByIdより後の処理を繋ぐbindはこの時点では呼ばれません。
あくまで『最初のRun（とその後続の処理まで）』が返されます。
2. Runから副作用TODO_REPOSITORYを除去する
1. runToDoRepository[4]の処理
この関数は渡されたRunからTODO_REPOSITORYに関する副作用を除去した新しいRunの返します。
渡された値はinterpret[5], run[6], resume[7]という流れでそのまま運ばれていきます。
runからresumeを呼び出す際は、処理結果のRunに対して再びresumeを呼び出せるような細工[16]をしています（詳細は後述しますが、この細工は重要で、後々まで影響してきます）。
またresumeからresume'[8]に渡される際unwrapでRunの中身のFreeの値が取り出されます。
2. resume'[8]の処理
resume'ではこのFreeの値を引数にtoView[9]を呼び出し、その結果で分岐します。
3. toView[9]
[2]を参照すると、findUserByIdはlift[10]でRunを作っています。
その際Freeを作るためliftF[11]が使われています。
findUserByIdの場合のliftFは[12]が元になっているため
Free
(Bind
{ userRepository: FindUserById userId identity }
pure)
[]
のような値を返します。
pureは後々ハンドラが呼ばれたとき、ハンドラが処理した結果の値を後続の処理に繋ぐためのReturnを返す関数です。
このFreeの値は、前述の通りfindSameGroupToDoListByUserId[1]のbindによりfindGroupById[3]に繋ぐ処理が紐づいており
Free
(Bind
{ userRepository: (FindUserById userId identity) }
pure)
[findGroupById]
という感じになっています。
toViewではこの値からpureの部分と[findGroupById]を取り出して、これらを利用する次のような新しいBindを返してきます。
-- f は VariantF
-- k は pure
-- s は [findGroupById]
Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
値を当てはめてみるとこうなります。
Bind
{ userRepository: (FindUserById userId identity) }
(\a -> Free (Return a) [findGroupById])
ちなみに後々わかりますがaにはハンドラの処理結果の値が渡されてきます。
4. resume'の分岐
toViewで返ってきたのはBindだったのでBind g i -> k g i[13]のk g iが実行されます。
kとはresumeの(\x f -> k1 (Run <<< f <$> x))[14]です。
5.(Run <<< f <$> x)の処理
まず(Run <<< f <$> x)の部分の説明にとりかかります。
xとfの値はわかっているので、値を当てはめてみると次のようになるでしょう。
x = { userRepository: (FindUserById userId identity) }
f = (\a -> Free (Return a) [findGroupById])
なので
(Run <<< (\a -> Free (Return a) [findGroupById])
<$> {userRepository: (FindUserById userId identity)})
{userRepository...はVariantFを表すことにしていたので、VariantFのmap関数が使われます。このmap関数は、VaraintFを作る元になったやつのmapに処理を委譲する仕組みになっているため、実際はFindUserByIdのmapが使われます。
FindUserByIdのmapはderive instane[15]により導出されていますが、今回の場合は次のような結果を返します。
FindUserById userId (渡された関数 <$> identity)
identityは関数ですが、関数のmapは合成関数となります。
なのでこうなるでしょう。
FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity)
そういえばVariantFのmapの話をしていたのでした。
ということで、これまでの説明を元に(Run <<< f <$> x)の結果を考えると、次のような値になるでしょう。
{ userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) }
6.k1の処理
上記のような値を引数としてk1が実行されるわけですが、k1とは元をたどるとrunの(\a -> loop =<< k a)[16]でした。
aは上記の値なので、まずこれを引数としてkが呼ばれます。
ここのkは元をたどるとrunPresenter[4]でinterpretに渡していた関数(on _toDoRepository handler send)[17]です。
この関数は渡したVariantFが、ラベルtoDoRepositoryを持っていればそのラベルに紐づく値を引数としてhandlerを呼び出し、持っていなければsendを呼ぶという関数です。
今回の値のラベルはuserRepositoryなのでsend[18]が呼ばれますね。
sendはRun <<< liftFということをしており、この値をliftF[11]でFreeにしてからRunで包んで返しています。
Run
{ userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) }
[]
ちなみにsendから返されたRunはTODO_REPOSITORYの副作用が除去されたRunになっています(中にはTODO_REPOSITORYに紐づく値は残ってますけどね)。
更にこの値に対してloop =<<というloopとのbindが呼び出されているので、loopが後続の処理として追加されます。すなわちこうなります。
-- loop =<< k の k は on関数[17] なので置き換えた
Run
{ userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) }
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))]
この値が返されて、runToDoRepositoryの処理が終わります。
3. Runから副作用USER_REPOSITORYを除去する
1. runUserRepository[19]の処理
この関数は渡されたRunからUSER_REPOSITORYに関する副作用を除去した新しいRunの返します。
この例の処理の流れでは上記のRunが渡されます。
runToDoRepositoryと同じくこの値はinterpret[5], run[6], resume[7]という流れでそのまま運ばれていきます。
resumeからresume'[8]に渡される際は、unwrapで中身のFreeの値が取り出されます。
2. resume'[8]の処理
resume'ではこのFreeの値を引数にtoView[9]を呼び出し、その結果で分岐します。
3. toView[9]
今回のtoViewに渡されるFreeはこのようになっています。
このFreeは「3-2-2」のsend中のliftFで作られたものなので、内容はBind f pureとなります。つまり以下の値です。
Free
(Bind
{ userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) }
pure)
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))]
toViewではこの値からpureの部分と[(\run -> resume (\a -> loop =<< k a) pure run)]を取り出して、これらを利用する次のような新しいBindを返してきます。
-- f は VariantF
-- k は pure
-- s は [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))]
Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
値を当てはめてみるとこうなります。
Bind
{ userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) }
(\a -> Free (Return a) [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
4. resume'の分岐
toViewで返ってきたのはBindだったのでBind g i -> k g i[13]のk g iが実行されます。
kとはresumeの(\x f -> k1 (Run <<< f <$> x))[14]です。
5. (Run <<< f <$> x)の処理
今回もxとfの値はわかっているので、値を当てはめてみると次のようになるでしょう。
x = { userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) }
f = (\a -> Free (Return a) [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
-- なので↓となる
(Run <<< (\a -> Free (Return a) [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))]))
<$> { userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) })
{userRepository...はVariantFなので、VariantFのmap関数が使われます。
つまり実際はFindUserByIdのmapが使われます。
FindUserByIdのmapはderive instane[15]により導出されており、次のような結果を返すのでした。
FindUserById 元の値そのまま (渡された関数 <$> 元の関数)
ということで、これまでの説明を元に(Run <<< f <$> x)の結果を考えると、次のような値になるでしょう。
{ userRepository: FindUserById
userId
(Run <<< (\a -> Free (Return a) [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))]))
<<<
(Run <<< (\a -> Free (Return a) [findGroupById]) <<< identity) }
ちょっと見づらくなってきたので整理しましょう。
{ userRepository: FindUserById
userId
(identity
>>> (\a -> Free (Return a) [findGroupById])
>>> Run
>>> (\a -> Free (Return a) [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
>>> Run) }
6. (Run <<< f <$> x)のまとめ
FreeのBindとはBind (f b) (b -> Free f a)という定義でしたが、Runの場合の型を当てはめるとこれはこうなるでしょう。
Bind (VariantF r b) (b -> Free (VariantF r) a)
つまり(Run <<< f <$> x)は
(Run <<< (b -> Free (VariantF r) a) <$> (VariantF r b))
ということなので、VariantFのmapによってVariantFが持つ代数的データ型(など)の型が持つ関数とRun <<< (b -> Free (VariantF r) a)が組み合わされることになります。
そしてこの代数的データ型(など)の型が持つ関数((User -> a)みたいなやつ)とは、代数的データ型(など)が持つ値を後続の処理に渡すための橋渡しをする部分でした（この橋渡しのあたりはFreeモナドの基礎知識）。
なので(Run <<< f <$> x)とは
『Bind (VariantF r b) (b -> Free (VariantF r) a)の(b -> Free (VariantF r) a)関数を、(VariantF r b)のmapを使って後続の処理に繋げるための橋渡し部分と繋げる』
という関数です。
7. k1 (Run <<< f <$> x))の処理
話を戻します。(Run <<< f <$> x)の結果は次のような値(VariantF)でした。
{ userRepository: FindUserById
userId
(identity
>>> (\a -> Free (Return a) [findGroupById])
>>> Run
>>> (\a -> Free (Return a) [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
>>> Run) }
これを引数としてk1つまり(\a -> loop =<< k a)[16]を呼び出します。
aは上記の値なので、まずこれを引数としてkが呼ばれます。
ここのkは更に元をたどるとrunUserRepository[19]でinterpretに渡していた関数(on _userRepository handler send)[20]です。
今回はVariantFが、ラベルuserRepositoryを持っているので、handler[21]が呼ばれます。
パターンとしてはFindUserByIdにマッチするので次の処理が呼ばれます。
FindUserById userId next -> do
pure $ next { id: userId, name: "ユーザ1", groupId: "gid" }
いまnextはえらく長い関数になっています。
(identity -- A
>>> (\a -> Free (Return a) [findGroupById]) -- B
>>> Run -- C
>>> (\a -> Free (Return a) -- D
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
>>> Run) -- E
各行の末尾に処理を表すアルファベットを付けたので、これを見つつ追っていきましょう。
まず[A]の処理では{ id: userId, name: "ユーザ1", groupId: "gid" }がそのまま返されます。
[B]はこれを受け取りFree (Return { id: userId, name: "ユーザ1", groupId: "gid" }) [findGroupById]を返します。
[C]でこれがRunに包まれます。
Run (Free (Return { id: userId, name: "ユーザ1", groupId: "gid" }) [findGroupById])
[D]と[E]で更にRunが入れ子になり、このような値になりました。
Run (
(Return Run (
(Return { id: userId, name: "ユーザ1", groupId: "gid" })
[findGroupById])))
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
これがnextの結果です。nextの結果は更にpureに渡されていました。
更にそのpureの結果とloopがbindで繋がるので、これが最終型です。
えらく入れ子な構造になりました。
(Run
(Return
(Run
(Return
(Run
(Return { id: userId, name: "ユーザ1", groupId: "gid" })
[findGroupById])
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])))
[(\run -> resume (\a -> loop =<< [20] a) pure (unwrap run))])
構造を見てみると、on関数である[17]と[20]が2つ登場しています。
いまは副作用2つを除去した状態なので2つですが、他に副作用があり、それを除去すればその度にこのレイヤーは増えることでしょう。
loop =<<でresumeを再帰的に呼び出せるようにしておくことで、[17]や[20]のon関数を保持しつつ使えるようになっているのだと思います。
さて、この値が返すことで長かったrunUserRepositoryの処理が終わります。
4. 溜まってた処理をすべて解釈し、値を取り出す
1. extract[22]の処理
この関数はRunを引数としてとり、Run r aのa型の値を返します。
ただし条件があって副作用はすべて除去されている必要があります。
つまりRun () aという状態でなければなりません。
今回の場合、runUserRepositoryとrunToDoRepositoryによりすべての副作用が除去された状態なのでOKです。
ということで、この入れ子になった値を引数にextract[22]が呼ばれたところから話を再開しましょう。
(Run
(Return
(Run
(Return
(Run
(Return { id: userId, name: "ユーザ1", groupId: "gid" })
[findGroupById])
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])))
[(\run -> resume (\a -> loop =<< [20] a) pure (unwrap run))])
extractは渡されたRunの中身のFreeと、関数\_ -> unsafeCrashWith "Run: the impossible happened"を引数にrunFree[23]を呼び出します。
unsafeCrashWithは任意の型を返せる定義になっている関数ですが、内部的にはJavaScriptでErrorをthrowしています。つまりこの関数が呼ばれたらエラーになります。
ただ、エラーメッセージから見るに基本これは呼ばれない前提の関数と考えていいと思います。
2. runFree[23]の処理
この関数は、次のようにtoView fがReturnを返してきた場合はReturnの値を返して処理を終えます。
Bindを返してきた場合は、k (i <$> g)を実行して再帰するようになっていますが、今回の場合kとはextractから渡されてきたErrorをthrowする関数なのでBindは返ってこない前提です。
runFree :: forall f a. Functor f => (f (Free f a) -> Free f a) -> Free f a -> a
runFree k = go
where
go :: Free f a -> a
go f = case toView f of
Return a -> a
Bind g i -> go (k (i <$> g))
Returnが返ってきたら、それがmain関数まで戻されるので、処理のゴールだと考えてよいでしょう。
ということでtoViewの方にいきましょう。
3. runFreeのtoView
toViewに渡された値はこうです。
(Free
(Return
(Run
(Return
(Run
(Return { id: userId, name: "ユーザ1", groupId: "gid" })
[findGroupById])
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])))
[(\run -> resume (\a -> loop =<< [20] a) pure (unwrap run))])
toViewは次のように、値がReturnのときは、CatListから最初の関数を取り出して[24]、Returnの値を引数にして呼び出し、その結果をtoViewに渡して再帰します[25]。
toView :: forall f a. Free f a -> FreeView f a Val
toView (Free v s) =
case v of
Return a ->
-- [24]
case uncons s of
Nothing ->
Return (unsafeCoerceVal a)
Just (Tuple h t) ->
-- [25]
toView (unsafeCoerceFree (concatF ((runExpF h) a) t))
Bind f k ->
Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
今回の値はReturnが入れ子になっています。なのでtoViewも入れ子のレイヤーごとに呼ばれていくわけですが、その流れを文章で説明するのは無理があるので、ちょっと図解してみます。
図: toViewが繰り返し呼ばれる流れ
末端のレイヤー3の処理の結果は次のようになるでしょう。
Free
(Bind { userRepository: (FindGroupById "gid" identity) } pure)
[findToDoListByUserIds]
この値はレイヤー2のtoViewから呼ばれた関数の結果なので、レイヤー2に戻っていきます。
戻ってきた値はtoViewにまた渡されます。
そして値がBindなため、Bindにパターンマッチします。
Bind f k ->
Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
なので次の値が返ります。
Bind
{ userRepository: (FindGroupById "gid" identity) }
(\a -> Free (Return a) [findToDoListByUserIds])
この値はレイヤー2のresumeまで戻っていき、Bindなので次が実行されます(resumeから渡されている関数もまとめて書いちゃいました)。
(\x f -> (\a -> loop =<< [17] a) (Run <<< f <$> x))
ここらへんの動きは既に説明しているので、結果だけ書いてしまうと、次の値が返ります。
(userRepositoryは[17]のon関数にマッチしないのでsendが使われました)
Run
{ userRepository: FindGroupById
"gid"
(Run <<< (\a -> Free (Return a) [findToDoListByUserIds]) <<< identity) }
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))]
この値はレイヤー3のtoViewから呼ばれた関数の結果なので、レイヤー3に戻っていきます。
戻ってきた値はtoViewにまた渡されます。
そして値がBindなため、Bindにパターンマッチします。
Bind f k -> Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
なので次の値が返ります。
Bind
{ userRepository: FindGroupById
"gid"
(Run <<< (\a -> Free (Return a) [findToDoListByUserIds]) <<< identity) }
(\a -> Free (Return a) [(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
この値は更にレイヤー3のresume'まで戻っていきます。
そして今度は[20]のon関数にマッチするわけです。
(\x f -> (\a -> loop =<< [20] a) (Run <<< f <$> x))
なので今度はsendではなくハンドラ[21]が使われます。
最終的にはこのような値になります。
これがレイヤーの一番上まで戻ってきたときの値です。
(Free
(Return
(Run
(Return
(Run
(Return { id: "gid", userIds: ["uid1", "uid2"] })
[findToDoListByUserIds])
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])))
[(\run -> resume (\a -> loop =<< [20] a) pure (unwrap run))])
runFreeのtoViewが呼ばれたときの構造とそっくりですね。
変わっているのは末端のレイヤーの中身です。処理が一つ進んでいます。
そして、値がReturnでかつCatListに関数があるため、次も同じようにレイヤーの中に入っていく動きが繰り返されます。
次の末端の処理結果はこうなります。
Free
(Bind { toDoRepository: (FindToDoListByUserIds ["uid1", "uid2"] identity) } pure)
[]
この値が今度もレイヤー2のtoViewに戻ってきて、値がBindなため、Bindにパターンマッチします。
Bind f k ->
Bind f (\a -> unsafeCoerceFree (concatF (k a) s))
なので次の値が返ります。
Bind
{ toDoRepository: (FindToDoListByUserIds ["uid1", "uid2"] identity) }
(\a -> Free (Return a) [])
この値はまたレイヤー2のresume'まで戻っていき、Bindなので次が実行されます。 (\x f -> (\a -> loop =<< [17] a) (Run <<< f <$> x))`
(Run <<< f <$> x)は
『Bind (VariantF r b) (b -> Free (VariantF r) a)の(b -> Free (VariantF r) a)関数を、(VariantF r b)のmapを使って後続の処理に繋げるための橋渡し部分と繋げる』
という関数でしたね。
今回はFindToDoListByUserIdsのmapが使われます。
つまり(Run <<< f <$> x)の結果はこういう値になります。
{ toDoRepository: (FindToDoListByUserIds
["uid1", "uid2"]
(identity
>>> (\a -> Free (Return a) [])
>>> Run)
}
[17]のon関数では、上記の値はtoDoRepositoryラベルにマッチするのでハンドラー[26]が使われます。
handler :: ToDoRepository ~> Run (r)
handler = case _ of
FindToDoListByUserIds userIds next -> do
pure $ next [
{userName: "ユーザ1", description: "エアコンを掃除する", completed: false},
{userName: "ユーザ2", description: "照明を買い替える", completed: true}
]
nextは(identity >>> (\a -> Free (Return a) []) >>> Run)で、それをpureの引数にするため、結果はこうなります。
(Free
(Return
(Run
(Return [
{userName: "ユーザ1", description: "エアコンを掃除する", completed: false},
{userName: "ユーザ2", description: "照明を買い替える", completed: true}
])
[])
[(\run -> resume (\a -> loop =<< [17] a) pure (unwrap run))])
この値は更にレイヤー1のtoViewまで戻っていきます。
この結果はtoViewの引数となり再帰します。
Return a ->
case uncons s of
Nothing -> Return (unsafeCoerceVal a)
Just (Tuple h t) ->
-- ~~ここの結果~~
toView (unsafeCoerceFree (concatF ((runExpF h) a) t))
再帰した結果、今回の値はReturnなのでresumeでレイヤー2に逆戻りです。
resume'では今度は次の値に対してtoViewが呼ばれるわけですが、今回は値がReturnかつCatListが空であるため、Returnの値がそのまま返されます。
Free
(Return [
{userName: "ユーザ1", description: "エアコンを掃除する", completed: false},
{userName: "ユーザ2", description: "照明を買い替える", completed: true}
])
[])
resume'はこれまでと違いtoViewがReturnを返してきたので、Return aのaを引数にjを呼び出します。
resume' k j f = case toView f of
Return a -> j a
Bind g i -> k g i
jとはRunのpureです。つまり次のようにReturnの値がそのままレイヤー1に戻っていくようなものでしょう。ただしBindのkを呼び出さないので、CatListにレイヤー2のresumeを呼び出す関数は追加されません。
結局のところ戻っていく処理では値がReturnかつCatListの関数が存在しないので、ひたすら呼び出し元に戻っていくことになります。
最終的には、runFreeのReturnにマッチして値が返されることで処理が終了します。
go f = case toView f of
Return a -> a
Bind g i -> go (k (i <$> g))
実行まとめ
-
interpretはon関数により特定の副作用を除去することができる。 -
on関数には『副作用を表すラベル』とそのラベルの副作用をハンドリングするハンドラを指定できる。 -
on関数が実行されるのは、Runを作る処理で使った最初の副作用に対して。 -
on関数に指定した『副作用を表すラベル』と上記の最初の副作用のラベルがマッチしない場合、当然副作用をハンドリングする処理は呼ばれない。 - ラベルが合わずハンドラが呼ばれなかった場合、もしくはハンドラは呼ばれたが同種の副作用が複数存在する場合のために、
onを再び呼べる細工を仕込んでいる。 - すべての副作用を除去したならば
extract関数でRun r aのaの値を取得できる。 -
extract関数では、上記の細工を利用して、残っているすべての副作用に対する処理を実行していく。 - その様子は、ある種レイヤーのような構造になっている
Runのレイヤーの階層を行ったり来たりする感じ(タイトル回収)。
その他の実行方法
今回の例では、interpretで副作用を除去しつくしてextractを呼ぶという方法で実行しましたが、別の方法もあります。
例えば最後の副作用がRunモジュールに存在するEFFECTやAFFになっている場合、runBaseEffectやrunBaseAffを実行することで、extractを呼んだときのように残っている処理をすべて呼び出すことができます。
また、Runが持つ副作用の処理一つだけを引っこ抜いてくるpeelという関数があり、これを自分で呼び出すことでも実行ができます。
peel
:: forall a r
. Run r a
-> Either (VariantF r (Run r a)) a
peel = resume Left Right
例えばRun版のReaderの副作用を除去する際、このpeelが使われています。
runReader :: forall e a r. e -> Run (READER e + r) a -> Run r a
runReader = runReaderAt _reader
runReaderAt
:: forall t e a r s
. IsSymbol s
=> Row.Cons s (Reader e) t r
=> Proxy s
-> e
-> Run r a
-> Run t a
runReaderAt sym = loop
where
handle = Run.on sym Left Right
loop e r = case Run.peel r of
Left a -> case handle a of
Left (Reader k) ->
loop e (k e)
Right a' ->
Run.send a' >>= runReaderAt sym e
Right a ->
pure a
おわりに
Extensible Effectsの動作の解説、いかがだったでしょうか。
実行の部分はクソ長くなってしまいました。
私自身は最初Extensible Effectsを利用したコードを見たとき、なぜこのようなことが実現できているのか不思議で仕方がありませんでしたが、マイナー言語の宿命かコードの解説などなく、腹落ちするためには、ちょっとずつコードを追っかける日々を送らざるを得ませんでした。
ということがあり、折角なので知ってることを吐き出すつもりでこのような記事を書いてみたのです。
私と同じような奇特な人の助けになれば幸いです。
Discussion