Freer Effectsが、だいたいわかった: 13 モナドを混ぜ合わせる(開いた型で) 

Freer Effectsが、だいたいわかった: 13 モナドを混ぜ合わせる(開いた型で)
================================================================

はじめに
-------

「Freer Effectsが、だいたいわかった」シリーズのクライマックスだ。ようやく、ここまで来た。Freerモナドと開いた直和型とを組み合わせる。Freer EffectsはFreerモナドと開いた直和型の両方にとっての、よい使用例になっている。

目次
----

(0). [導入](https://qiita.com/YoshikuniJujo/items/c71644b5af1f5195cbf3)

1. [Freeモナドの概要](https://qiita.com/YoshikuniJujo/items/988ac4b69a27974154fd)
	* Freeモナドとは
	* FreeモナドでReaderモナド、Writerモナドを構成する
2. [存在型(ExistentialQuantification拡張)の解説](
	https://qiita.com/YoshikuniJujo/items/988ac4b69a27974154fd )
3. [型シノニム族(TypeFamilies拡張)の解説](https://qiita.com/YoshikuniJujo/items/17853e423c39409d8dfe)
4. [データ族(TypeFamilies拡張)の解説](https://qiita.com/YoshikuniJujo/items/b3c442d0387a35bfe860)
5. [一般化代数データ型(GADTs拡張)の解説](https://qiita.com/YoshikuniJujo/items/739a1e3abed8c602dba7)
6. [ランクN多相(RankNTypes拡張)の解説](https://qiita.com/YoshikuniJujo/items/4094b5fe5a7a33f3d1e6)
7. [FreeモナドとCoyoneda](https://qiita.com/YoshikuniJujo/items/729ad9830833eacb9d75)
	* Coyonedaを使ってみる
	* FreeモナドとCoyonedaを組み合わせる
		+ いろいろなモナドを構成する
8. [Freerモナド(Operationalモナド)でいろいろなモナドを構成する](
	https://qiita.com/YoshikuniJujo/items/686fedc92fd20ff70ab8 )
	* FreeモナドとCoyonedaをまとめて、Freerモナドとする
	* Readerモナド
	* Writerモナド
	* 状態モナド
	* エラーモナド
9. [モナドを混ぜ合わせる(閉じた型で)](
	https://qiita.com/YoshikuniJujo/items/19a6e9dada698a5ebfb6 )
	* Freerモナドで、状態モナドとエラーモナドを混ぜ合わせる
		+ 両方のモナドを一度に処理する
		+ それぞれのモナドを、それぞれに処理する
10. [存在型による拡張可能なデータ構造(Open Union)](
	https://qiita.com/YoshikuniJujo/items/8dd63c9415ccda20be28 )
11. 追加の言語拡張
	1. [ScopedTypeVariables拡張](
		https://qiita.com/YoshikuniJujo/items/103807ee6692e8c2c48b )
	2. [TypeOperators拡張](
		https://qiita.com/YoshikuniJujo/items/68af70347e61849ccea9 )
	3. [KindSignatures拡張](
		https://qiita.com/YoshikuniJujo/items/0f581acc78d2ba8e3a7c )
	4. [DataKinds拡張](
		https://qiita.com/YoshikuniJujo/items/c06c01f9a2d344ac211f )
	5. [MultiParamTypeClasses拡張](
		https://qiita.com/YoshikuniJujo/items/165460f39f1cae751300 )
	6. [FlexibleInstances拡張] (
		https://qiita.com/YoshikuniJujo/items/eb70e7978f333ef3b514 )
	7. [OVERLAPSプラグマ](https://qiita.com/YoshikuniJujo/items/6b57a2778b04f54cac1e)
	8. [FlexibleContexts拡張](https://qiita.com/YoshikuniJujo/items/a7146d041f88ba00d574)
	9. [LambdaCase拡張](https://qiita.com/YoshikuniJujo/items/7ee3f393871c9d6935af)
12. [Open Unionを型によって安全にする](https://qiita.com/YoshikuniJujo/items/3e7adbbbf0e7f73f669f)
13. モナドを混ぜ合わせる(開いた型で)
	* FreeモナドとOpen Unionを組み合わせる
	* 状態モナドにエラーモナドを追加する
14. [Freer Effectsで、IOモナドなどの、既存のモナドを使用する](https://qiita.com/YoshikuniJujo/items/033c8a485c991bd28241)
15. 関数を保管しておくデータ構造による効率化
16. いろいろなEffect
	* 関数send, handleRelayなどを作成する
	* NonDetについてなど
	* Trace
	* Fresh, Cut
	* Coroutine

本質
----

ここまで、長々と説明してきたが、Freer Effectsの本質は、つぎの型シノニムにある。

```haskell
type Eff effs = Freer (Union effs)
```

開いた直和型による拡張可能な「文脈」を、Freerモナドにくるんでいる。

Readerモナドの例
---------------

データ型Readerを、つぎのように定義する。

```haskell
data Reader e a where Reader :: Reader e e
```

Readerモナドにおける「値を読み出す関数ask」は、つぎのようになる。

```haskell
ask :: Member (Reader e) effs => Eff effs e
ask = inj Reader `Bind` Pure
```

型クラス制約のMember (Reader e) effsは、「型のリストeffsが型Reader eを含む」という意味である。なので`Member (Reader e) effs => Eff effs e`とした場合には、つぎのような型を意味する。

* `Eff '[Reader e] e`
* `Eff '[Writer w, Reader e, State s] e`
* `Eff '[Foo, Bar, Reader e, Baz] e`
* ...

`inj Reader`で、関数injは適切なインデックスを指定しつつ、値Readerを開かれた直和型に変換している。たとえば、`ask :: Eff '[Writer w, Reader e, State s] e`だったとすると、インデックスは1になるはずだ。`Bind (inj Reader) Pure`とすることで、Freerモナドにつつみこんでいる。

関数runReaderを定義する。

```haskell
runReader :: Eff (Reader e ': effs) a -> e -> Eff effs a
m `runReader` e = case m of
        Pure x -> Pure x
        u `Bind` k -> case decomp u of
                Right Reader -> k e `runReader` e
                Left u' -> u' `Bind` ((`runReader` e) . k)
```

`Pure x`ならば、そのまま`Pure x`になる。`Bind u k`であった場合、`decomp u`によってuのなかみがReaderモナドなのか、それ以外のモナドなのかを場合分けする。Readerモナドであれば、モナドの計算の続きであるkに引数としてeをあたえ、さらに関数runReaderを適用していく。uのなかみがReaderモナドでなかったときには、そのままモナドの計算の続きであるkにたいしてrunReaderを適用していく。関数runReaderは、Readerモナドだけを処理して、ほかのモナドについては「そのまま」にしておく処理だ。

Readerモナドのサンプルを定義する。

```haskell
readerSample :: Eff '[Reader Integer] Integer
readerSample = do
        e <- ask
        return $ 3 * e
```

これに関数runReaderを適用すると結果の型は`Eff '[] Integer`となる。Effの型引数が空リストであるということは、モナドの文脈を含んでいないということになるので、かならずPure xのかたちになっているはずだ。このような、文脈が空になったデータ型から値を取り出す関数を定義する。

```haskell
run :: Eff '[] a -> a
run (Pure x) = x
run _ = error "Eff.run: This function can run only PUre"
```

定義の2行目のエラーは開かれた直和型を正しく関数injのみで構成して、正しく関数prjやdecompなどで展開していれば、起こり得ないエラーだ。なぜなら、値構築子BindはEffの型引数である「型のリスト」に型が含まれていなければ、導入することができず、「型のリスト」から型を取り除くには対応する値構築子Bindを展開しなくてはならないからだ。

ここまでのコードの全体
-------------------

ここまでのコードの全体を、ここに再掲する。

```haskell:src/Freer.hs
{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Freer (Freer(..)) where

import Control.Monad ((>=>))

data Freer t a = Pure a | forall x . t x `Bind` (x -> Freer t a)

instance Functor (Freer f) where
        f `fmap` Pure x = Pure $ f x
        f `fmap` Bind tx k = tx `Bind` (k >=> Pure . f)

instance Applicative (Freer f) where
        pure = Pure
        Pure f <*> m = f <$> m
        tx `Bind` q <*> m = tx `Bind` (q >=> (<$> m))

instance Monad (Freer f) where
        Pure x >>= f = f x
        tx `Bind` k >>= f = tx `Bind` (k >=> f)
```

```haskell:src/OpenUnion.hs
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DataKinds, KindSignatures, TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module OpenUnion (Union, Member, inj, prj, decomp) where

import Unsafe.Coerce (unsafeCoerce)

data Union (ts :: [* -> *]) a = forall t . Union Word (t a)

newtype P (t :: * -> *) (ts :: [* -> *]) = P { unP :: Word }

class Member (t :: * -> *) (ts :: [* -> *]) where elemNo :: P t ts
instance Member t (t ': ts) where
        elemNo = P 0
instance {-# OVERLAPPABLE #-} Member t ts => Member t (_t' ': ts) where
        elemNo = P $ 1 + unP (elemNo :: P t ts)

inj :: forall t ts a . Member t ts => t a -> Union ts a
inj = Union $ unP (elemNo :: P t ts)

prj :: forall t ts a . Member t ts => Union ts a -> Maybe (t a)
prj (Union i x)
        | i == unP (elemNo :: P t ts) = Just $ unsafeCoerce x
        | otehrwise = Nothing

decomp :: Union (t ': ts) a -> Either (Union ts a) (t a)
decomp (Union 0 tx) = Right $ unsafeCoerce tx
decomp (Union i tx) = Left $ Union (i - 1) tx
```

```haskell:src/Eff.hs
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Eff (Eff, Freer(..), Member, run, inj, prj, decomp) where

import Freer (Freer(..))
import OpenUnion (Union, Member, inj, prj, decomp)

type Eff effs = Freer (Union effs)

run :: Eff '[] a -> a
run (Pure x) = x
run _ = error "Eff.run: This function can run only Pure"
```

Freer Effectsの本質は上記の3つのモジュールだ。あとは、それぞれのモナドと、それらについて「そのモナドだけを処理する関数」を定義すればいい。Readerモナドでは、うえでみたように、つぎのようになる。

```haskell:src/Reader.hs
{-# LANGUAGE GADTs, DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Reader (Reader, ask, runReader) where

import Eff (Eff, Freer(..), Member, inj, decomp)

data Reader e a where Reader :: Reader e e

ask :: Member (Reader e) effs => Eff effs e
ask = inj Reader `Bind` Pure

runReader :: Eff (Reader e ': effs) a -> e -> Eff effs a
m `runReader` e = case m of
        Pure x -> Pure x
        u `Bind` k -> case decomp u of
                Right Reader -> k e `runReader` e
                Left u' -> u' `Bind` ((`runReader` e) . k)
```

サンプルをモジュールSamplesに定義する。

```haskell:src/Samples.hs
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Sample where

import Eff
import Reader

readerSample :: Eff '[Reader Integer] Integer
readerSample = do
        e <- ask
        return $ 3 * e
```

対話環境で試してみる。

```
*Samples> run $ readerSample `runReader` 123
369
```

Writerモナド
-----------

おなじように、Writeモナドを定義する。

```haskell:src/Writer.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs, DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Writer (Writer, tell, runWriter) where

import Control.Arrow (second)
import Data.Monoid (mempty, (<>))

import Eff (Eff, Freer(..), Member, inj, decomp)

data Writer w a where Writer :: w -> Writer w ()

tell :: Member (Writer w) effs => w -> Eff effs ()
tell = (`Bind` Pure) . inj . Writer

runWriter :: Monoid w => Eff (Writer w ': effs) a -> Eff effs (a, w)
runWriter = \case
        Pure x -> Pure (x, mempty)
        u `Bind` k -> case decomp u of
                Right (Writer w) -> second (w <>) <$> runWriter (k ())
                Left u' -> u' `Bind` (runWriter . k)
```

とくに新しい話はない。いままでの話を組み合わせれば、わかるはずだ。`tell 123`のようにすることで、`Writer 123`が開かれた直和型に変換されたうえで、Freerモナドでつつみこまれる。関数runWriterは`Writer w`をみつけるたびに、タプルの第2要素にwを追加していく。

Stateモナド
----------

Stateモナドについても、だいたいおなじだ。

```haskell:src/State.hs
{-# LANGUAGE GADTs, DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module State (State, runState, get, put, modify) where

import Eff (Eff, Freer(..), Member, inj, decomp)

data State s a where Get :: State s s; Put :: s -> State s ()

get :: Member (State s) effs => Eff effs s
get = inj Get `Bind` Pure

put :: Member (State s) effs => s -> Eff effs ()
put = (`Bind` Pure) . inj . Put

modify :: Member (State s) effs => (s -> s) -> Eff effs ()
modify f = put . f =<< get

runState :: Eff (State s ': effs) a -> s -> Eff effs (a, s)
m `runState` s0 = case m of
        Pure x -> Pure (x, s0)
        u `Bind` k -> case decomp u of
                Right Get -> k s0 `runState` s0
                Right (Put s) -> k () `runState` s
                Left u' -> u' `Bind` ((`runState` s0) . k)
```

Stateモナドについても、新しい話はないかと思う。関数getやputは、それぞれReaderモナドやWriterモナドの関数askやtellとだいたいおなじだ。関数runStateでは、`Get`をみつけるたびに「続く計算に状態s0を引数としてあたえて」いる。また`Put s`をみつけるたびに、状態をsに更新している。`Bind u k`で`u`が`Get`でも`Put s`でもない場合には、そのまま残しておき続く計算に対してrunStateを再帰的に適用している。

Exceptionモナド
--------------

```haskell:src/Exception.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Exception (Exc, runError, throwError, catchError) where

import Eff (Eff, Freer(..), Member, inj, prj, decomp)

newtype Exc e a = Exc e

throwError :: Member (Exc e) effs => e -> Eff effs a
throwError = (`Bind` Pure) . inj . Exc

runError :: Eff (Exc e ': effs) a -> Eff effs (Either e a)
runError = \case
        Pure x -> Pure $ Right x
        u `Bind` k -> case decomp u of
                Right (Exc e) -> Pure $ Left e
                Left u' -> u' `Bind` (runError . k)

catchError ::
        Member (Exc e) effs => Eff effs a -> (e -> Eff effs a) -> Eff effs a
m `catchError` h = case m of
        Pure x -> Pure x
        u `Bind` k -> case prj u of
                Just (Exc e) -> h e
                Nothing -> u `Bind` ((`catchError` h) . k)
```

関数throwErrorはWriterモナドの関数tellと、だいたいおなじだ。`throwError "Oops!"`とすると`Exc "Oops!"`を開かれた直和型に変換したものがFreerモナドでつつまれる。関数runErrorも、いままでみてきた内容で理解できるはずだ。`Bind u k`で`u`が`Exc e`だったときには「残りの計算」を捨てて`Left e`をかえす。

関数catchErrorは新しい内容を含んでいる。まず、`Exc e`を取り出すのに関数decompではなく関数prjを使っている。関数decompは型リストの先頭に、その型があることを想定していて、結果の型からは、その型が取り除かれる。関数prjでは型リストにその型が含まれていればよく、結果の型からその型を取り除かない。

関数catchErrorは`Bind u k`において`u`が`Exc e`だったときに、残りの計算は捨ててh eに置き換える。`h e :: Eff effs a`の型リストeffsには`Exc e`も含まれているので、関数catchErrorは、「エラー処理をしたあとに、おなじエラーを投げ直す」などの処理をすることができる。

StateモナドとExceptionモナドとを組み合わせる
----------------------------------------

適当な計算の例でStateモナドとExceptionモナドとを組み合わせてみよう。

```haskell:Sample.hs
{-# LANGUAGE ScopedTypeVariables, DataKinds, FlexibleContexts #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Samples where

import Eff
import State
import Exception

safeDiv :: Member (Exc String) effs => Integer -> Integer -> Eff effs Integer
n `safeDiv` 0 = throwError $ show n ++ " is devided by 0"
n `safeDiv` m = return $ n `div` m

safeDivSample :: (Member (State Integer) effs, Member (Exc String) effs) =>
        Eff effs Integer
safeDivSample = do
        (a :: Integer) <- get
        modify (subtract (5 :: Integer))
        modify (* (2 :: Integer))
        b <- get
        c <- 60 `safeDiv` b
        put a
        modify (subtract (3 :: Integer))
        d <- get
        e <- 250 `safeDiv` d
        return $ c + e

runSafeDivSample1 :: Integer -> Either String (Integer, Integer)
runSafeDivSample1 n = run $ runError (safeDivSample `runState` n)

runSafeDivSample2 :: Integer -> (Either String Integer, Integer)
runSafeDivSample2 n = run $ runError safeDivSample `runState` n
```

計算safeDivSampleの型は`Eff effs Integer`で、型リストeffsは要素として`State Integer`と`Exc String`を含んでいる。状態であるInteger型の値に対して、いろいろな計算をしたり、それを取り出したりしている。また、関数safeDivによって、わる数が0のときにはエラーを投げるようになっている。

関数runSafeDivSample1は計算を実行するやりかたのひとつであり、「初期状態をあたえる処理のうえで、エラーを処理し」ている。関数runSafeDivSample2は計算を実行する、もうひとつのやりかたであり、「エラーの処理のうえで、初期状態をあたえる処理をし」ている。

対話環境で試してみる。

```
*Samples> runSafeDivSample1 8
Right (60,5)
*Samples> runSafeDivSample1 5
Left "60 is devided by 0"
*Samples> runSafeDivSample1 3
Left "250 is devided by 0"
*Samples> runSafeDivSample2 8
(Right 60,5)
*Samples> runSafeDivSample2 5
(Left "60 is devided by 0",0)
*Samples> runSafeDivSample2 3
(Left "250 is devided by 0",0)
```

モナドの階層構造を意識する必要がない
--------------------------------

それぞれのモナドの機能を組み合わせるときには、モナドの階層構造を意識する必要がない。組み立てた構造を「単純な値」に展開する段階で「階層構造」を決めてやればいい。

まとめ
-----

ここまで、ながながと説明してきた、ふたつの道具を組み合わせて、「モナドを混ぜ合わせる」仕組みを作った。その道具は、つぎのふたつだ。

* Freerモナド
* 開かれた直和型

モナドトランスファーマーだと、モナドを組み合わせるときに「モナドの階層構造」を意識する必要がある。Freer Effectsでは、その必要がない。これは、それぞれのモナドについて「部品として使いやすくなる」性質だ。