Freeモナドの合成

## TL;DR

- Freeモナドの合成は`Coproduct`という型と`Inject`という型クラスを使うとできるよ！
- 詳しくはコードを見てね！ https://github.com/goldarn-ring/how-to-compose-free-monad

## すごーい！君はDSLが得意なフレンズなんだね！

突然ですが、Freeモナドって便利ですよね！
えっ、ご存知ではない？　DSLを簡単に作れる便利なモナドですよ！　詳しくはこちら：

- [Freeモナドって何なのさっ！？ - capriccioso String Creating(Object something){ return My.Expression(something); } ](http://d.hatena.ne.jp/its_out_of_tune/20121111/1352632815)
- [そろそろFreeモナドに関して一言いっとくか - fumievalの日記](http://d.hatena.ne.jp/fumiexcel/20121111/1352614885)

DSLによるコードと、DSLの各命令の処理を切り離すことで、モック化とかDIとかが簡単にできるのです。
例えばこのようなDSLを作って：
（コードはHaskellではなくPureScriptです。importは省略しています）

```haskell
data Friends a
  = Wai a
  | Sugoi a
  | Tanoshii a
  | TokuiNandane String a

wai :: Free Friends Unit
wai = liftF $ Wai unit

sugoi :: Free Friends Unit
sugoi = liftF $ Sugoi unit

tanoshii :: Free Friends Unit
tanoshii = liftF $ Tanoshii unit

tokuiNandane :: String -> Free Friends Unit
tokuiNandane skill  = liftF $ TokuiNandane skill unit
```

DSLでこのようなこのようなプログラムを書きます：

```haskell
friends :: String -> Free Friends Unit
friends skill = do
  wai
  sugoi
  tanoshii
  tokuiNandane skill
```

そしてDSLの各命令の動作を定義します：

```haskell
goFriendsJp :: forall a. Friends a -> Effect a
goFriendsJp (Wai next) = do
  log "わーい！"
  pure next
goFriendsJp (Sugoi next) = do
  log "すごーい！"
  pure next
goFriendsJp (Tanoshii next) = do
  log "たーのしー！"
  pure next
goFriendsJp (TokuiNandane skill next) = do
  log ("君は" <> skill <> "が得意なフレンズなんだね！")
  pure next
```

最後にDSLを走らせると、「わーい！　すごーい！　たーのしー！　君はクソコードが得意なフレンズなんだね！」（改行省略）と表示されます。


```haskell
runFriendsJp :: forall a. Free Friends a -> Effect a
runFriendsJp f = foldFree goFriendsJp f

main :: Effect Unit
main = do
  log "◆フレンズ（日本語）◆"
  runFriendsJp $ friends "クソコード"
```

フレンズたちに英語をしゃべらせてみましょう。DSLの各命令の動作を以下のようにします：

```haskell
goFriendsEn :: forall a. Friends a -> Effect a
goFriendsEn (Wai next) = do
  log "Wow!"
  pure next
goFriendsEn (Sugoi next) = do
  log "Great!"
  pure next
goFriendsEn (Tanoshii next) = do
  log "Wonderful!"
  pure next
goFriendsEn (TokuiNandane skill next) = do
  log ("You are friends that good at " <> skill <> "!")
  pure next
```

そしてこの定義を使ってDSLで書かれたプログラムを走らせると、今度は「Wow! Great! Wonderful! You are friends that good at Crappy Code!」（改行省略）と表示されます。

```haskell
runFriendsEn :: forall a. Free Friends a -> Effect a
runFriendsEn f = foldFree goFriendsEn f

main :: Effect Unit
main = do
  log "\n◆Friends (English)◆"
  runFriendsEn $ friends "Crappy Code"
```

この例はまごうことなきクソofクソコードですが、この命令の動作差し替えの仕組みがあれば、例えば、本番では外部APIを叩いて値を取得するけどテストコードでは適当なダミーの値を返すモックだとかを作れるだろうということが分かると思います。

## すごーい！君はニンジャのフレンズなんアイエエエ！ニンジャナンデ！？

DSLというのは往々にして複数の種類のものを混ぜて使いたくなることがあります。例えばQiita API用のDSLとTwitter API用のDSLがある場合、Qiitaに記事を投稿してそれをTwitterにシェアなんて機能の実装には両方のDSLを混ぜて使うことになるでしょう。

さて、まずは前節のフレンズDSLとは別のDSLを用意しましょう。

```haskell

data Ninja a
  = Domo String a
  | Yeeart a
  | Aieee a
  | Sayonara String a

domo :: String -> Free Ninja Unit
domo name = liftF $ Domo name unit

yeeart :: Free Ninja Unit
yeeart = liftF $ Yeeart unit

aieee :: Free Ninja Unit
aieee = liftF $ Aieee unit

sayonara :: String -> Free Ninja Unit
sayonara name = liftF $ Sayonara name unit

runNinjaJp :: forall a. Free Ninja a -> Effect a
runNinjaJp f = foldFree goNinjaJp f

goNinjaJp :: forall a. Ninja a ->  Effect a
goNinjaJp (Domo name next) = do
  log ("ドーモ、" <> name <> "＝サン") 
  pure next
goNinjaJp (Yeeart next) = do
  log "イヤーッ！"
  pure next
goNinjaJp (Aieee next) = do
  log "アイエエエ！？"
  pure next
goNinjaJp (Sayonara name next) = do
  log ("サヨナラ！ " <> name <> "＝サンは爆発四散！")
  pure next
```

さて、このニンジャDSLと先ほどのフレンズDSLを混ぜて使うにはどうすればいいでしょう？
具体的にはDSLで書かれた以下のようなプログラムが動くようになってほしいということです。

```haskell

ninjaFriends :: String -> String -> String -> Free NinjaFriends Unit
ninjaFriends skill ninja1 ninja2 = do
  wai
  domo ninja1
  sugoi
  yeeart
  tanoshii
  aieee
  sayonara ninja2
  tokuiNandane skill
```

「Free モナド 合成」でググると一番上にこんなブログ記事がヒットします。

- [CoproductとInjectを使ったFree Monadの合成とExtensible Effects - xuwei-k's blog]( https://xuwei-k.hatenablog.com/entry/20140618/1403054751)

`Coproduct`・・・？　`Inject`・・・？　よくわからないですが、この二つを使えば、二つのDSLを合成してニンジャフレンズDSLを爆誕させることができそうです。コードはScalaで書かれていますね。型クラスを使ったScalaのコードを読むのは慣れませんが、PureScriptで書くとどうなるのでしょう・・・。

### ドーモ、Coproduct＝サン

まずは`Friends`と`Ninja`を合成して、`NinjaFriends`と言う型を作ります。ここで早くも`Coproduct`が登場します。`Coproduct`は、kindが`Type -> Type`の型を二つ受け取って、それらの直和型を作る型のようです。`Ninja`も`Friends`も型引数を一つ取る（つまりkindが`Type -> Type`）ので`Coproduct`で合成できます。

```haskell

type NinjaFriends = Coproduct Ninja Friends
```

`Coproduct`がどんな型なのか、より詳しくは以下のドキュメントを参照してください

- https://pursuit.purescript.org/packages/purescript-functors/3.1.0/docs/Data.Functor.Coproduct#t:Coproduct

### ドーモ、Inject＝サン

次に、DSLの各命令（`wai`とか`domo`とか）を`NinjaFriends`のFreeモナドでも使えるようにします。ここで`Inject`の出番です。
もともと以下のような定義だった各命令を：

```haskell

wai :: Free Friends Unit
wai = liftF $ Wai unit

domo :: String -> Free Ninja Unit
domo name = liftF $ Domo name unit
```

`Inject`を使って以下のように書き換えます。すると`wai`や`dommo`が`NinjaFriends`のFreeモナドでも使えるようになります。

```haskell

liftF' :: forall f g a. Inject f g => f a -> Free g a
liftF' f = liftF $ inj f

wai :: forall f. Inject Friends f => Free f Unit
wai = liftF' $ Wai unit

domo :: forall f. Inject Ninja f => String -> Free f Unit
domo name = liftF' $ Domo name unit
```

なぜこれだけで使えるようになるのでしょう？ それは`Coproduct`が`Inject`のインスタンスになっているからです。ソースコードを見てみましょう。

（https://github.com/purescript/purescript-functors/blob/v3.1.0/src/Data/Functor/Coproduct/Inject.purs より一部抜粋)


```haskell

class Inject f g where
  inj :: forall a. f a -> g a

instance injectLeft :: Inject f (Coproduct f g) where
  inj = Coproduct <<< Left

else instance injectReflexive :: Inject f f where
  inj = identity
```

`Inject`の型引数が両方とも`Ninja`や`Friends`の場合、`inj`は`identity`になります。つまり、`liftF'`は`liftF`と同じ動作になります。型引数の左側が`Ninja`や`Firends`で右側がそれと何かの`Coproduct`の場合、`inj`は引数の`Ninja`や`Friends`の値から`Coproduct`の値を作るようになります。これにより、`wai`や`domo`は、もとの`Ninja`や`Friends`でもそれらの`Coproduct`である`NinjaFriends`でも使えるようになります。

### 命令実行関数合成すべし。慈悲は無い

次に、DSLの各命令の動作を定義する関数を合成しましょう。つまり以下のようなコードで、`goNinjaJp`と`goFriendsJp`を合成できるような`or`関数を作ります。

```haskell
goNinjaFriendsJp :: forall a. NinjaFriends a -> Effect a
goNinjaFriendsJp x = (goNinjaJp `or` goFriendsJp) x
```

そして、以下がその`or`関数の定義です。`f a`を受け取る関数と`g a`を受け取る関数から、両方の`Coproduct`を受け取る関数を作ります。その関数の中では、渡された`Coproduct`の値が左右どちらの値なのかを確認し、適切な方の関数に渡しています。

```haskell

or :: forall f g h a. (f a -> h a) -> (g a -> h a) -> (Coproduct f g a -> h a)
or fh gh = case _ of
  (Coproduct (Left left)) -> fh left
  (Coproduct (Right right)) -> gh right
```

ここまでやってようやく、ニンジャフレンズDSLを以下のように走らせることができるようになります。

```haskell

runNinjaFriendsEn :: forall a. Free NinjaFriends a -> Effect a
runNinjaFriendsEn f = foldFree goNinjaFriendsEn f

main :: Effect Unit
main =  do
  log "◆ニンジャフレンズ（日本語）◆"
  runNinjaFriendsJp $ ninjaFriends "クソコード" "サーバル" "カバン"
```

コンソールには以下のような出力がされることでしょう。ナムアミダブツ！

```console
◆ニンジャフレンズ（日本語）◆
わーい！
ドーモ、サーバル＝サン
すごーい！
イヤーッ！
たーのしー！
アイエエエ！？
サヨナラ！ カバン＝サンは爆発四散！
君はクソコードが得意なフレンズなんだね！
```

## 番外編1：君って本当にFreeモナドのフレンズなの・・・？

Freeモナドとは、**Functorさえあれば**そこからモナドを作れるモナドです。HaskellにもPureScriptにも、Functorを導出する仕組みがあります。

例えばHaskellではこんな感じ：

```haskell
{-# LANGUAGE DeriveFunctor #-}

data Foo a = Hoge a | Fuga a deriving (Functor)
```

PureScriptだとこんな感じ：

```haskell

data Foo a = Hoge | Fuga a

derive instance functorFoo :: Functor Foo
```

あれ・・・？　本編で`derive instance`なんて書いてないぞ・・・。
この記事でさんざん使ってきた`liftF`と`foldFree`の型をHaskellとPureScriptで比較してみましょう。

ドキュメントは以下から
- **Haskell:** http://hackage.haskell.org/package/free-5.1/docs/Control-Monad-Free.html
- **PureScript:** https://pursuit.purescript.org/packages/purescript-free/5.1.0/docs/Control.Monad.Free

Haskellでは`liftF`と`foldFree`はそれぞれ以下のような定義になっています。
はい。`liftF`が`Functor`を要求していますね。

```haskell

liftF :: (Functor f, MonadFree f m) => f a -> m a
foldFree :: Monad m => (forall x. f x -> m x) -> Free f a -> m a
```

一方、PureScriptでは以下のような定義になっています。`~>` という見慣れない矢印がありますが、これは自然変換を表します。簡単に言えば、`f ~> g`は`f a -> g a`の略記だと思えばいいでしょう。それはそれとして、やはり`liftF`が`Functor`を要求しませんね・・・。

```haskell

liftF :: forall f. f ~> (Free f)
foldFree :: forall f m. MonadRec m => (f ~> m) -> (Free f) ~> m
```

どういうことなの・・・？ もしかしてOperationalモナドなの？　CoyonedaというFunctorを使えばただのデータ型からFunctorを作れるので、それとFreeモナドを組み合わせることで、ただのデータ型からモナドを作れるというのがOperationalモナドですが・・・。

ソースコードを見るとCoyonedaも使っていないんですよねー・・・。
https://github.com/purescript/purescript-free/blob/v5.1.0/src/Control/Monad/Free.purs

## 番外編2: Haskellでも書いてみたよ！

- Haskellの場合、`Coproduct`じゃなくて`Sum`を使うよ！ 機能は実質一緒だよ
  - https://hackage.haskell.org/package/transformers-0.4.2.0/docs/Data-Functor-Sum.html
- `Inject`は無いっぽいから、自分で実装しよう！
  - Haskellにはinstance chainなんて構文は無いから、代わりに`{-# OVERLAPS #-}`と`{-# OVERLAPPABLE #-}`プラグマを使うよ！
- 詳しくはGitHubのコードを見てね！
  - https://github.com/goldarn-ring/how-to-compose-free-monad/tree/master/haskell/how-to-compose-free-monad


## コード

冒頭にも貼りましたが、最後に書いたコードへのリンクを張っておきます。コードはご自由にお使いください。

https://github.com/goldarn-ring/how-to-compose-free-monad