つくってわかるFreeモナド 〜 Freeモナド、その仕組み 〜
はじめに
Freeモナド・・・使ってますか?
使ってないという方も、Freeモナドが使われたフレームワークやライブラリを使っていて間接的に使っているかもしれません。
例えばフレームワークだとHalogen
やJelly
など、ライブラリだとRun
(拡張可能作用)で使われています。
newtype HalogenM state action slots output m a = HalogenM (Free (HalogenF state action slots output m) a)
newtype ComponentM m a = ComponentM (Free (ComponentF m) a)
newtype Run r a = Run (Free (VariantF r) a)
この記事は、そのFreeモナドの仕組みを理解するため、Freeモナドを実際に作りながら解説や図解をしていくという記事です。
実用的なライブラリとしてのFreeモナドをつくるのは大変ですが、あそびながら理解するために最低限のものをつくるという趣旨なら、意外と短いコード量でもいけるので、気楽にやってみましょう!
つくる
Freeモナドをつくる道筋
こんな感じで進めていきます。
- 型を定義する
- モナドにする
- あそぶ
Free型を定義しよう
最初のステップとして、Freeの型を定義しましょう。
次のような代数的データ型を定義します。
data Free f a
= Pure a
| Free (f (Free f a))
1行目・2行目で「ふむふむ」となり、3行目で「うっ」となったかもしれません。
が、ご安心ください。よく見れば同じ構造が再帰的に定義されているだけです。
Free
が3つも出てきて混乱するかもしれませんが、1つは単なるデータ構築子です。
データ構築子Free
は、再帰的なデータの構築を可能にするもので、Pure
は終端を表すものです。
構造の持つ意味
上述したように、型構築子Free f a
に対し、データ構築子Pure a
は構造の終端を表す部分で、a
を持っています。
データ構築子Free (f (Free f a))
の方は再帰的な構造を実現している部分で、様々なf
の値を階層的に蓄積していってる部分です。
様々なf
の値というのは、例えば次のような代数的データ型Teletype
におけるPutStrLn
やGetLine
の値のことです(これはPureScriptのFreeモナドのライブラリであるpurescript-free
の例で使われている型です)。
data Teletype a = PutStrLn String a | GetLine (String -> a)
このf
は「何を行うか」を表すインタフェースのようなもので、ネストしていった階層の深さが処理の順序にあたります。
説明しやすくするため、上記の型をFree f a
のf
として、値を作ってみます。
(あまりネストが深くなると見づらくなるのでこの程度にとどめています。また実用する上ではこんな作り方はしないです)
derive instance teletypeFunctor :: Functor Teletype
t :: Free Teletype Unit
t = Free (GetLine (\line -> (Free (PutStrLn line (Pure unit)))))
1階層目のGetLine
が最初の処理で、2階層目(終端)のPutStrLn
が次の処理にあたります。
このように、階層構造とインタフェース的役割を持つデータ型を使って、ときには上記よりもっと複雑になる処理の順序・流れを蓄積しつつも、型としてはFree f a
とシンプルに表すことができるのがFreeモナドの特徴の一つです。
この例のGetLine
やPutStrLn
の具体的な処理は、この構造の構築とは切り離されており、別に定義することになります。
この「分離されている」というところがFreeモナドの素晴らしいところです。
DSLが簡単に作れるのもこの特性のおかげでしょう。
ところで、上記例においてPutStrLn String a
のa
や、GetLine (String -> a)
の(String -> a)
が何か気になった方がおられるかもしれません。
これらは処理の結果を後続の処理に渡すための仕組みです。
このような構造において、処理結果を後続の処理に渡すために、こういったアプローチをとっているわけです。
GetLine
がもっている関数に型アノテーションをつけてみると、GetLine
が持っている関数の型がよくわかるでしょう。
t :: Free Teletype Unit
t = Free (GetLine
((\line -> Free (PutStrLn line (Pure unit)))
:: (String -> Free Teletype Unit))
)
ところで、Free
の値をつくるのにいちいちこんな風に書きたくはないですよね?
Free (GetLine (\line -> (Free (PutStrLn line (Pure unit)))))
こんな風に書けたらいいな、そうは思いませんか?
t :: Free Teletype Unit
t = do
line <- getLine
putStrLn line
・・・・・・思うでしょう?
思いますね!
(Freeモナドをよくご存じの方にとっては茶番でしょうが、話の流れの都合ってやつです)
んじゃ、書けるようにしましょうー。
どうしたらいいかってーと、Free
をモナドにすればいいのです!
Freeをモナドにしよう
モナドにすればいいのです!と言いましたが、そもそも今回はFreeモナドの話をしていたわけで、
最初から既定路線でした。
しかし、ここまでのコード上では、ただ型が定義されただけなので、当然モナドではありません。
ということで、Free
をモナドにしたいのですが、PureScriptで、ある型をモナドとして扱えるようにするためには、その型がいくつかの型クラスのinstanceになっている必要があります。
その型クラスとは、Functor
Apply
Applicative
Bind
Monad
です。
これらの型クラスには次のように階層的な関係性があります。
図でいうと、Functor
が階層のトップにいるので、まずFunctor
からいってみましょう。
Functor
Free
をFunctor
のinstanceにします。
定義はこのようになります(実装はこれからです)。
実装のイメージがつきやすいようmap
に型アノテーションをつけています。
instance functorFree :: Functor (Free f) where
map :: forall a b. (a -> b) -> (Free f a) -> (Free f b)
Free f a
のa
をb
に写してますね。
Free
にはPure
とFree
2つのデータ構築子が存在するので、次のようにそれぞれのパターンの処理を実装することになります。
instance functorFree :: (Functor f) => Functor (Free f) where
map :: forall a b. (a -> b) -> (Free f a) -> (Free f b)
map fn (Free f) = Free (map fn <$> f)
map fn (Pure a) = Pure (fn a)
着目したいポイントは、型制約Functor f
の部分です。
この制約がなぜ必要かは、Free (map fn <$> f)
の部分を見れば理解していただけると思います。
<$>
はmap
なので、f
のmap
を使うために必要なわけです。
この部分の解説をしましょう。
この部分をlet
と型アノテーションを使ってクッソ冗長に書きなおしてみます。
map fn (Free free) = let
freeMapFn = map fn :: (Free f a) -> (Free f b)
f = free :: (f (Free f a))
in Free (freeMapFn <$> f)
最初のmap fn
の部分ですが、map
は自分自身の関数であるため、再帰的な呼び出しとなります。
そしてmap
にはfn
しか渡していないので、結果は(Free f a) -> (Free f b)
という関数になります。
次に(Free free)
のfree
は、定義から(f (Free f a))
となるので、map
の結果の関数をfreeMapFn <$> f
というように使えます。
Free
の方の実装が比較的複雑だったのに比べ、Pure
のmap
の実装は非常に単純で、fn a
の結果をPure
に包んでるだけです。
このmap
がどう動作するのか、この簡単なFree
の値を使って説明します。
f :: Free Maybe String
f = Free (Just (Free (Pure <$> (Just "hoge"))))
exec :: Free Maybe String
exec = (_ <> ":fuga") <$> f
まず最初は
map fn (Free free) = let
freeMapFn = map fn :: (Free f a) -> (Free f b)
f = free :: (f (Free f a))
in Free (freeMapFn <$> f)
の方にマッチしますね(説明のため冗長なコードの方をもってきてます)。
この場合のFree free
のfree
は、Just (Free (Pure <$> (Just "hoge")))
です。
そしてMaybe
のmap
によって、free
に対してfreeMapFn
が実行されます。
freeMapFn
の元になっているfn
は最初渡された関数です。
そしてfreeMapFn
の元になっているmap
はFree
のmap
です。
更に値はFree (Pure <$> (Just "hoge"))
となります。
Free
のmap
関数に、Free
の値が与えられました。
はい、再帰です。
次は
map fn (Pure a) = Pure (fn a)
の方にマッチします。
ここでa
の値は"hoge"なので最初渡したmap
の関数(_ <> ":fuga")
によって文字列が結合され、a
の値はhoge:fuga
となります。
Functor
の説明はこれくらいでよいでしょう。
Free
にFunctor
が必要な理由がご理解いただけたと思います。
Applicative
Applicative
のinsntanceはめちゃくちゃ簡単です。
Pure
を使うだけです。
instance applicativeFree :: (Functor f) => Applicative (Free f) where
pure = Pure
以上。
Bind
Bind
のinstanceはこうです。
説明のためbind
の型アノテーションも書いています。
instance bindFree :: (Functor f) => Bind (Free f) where
bind :: forall a b. Free f a -> (a -> Free f b) -> Free f b
bind (Free f) fn = Free $ (\a -> bind a fn) <$> f
bind (Pure a) fn = fn a
まずbind (Free f) fn = Free $ (\a -> bind a fn) <$> f
の方の説明をします。
型制約によりf
はFunctor
なので<$>
が使えます。
その際のmap
関数(\a -> bind a fn)
のa
はFree
なので、元の関数fn
を維持したままbind
で再帰します。再帰していった結果、終端であるPure a
の方にマッチしたらfn a
して終わりです。(\a -> bind a fn) <$> f
の結果はFree
に与えられるので、bind
するたびFree
の階層はどんどん増えていきます。
つまり、bind
により、値を作る際にFree
をネストさせなくてよくなります。
こんなコードを書かなくてよくなります(よかった)。
t :: Free Teletype Unit
t = Free (GetLine (\line -> (Free (Pure <$> (PutStrLn line unit)))))
これまで作ってきたpure
や>>=
を使うと↑を↓のように書けるようになります。
t :: Free Teletype Unit
t = (Free $ pure <$> (GetLine identity))
>>= (\line -> Free $ pure <$> (PutStrLn line unit))
複数の小さなFree
がbind
でくっついた形になりました。
GetLine
とPutStrLn
がバラされたので、GetLine
の関数はFree
を返さなくてよくなりました。型的に取得したものをそのまま返せばいいのでidentity
でよいのです。
(なぜidentity
でよいのか、なぜこのような関数が必要なのかは、このあと解説します)
別関数に切り出して、型アノテーションを書いてみるとわかりやすいでしょう。
getLine :: Free Teletype String
getLine = Free $ pure <$> (GetLine identity)
putStrLn :: String ->Free Teletype Unit
putStrLn s = Free $ pure <$> (PutStrLn s unit)
t :: Free Teletype Unit
t = getLine >>= (\line -> putStrLn line)
Bindの解説
bind
関数は極めて重要なので、getLine >>= (\line -> putStrLn line)
を例にとり、処理の流れを解説しましょう。
ここでGetLine identity
のidentity
の意味もわかります。
getLine
が示す値は構造がわかるように書くとFree (GetLine (\a -> Pure (identity a)))
です。なので、bind
としては次のパターンにマッチします。
bind (Free f) fn = Free $ (\a -> bind a fn) <$> f
このときのf
はGetLine (\a -> Pure (identity a))
となっています。
次にf
に対しての<$>
つまりmap
の動きを説明します。
Functor
はderive instance
で導出できるのですが、説明のため敢えて書くとこんな感じになるでしょう。
instance teletypeFunctor :: Functor Teletype where
map fn (PutStrLn s a) = PutStrLn s (fn a)
map fn (GetLine next) = GetLine $ fn <<< next
このmap fn (GetLine next)
の部分をいまの値で置き換えてみると、このようになります。
map (\a -> bind a (\line -> putStrLn line)) (GetLine (\a -> Pure (identity a)))
GetLine $ fn <<< next
の部分を上記の値で置き換えてみると、次のような値が返されることがわかります。
GetLine $ (\a -> bind a (\line -> putStrLn line)) <<< (\a -> Pure (identity a))
整形してみるとこうです。
GetLine (\a -> (Pure (identity a)) >>= (\line -> putStrLn line))
(\a -> bind a fn) <$> f
の結果はFree
に渡されるので、最終的に返る値はこうなります。
-- 型はFree Teletype Unit
Free (GetLine (\a -> (Pure (identity a)) >>= (\line -> putStrLn line)))
putStrLn
の部分を構造がわかるように戻すとこうなります。
Free (GetLine (
\a -> (Pure (identity a)) >>= (\line -> Free (PutStrLn line (Pure unit)))
))
ここでidentity
の意味がわかります。
まずそもそもGetLine
がString -> a
型の関数を持っていなかった場合、後続の処理に値を渡すことができないです。
a
のような任意の型を返す必要があるのは、状況によって返す型が変わるからですね。
最初GetLine
はFree Teletype String
型でString
型を返すようになっていました。
それが、bind
の処理の中でmap
関数によりFree Teletype Unit
を返すようになりました。
なのでくどいですが、GetLine
は関数を持っていなければなりません。
そしてgetLine
のように組み合わせ前提の単純なFree
を返す場合、「関数でなければならない」「その関数はString
を返す」という条件を満たすものとしてidentity
は都合がよいのです。
getLine :: Free Teletype String
getLine = Free $ pure <$> (GetLine identity)
これがGetLine
が持っている関数がidentity
だった理由です。
bind
の話が途中でした。
上記の(Pure (identity a)) >>= (\line -> Free (PutStrLn line (Pure unit)))
の部分もまたbind
を呼び出しているので、ここも展開してみようと思います。
(関数の中で呼ばれるので本当は評価は後なのですが、説明のため)
この場合のbind
はPure
のパターンにマッチします。
bind (Pure a) fn = fn a
これにさきほどのコードの値を当てはめて置き換えていってみます。
fn
が(\line -> Free (PutStrLn line (Pure unit)))
で、a
が(identity a)
なのでこうなります。
(\line -> Free (PutStrLn line (Pure unit))) (identity a)
↓
(\line -> Free (PutStrLn line (Pure unit))) a
↓
Free (PutStrLn a (Pure unit))
ここまできたところで、元のコードに上記を埋め込んでみます。
Free (GetLine (\a -> Free (PutStrLn a (Pure unit))))
・・・・・・どこかで見た形ですね?
そう、この記事の最初の方で
「ところでFree
の値をつくるのにいちいちこんな風に書きたくはないですよね?」
と言っていた形と全く同じです。
ついにやりました!
・・・・・・さて、この項においては、面倒な方法でつくる値と同じ値を、簡単につくれるようになったことを説明しました。
長い長いBind
の説明もこれで終わりです。
さぁもう一息です。次にいきましょう。
(まだ見づらい部分に関してはもう少しあとに解決させます)
Monad
Monad
は型クラスの定義がこうなっているため、Applicative
とBind
のinstanceになってさえいれば特に実装はいらないです。
class (Applicative m, Bind m) <= Monad m
Apply
Apply
の実装も簡単です。Monad
のinsntanceになっていれば使えるap
がそのまま使えるからです。
instance applyFree :: (Functor f) => Apply (Free f) where
apply = ap
お疲れ様でした!
これにてようやくFree
がモナドになりました。
使ってみよう
できたので使ってみましょう。
Freeを簡単につくれるようにしよう
さて、できあがったFree
を使いたいのですが、Free
をつくるのが面倒です。
上述したようにこんなことやってられません。
data Teletype a = PutStrLn String a | GetLine (String -> a)
program :: Free Teletype Unit
program = (Free $ pure <$> (GetLine identity))
>>= (\line -> Free $ pure <$> (PutStrLn line unit))
ということで、こんな関数を作ります。
↑のコードでFree
をつくっている部分をそのまま関数にした感じです。
liftF :: forall f. Functor f => f ~> Free f
liftF f = Free $ pure <$> f
これは任意のFunctor
をFree
に「持ち上げる」関数です。
これを使うと上記のコードはこうなります。
program :: Free Teletype Unit
program = liftF (GetLine identity) >>= (\line -> liftF (PutStrLn line unit))
do
記法にした方が見やすいでしょう。
program :: Free Teletype Unit
program = do
line <- liftF (GetLine identity)
liftF (PutStrLn line unit)
更に、liftF GetLine
やliftF PutStrLn
を別の関数にするとこうなります。
putStrLn :: String -> FreeTeletype Unit
putStrLn s = liftF $ PutStrLn s unit
getLine :: FreeTeletype String
getLine = liftF $ GetLine identity
program :: Free Teletype Unit
program = do
line <- getLine
putStrLn line
で き た !
上~の方で書いていた理想形になりました!
あそぼう
GetLine
やPutStrLn
はあくまでインタフェースのような役割なので、対応する実装を与えないといけません。実装は自由にできるのですが、今回はこのような実装を用意してみました。
run :: Free Teletype ~> Effect
run (Pure a) = pure a
run (Free (PutStrLn s a)) = log s >>= \_ -> run a
run (Free (GetLine k)) = run $ k "FreeExample: fake input"
単にパターンマッチをして、Effect
に自然変換しているだけです。
使うのは簡単で、こんな感じです。
main :: Effect Unit
main = do
run program -- FreeExample: fake input
FreeExample: fake inputという出力が得られました。
では、program
をrun
に与えたとき、どのように処理が進んだ結果、この出力が得られたのか、それをこれから説明します。
まずは説明のために、program
の値をdo
記法もbind
も使わない形に戻します。
program :: Free Teletype Unit
program = Free (GetLine (\line -> (Free (PutStrLn line (Pure unit)))))
これをrun
に与えます。
すると、このパターンにマッチします。
GetLine
のk
は関数ですが、その内容はこうなっていますね。
そのk
に入力を与えた結果は、Free (PutStrLn "FreeExample: fake input" (Pure unit))
になります。
この値はrun
の再帰呼び出しに渡ります。今度はどのパターンにマッチするでしょうか?
当然Free PutStrLn...
にマッチしますね。
PutStrLn
の値はそれぞれこうなっています。
つまりこういうことです。文字列をログ出力した後、またrun
の再帰呼び出しです。
次はFree Pure
にマッチするので、pure unit
を返して終わりです。
処理の流れの説明は以上になります。
で、上記のようにFree
のレベルでパターンマッチをしてもいいのですが、次のような関数があると便利です。
foldFree :: forall f m. MonadRec m => (f ~> m) -> Free f ~> m
foldFree k = tailRecM go
where
go :: forall a. Free f a -> m (Step (Free f a) a)
go f = case f of
Pure a -> Done <$> pure a
Free g -> Loop <$> k g
結局構造を再帰的に辿るということをやってます。
辿る部分を共通的な関数にしたということですね。
これを使うとFree
のパターンマッチが消せます。
run :: FreeTeletype ~> Effect
run = foldFree go
where
go :: Teletype ~> Effect
go (PutStrLn s a) = const a <$> log s
go (GetLine k) = pure (k "SimpleFreeExample: fake input")
FreeでReaderモナドをつくってみよう
せっかくなので、Free
を利用してReaderモナドをつくってみるおまけを載せておきます。
newtype ReaderF r e = ReaderF (r -> e)
derive newtype instance functorReaderF :: Functor (ReaderF r)
type FreeReader r a = Free (ReaderF r) a
ask :: forall e. FreeReader e e
ask = liftF (ReaderF identity)
local :: forall r a. (r -> r) -> FreeReader r a -> FreeReader r a
local f r = map f ask >>= pure <<< runReader r
asks :: forall e a. (e -> a) -> FreeReader e a
asks f = f <$> ask
runReader :: forall r a. FreeReader r a -> r -> a
runReader f e = case resume f of
Left (ReaderF r) -> runReader (r e) e
Right a -> a
-- Freeのレイヤーを一つunwrapする
-- PureならRightが返り、FreeならLeftが返る。
resume
:: forall f a
. Free f a
-> Either (f (Free f a)) a
resume = resume' (\g -> Left g) Right
-- Freeのレイヤーを一つunwrapする
-- こちらはデータ型によって適用する関数を指定することができる
resume'
:: forall f a r
. (f (Free f a) -> r)
-> (a -> r)
-> Free f a
-> r
resume' k j f = case f of
Free g ->
k g
Pure a ->
j a
type Config = { debug :: Boolean }
spec :: Spec Unit
spec = do
describe "Readerのテスト" do
describe "ask" do
it "環境を取得できる" do
"value" `shouldEqual` runReader ask "value"
describe "asks" do
it "環境を取得する際に渡した関数で環境の値を変更することができる" do
"value added" `shouldEqual` runReader (asks (_ <> " added")) "value"
describe "local" do
it "環境の変更を、渡した関数内のスコープに閉じることができる" do
let
getFlag :: FreeReader Config Boolean
getFlag = do
_ <- local (\c -> c { debug = true }) do
-- ここでaskするとdebugはtrueになってる。
pure false -- 説明のためだけの処理なので適当な値を返す
c <- ask
pure c.debug
runReader getFlag { debug: false } `shouldEqual` false
全体像
つくったFree
の全体像を載せます。
案外短いことがわかると思います。
import Prelude
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
import Control.Monad.Trans.Class (class MonadTrans)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
data Free f a = Pure a | Free (f (Free f a))
instance functorFree :: (Functor f) => Functor (Free f) where
map :: forall a b. (a -> b) -> (Free f a) -> (Free f b)
map fn (Pure a) = Pure (fn a)
map fn (Free f) = Free (map fn <$> f)
instance applyFree :: (Functor f) => Apply (Free f) where
apply = ap -- apはMonadであれば使える関数
instance applicativeFree :: (Functor f) => Applicative (Free f) where
pure = Pure
instance bindFree :: (Functor f) => Bind (Free f) where
-- あえてアノテーションを書くとこう
bind :: forall a b. Free f a -> (a -> Free f b) -> Free f b
bind (Pure a) fn = fn a
bind (Free f) fn = Free $ (\a -> a >>= fn) <$> f
instance monadFree :: (Functor f) => Monad (Free f)
-- 任意のFunctorをFreeに持ち上げる
liftF :: forall f. Functor f => f ~> Free f
liftF f = Free $ pure <$> f -- Free (Pure a) という状態
-- 渡された自然変換関数(f ~> m)を使い、`Free f a`から`m a`に変換して返す。
-- `m`は末尾再帰モナドとなる
foldFree :: forall f m. MonadRec m => (f ~> m) -> Free f ~> m
foldFree k = tailRecM go
where
go :: forall a. Free f a -> m (Step (Free f a) a)
go f = case f of
Pure a -> Done <$> pure a
Free g -> Loop <$> k g
-- Freeのレイヤーを一つunwrapする
-- PureならRightが返り、FreeならLeftが返る。
resume
:: forall f a
. Free f a
-> Either (f (Free f a)) a
resume = resume' (\g -> Left g) Right
-- Freeのレイヤーを一つunwrapする
-- こちらはデータ型によって適用する関数を指定することができる
resume'
:: forall f a r
. (f (Free f a) -> r)
-> (a -> r)
-> Free f a
-> r
resume' k j f = case f of
Free g ->
k g
Pure a ->
j a
おわりに
私は「なんでこれでこんな動作をするのだろう?」という仕組みに関心があり理解したくなるタイプなのですが、Freeモナドに関しては調べたりコードリーディングだけでは理解できず、写経したり自分で作ったりしてきました。
最初参考にしたのが、今現在のpurescript-free
というライブラリだったのですが、このライブラリの今の実装は(恐らくパフォーマンス問題に対応するため)とても複雑な実装になっており、PureScriptを触り始めたばかりの頃に理解を試みたというのも重なって理解が大変でした。思えばもっと単純なところから少しずつ理解していくべきだったのですね(実際結局そうやることになった)。
このような体験が背景にあり、この記事を書いてみたのですが、いかがでしたか?
少しでも皆様の理解の助けになっていれば幸いです。
Discussion