Extensible EffectsとTagless Finalで実装するDI

これは [FOLIO Advent Calendar 2017](https://qiita.com/advent-calendar/2017/folio-sec) 14日目の投稿です。

HaskellでDIを実装する一番いい方法は何か、様々な手法を比較しながらベストな方法を探していこうと思います。

記事中のコードは記述を簡潔にするため実行に必要なGHC拡張やimportを書いていません。完全なコードは以下のgistに載せているので参照して下さい。
<https://gist.github.com/lotz84/7207fa3a6b806807defd04e773f8dc78>

:new_moon: 易しい依存性の注入
---------------------------
DI(Dependency Injection, 依存性の注入)とは何でしょうか。Wikipediaから説明を引用すると、

> 依存性の注入とは、コンポーネント間の依存関係をプログラムのソースコードから排除し、外部の設定ファイルなどで注入できるようにするソフトウェアパターンである。英語の頭文字からDIと略される。

出典: [依存性の注入 - Wikipedia](https://ja.wikipedia.org/wiki/%E4%BE%9D%E5%AD%98%E6%80%A7%E3%81%AE%E6%B3%A8%E5%85%A5)

とあります。依存関係を排除するためによく使われる手法は プログラムのインターフェースと実装を何らかの言語機能を使って分離して 依存関係のあるプログラムをそのインターフェースだけを利用して書く方法でしょう。例えば簡単なKey-Valueストア(KVS)とやり取りするプログラムを書くとします。Haskellだと以下のように型クラスを使えばインターフェースと実装を分離することができます。

```hs
type Key   = ByteString
type Value = ByteString

-- | KVSの簡単なインターフェース
class DataStore ds where
  create :: Key -> Value -> ds -> IO ()
  read   :: Key          -> ds -> IO (Maybe Value)
  update :: Key -> Value -> ds -> IO ()
  delete :: Key          -> ds -> IO ()

-- | 与えられたKeyがすでに存在すればupdate, 存在しなければinsertする
createOrUpdate :: DataStore ds => Key -> Value -> ds -> IO ()
createOrUpdate k v ds = do
  peek <- read k ds
  case peek of
    Just _  -> update k v ds
    Nothing -> create k v ds
```

上記例の`createOrUpdate`は型クラス`DataStore`を利用して書かれているので実際に使用する際は`DataStore`のインスタンスを好きに入れ替えることができます。例えば以下のような２つの`DataStore`のインスタンスを考えてみましょう。

```hs
-- | IORefを用いたKVSの簡単な実装
newtype IORefImpl = IORefImpl (IORef [(Key, Value)])

updateList :: Eq k => k -> v -> [(k, v)] -> [(k, v)]
updateList k v = map (\r@(k', _) -> if k' == k then (k, v) else r)

deleteList :: Eq k => k -> [(k, v)] -> [(k, v)]
deleteList k = filter (\(k', _) -> k' /= k)

instance DataStore IORefImpl where
  create k v (IORefImpl ref) = modifyIORef ref ((k, v):)
  read   k   (IORefImpl ref) = lookup k <$> readIORef ref
  update k v (IORefImpl ref) = modifyIORef ref (updateList k v)
  delete k   (IORefImpl ref) = modifyIORef ref (deleteList k)

-- | 実際に処理は行わないモック用の実装
data MockImpl = MockImpl

instance DataStore MockImpl where
  create k v _ = BS.putStrLn $ BS.concat ["Create: ", k, ", ", v]
  read   k   _ = Nothing <$ (BS.putStrLn $ BS.concat ["Read: ", k])
  update k v _ = BS.putStrLn $ BS.concat ["Update: ", k, ", ", v]
  delete k   _ = BS.putStrLn $ BS.concat ["Delete: ", k]
```

`IORefImpl`は`IORef`で参照しているリストのデータを操作することで実際に簡単なKVSとして動作します。`MockImpl`は単純な出力しか行わないモック用の実装でテストの時など実際のKVSに接続しないような時に使うことを想定しています。このように型クラスを使って実装を分離できるようにすると「テストの時だけモックを使用する」ようなことが簡単に実現できます[^1]。実際にこれらが動作するか見てみましょう。

```hs
> createOrUpdate "key" "value" MockImpl
Read: key
Create: key, value
```

```hs
> ref <- newIORef ([] :: [(Key, Value)])
> createOrUpdate "key" "value" (IORefImpl ref)
> readIORef ref
[("key","value")]
```

期待通りに動いていますね。

:waxing_crescent_moon: Readerモナド
-----------------------------------
`DataStore` の定義をもう一度見てみましょう

```hs
class DataStore ds where
  create :: Key -> Value -> ds -> IO ()
  read   :: Key          -> ds -> IO (Maybe Value)
  update :: Key -> Value -> ds -> IO ()
  delete :: Key          -> ds -> IO ()
```

全てのメソッドが`ds`を引数にとっていますね。これをReaderモナドを使った型に書き直してみましょう。

```hs
class DataStore ds where
  create :: Key -> Value -> ReaderT ds IO ()
  read   :: Key          -> ReaderT ds IO (Maybe Value)
  update :: Key -> Value -> ReaderT ds IO ()
  delete :: Key          -> ReaderT ds IO ()
```

`IO`と合成するためにモナド変換子を使っています。この定義を使うと `createOrUpdate` の実装は以下のようになります。

```hs
createOrUpdate :: DataStore ds => Key -> Value -> ReaderT ds IO ()
createOrUpdate k v = do
    peek <- read k
    case peek of
      Just _  -> update k v
      Nothing -> create k v
```

変数を渡すというパターンをモナドに押し付けたことで 元のコードと比較すると`ds`だけを綺麗に消すことができました :tada: 

この`Reader`と`IO`を組み合わせる方法はとても便利で、[rio](https://hackage.haskell.org/package/rio)というライブラリでは`RIO`(=Reader+IO)という専用のモナドが提供されていたり、reflectionと存在型を使って汎用的に実装する方法も考案されています[^10]。型クラスを使ってインターフェースと実装を分離し、Readerモナドを使って依存性の注入を書くコストが減らせたのでかなり理想に近づいてきた気がします。しかし、次のような例を考えてみましょう。

```hs
-- | RedisをKVSとして利用する実装
data RedisImpl = RedisImpl

handleError :: Show a => Either a b -> b
handleError = either (error . show) id

instance DataStore RedisImpl where
  create k v _ = ()          <$  Redis.set k v
  read   k   _ = handleError <$> Redis.get k v
  update k v _ = ()          <$  Redis.set k v
  delete k   _ = ()          <$  Redis.del [k]
```

この例は[hedis](https://hackage.haskell.org/package/hedis)を使ってRedisを利用することを想定しています。ですがこの実装ではコンパイルが通りません。なぜなら`RedisImpl`の`DataStore`のインスタンスは

```hs
class DataStore ds where
  create :: Key -> Value -> ds -> Redis ()
  read   :: Key          -> ds -> Redis (Maybe Value)
  update :: Key -> Value -> ds -> Redis ()
  delete :: Key          -> ds -> Redis ()
```

のような型クラスを期待していますが、実際の返り値を包む型は`Redis`ではなく`IO`だからです。この例のようにDIでは注入する実装によって引き起こす副作用が違うことはよくあることです。例えば本番環境ではAmazon SESを使ってメールを送るから`IO`でだけど、開発環境ではログを吐きたいから`LoggingT`にしたいというケースもあるでしょう。Haskellは副作用を型で表すので、HaskellでのDIは注入する実装によって返り値の型が変えられることが望ましいでしょう。

:first_quarter_moon: Tagless Final
-----------------------------------
ならば型クラスの対象にする型を 引数の型 ではなく 返り値の型 にすればどうでしょうか。

```hs
class Monad repr => DataStoreSYM repr where
  create :: Key -> Value -> repr ()
  read   :: Key          -> repr (Maybe Value)
  update :: Key -> Value -> repr ()
  delete :: Key          -> repr ()
```

この方法は驚くほどうまくいきます。実際`repr`を`ReaderT ds IO`や`Redis`に置き換えれば今まで見てきた例に一致することがわかるでしょう。このような返り値の型を型クラスにするテクニックはTagless Finalとして知られていてEDSLを実現する手法として研究されています[^2]。`DataStoreSYM`は明らかに副作用を起こすことを期待しているので`Monad`の制約も付けて定義しています。`DataStoreSYM`を使って`createOrUpdate`を定義すると以下のようになります。

```hs
createOrUpdate :: DataStoreSYM repr => Key -> Value -> repr ()
createOrUpdate k v = do
  peek <- read k
  case peek of
    Just _  -> update k v
    Nothing -> create k v
```

実装だけ見れば`ReaderT`を使ったものとまったく一致していますね。`DataStoreSYM`のインスタンスも作ってみましょう。

```hs
instance DataStoreSYM IO where
  create k v = BS.putStrLn $ BS.concat ["Create: ", k, ", ", v]
  read   k   = Nothing <$ (BS.putStrLn $ BS.concat ["Read: ", k])
  update k v = BS.putStrLn $ BS.concat ["Update: ", k, ", ", v]
  delete k   = BS.putStrLn $ BS.concat ["Delete: ", k]

runMockDS :: IO a -> IO a
runMockDS = id
```

`DataStoreSYM`の`IO`のインスタンスをモックとして実装しています。これは以下のように実行することができます。

```hs
> runMockDS $ createOrUpdate "key" "value"
Read: key
Create: key, value
```

`runMockDS`は定義だけ見るとただの`id`ですが型をつけることで`DataStoreSYM`のどのインスタンスを使うか決定する役割を果たしています。

今度は`IORef`を使ってKVSとして動作する実装を作ってみましょう。`DataStoreSYM`のメソッドには`IORef`を渡せる引数が無いのでReaderモナドを使って`IORef`を引き回す処理を副作用に押しつけてしまいます。

```hs
type IORefDS = ReaderT (IORef [(Key, Value)]) IO

instance DataStoreSYM IORefDS where
  create k v = ask >>= (\ref -> liftIO $ modifyIORef ref ((k, v):))
  read   k   = ask >>= (\ref -> liftIO $ lookup k <$> readIORef ref)
  update k v = ask >>= (\ref -> liftIO $ modifyIORef ref (updateList k v))
  delete k   = ask >>= (\ref -> liftIO $ modifyIORef ref (deleteList k))

runIORefDS :: IORef [(Key, Value)] -> IORefDS a -> IO a
runIORefDS ref dsl = runReaderT dsl ref
```

```hs
> ref <- newIORef ([] :: [(Key, Value)])
> runIORefDS ref $ createOrUpdate "key" "value"
> readIORef ref
[("key","value")]
```

少し実装が面倒くさい感じは否めないですがなんとかなりました :relieved: 

それでは念願のRedis実装を作ってみましょう。

```hs
instance DataStoreSYM Redis where
  create k v = ()          <$  Redis.set k v
  read   k   = handleError <$> Redis.get k
  update k v = ()          <$  Redis.set k v
  delete k   = ()          <$  Redis.del [k]

runRedis :: Redis.Connection -> Redis a -> IO a
runRedis conn redis = Redis.runRedis conn redis
```

簡単に実装することができました :tada: 

さて、実際にDIを使用したコードを書いていると複数の依存性を注入したくなることがよくあります。例えば外部サービスのAPIからビットコインの時価を取得してデータベースに保存するプログラムを考えてみましょう。データベースに保存するプログラムは`DataStoreSYM`を使って表現できますがビットコインの値段を取得するプログラムは新しく作らなければなりません。まずこれをTagless Finalで書くと

```hs
type Price = Double

class Monad repr => BitcoinSYM repr where
  getPrice :: repr Double
```

のようになるでしょう。欲しかったプログラムは

```hs
saveBTCPrice :: (BitcoinSYM repr, DataStoreSYM repr) => repr ()
saveBTCPrice = do
  price <- getPrice
  createOrUpdate "BTC Price" (BS.pack $ show price)
```

のように書けます。とても簡単に2つのDSLを合成することができました :relaxed: 

`BitcoinSYM`の実装を作っていきましょう。まず`IO`でモック実装を作ります。

```hs
instance BitcoinSYM IO where
  getPrice = putStrLn "Get BTC price" >> pure 1000000.0

runMockBTC :: IO a -> IO a
runMockBTC = id
```

`saveBTCPrice`を`runMockDS`で実行するか`runMockBTC`で実行するか迷いますが、どちらも同じものなのでとりあえず`runMockBTC`で実行してみましょう。

```hs
> runMockBTC saveBTCPrice
Get BTC price
Read: BTC Price
Create: BTC Price, 1000000.0
```

うまく動いてそうですね :thinking: 

今度は実際に外部に通信して値段を取得する実装を見てみましょう。

```hs
type BitFlyer = ReaderT Manager IO

-- | bitFlyerのAPIからビットコインの時価を取得するプログラム
getBitFlyerBitcoinPrice :: Manager -> IO Price
getBitFlyerBitcoinPrice manager = do
  body <- responseBody <$> httpLbs "https://api.bitflyer.jp/v1/ticker" manager
  pure $ (decode body :: Maybe Aeson.Value) ^?! _Just . key "ltp" . _Double

instance BitcoinSYM BitFlyer where
  getPrice = ask >>= (\manager -> liftIO $ getBitFlyerBitcoinPrice manager)

runBitFlyer :: Manager -> BitFlyer a -> IO a
runBitFlyer manager dsl = runReaderT dsl manager
```

APIは株式会社bitFlyerが提供しているものを利用しています[^3]。この実装と`saveBTCPrice`を使っていよいよ外部からビットコインの時価を取得して`IORef`に記録してみましょう。

ところがこれがうまくいかないことはすぐにわかると思います。`runIORefDS`も`runBitFlyer`も`saveBTCPrice`を実行するのには使えません。原因は`IORefDS`も`BitFlyer`もどちらも相手のDSLを実行するために必要な情報を持っていないからです。例えば`runIORefDS`で`saveBTCPrice`を実行しようとすれば、まず`IORefDS`が`BitcoinSYM`のインスタンスではないので怒られるでしょう。それなら`IORefDS`を`BitcoinSYM`のインスタンスにしようと思うかもしれませんが`IORefDS`には`Manager`の情報がないため`runBitFlyer`と同等の実装を作ることができません。

ならば新しく

```hs
type IORefDSAndBitFlyer = ReaderT (IORef [(Key, Value)]) (ReaderT Manager IO)
```

という型を作って

```hs
instance DataStoreSYM IORefDSAndBitFlyer where
  create k v = ask >>= (\ref -> liftIO $ modifyIORef ref ((k, v):))
  ...

instance BitcoinSYM IORefDSAndBitFlyer where
  getPrice = lift ask >>= (\manager -> liftIO $ getBitFlyerBitcoinPrice manager)

runIORefDSAndBitFlyer :: Manager -> IORef [(Key, Value)] -> IORefDSAndBitFlyer a -> IO a
runIORefDSAndBitFlyer manager ref dsl = runReaderT (runReaderT dsl ref) manager
```

のように実装も新しく作るのはどうでしょう。しかしこの作業はDSLを組み合わせるたびに発生してしまうため現実的ではありません :fearful: 

もしかしたら[`mtl`](https://hackage.haskell.org/package/mtl)の型クラス[`MonadReader`](https://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Reader.html#t:MonadReader)を使って以下のように定義するとうまくいくかもしれません :bulb: 

```hs
instance MonadReader (IORef [(Key, Value)]) m => DataStoreSYM m where
  create k v = ask >>= (\ref -> liftIO $ modifyIORef ref ((k, v):))
  ...

instance MonadReader Manager m => BitcoinSYM m where
  getPrice = ask >>= (\manager -> liftIO $ getBitFlyerBitcoinPrice manager)
```

しかし`MonadReader`は定義に

```hs
class Monad m => MonadReader r m | m -> r where
  ...
```

のような関数従属性があるためこれらの実装を組み合わせて使うことができません[^4] :disappointed: 

せっかくDSLを綺麗に合成することができても実装側の副作用をうまく合成することができなければ使い勝手はあまりよくありません。Tagless Finalを使いこなすにはまだ準備が少し足りなかったようです。

:waxing_gibbous_moon: Freeモナド
--------------------------------
そこで一旦Tagless Finalから離れて副作用の合成に注目してみましょう。今度はDSLとしてFreeモナドを使います。

Freeモナドに関する詳しい解説はこの記事では行いませんが、以下の記事がわかりやすいので気になる方は参照してみてください。

* [Why free monads matter](http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html)
* [そろそろFreeモナドに関して一言いっとくか](http://d.hatena.ne.jp/fumiexcel/20121111/1352614885)

以下のコードの実装には[free](https://hackage.haskell.org/package/free)というライブラリを利用します。

さっそくFreeモナドを使って`DataStore`を実装してみましょう。

```hs
data DataStoreF a = Create Key Value (() -> a)
                  | Read   Key       (Maybe Value -> a)
                  | Update Key Value (() -> a)
                  | Delete Key       (() -> a)
                  deriving Functor

type DataStoreT m = FreeT DataStoreF m

create k v = liftF $ Create k v id
read   k   = liftF $ Read   k   id
update k v = liftF $ Update k v id
delete k   = liftF $ Delete k   id
```

DSLを合成することがもう分かっているのではじめからFreeモナド変換子を使っています[^5]。これを使って`createOrUpdate`を実装すると

```hs
createOrUpdate :: Monad m => Key -> Value -> DataStoreT m ()
createOrUpdate k v = do
  peek <- read k
  case peek of
    Just _  -> update k v
    Nothing -> create k v
```

のようになります。
`IORef`による実装を見てみましょう

```hs
runIORefDS :: MonadIO io => IORef [(Key, Value)] -> DataStoreT io a -> io a
runIORefDS ref = iterT interpret
  where
    interpret (Create k v r) = r =<< liftIO (modifyIORef ref ((k, v):))
    interpret (Read   k   r) = r =<< liftIO (lookup k <$> readIORef ref)
    interpret (Update k v r) = r =<< liftIO (modifyIORef ref (updateList k v))
    interpret (Delete k   r) = r =<< liftIO (modifyIORef ref (deleteList k))
```

後続の処理を意識しながら逐一翻訳するように実装を書けばインタプリタが出来上がっているのがわかると思います。これは次のように実行することができます。

```hs
> ref <- newIORef ([] :: [(Key, Value)])
> runIORefDS ref (createOrUpdate "key" "value")
> readIORef ref
[("key","value")]
```

実行に必要な`IORef`をインタプリタに直接渡すことができるのでReaderモナドを使わずに`DataStoreT`を実行する関数を簡単に書くことができました。
次にビットコインの値を取得するDSLを実装してみましょう。

```hs
data BitcoinF a = GetPrice (Price -> a) deriving Functor

type BitcoinT m = FreeT BitcoinF m

getPrice = liftF $ GetPrice id

runBitFlyer :: MonadIO io => Manager -> BitcoinT io a -> io a
runBitFlyer manager = iterT interpret
  where
    interpret (GetPrice r) = r =<< (liftIO $ getBitFlyerBitcoinPrice manager)
```

これらを合成して今度こそビットコインの値段を取得して記録するプログラムを作ってみましょう。

```hs
saveBTCPrice :: DataStoreT (BitcoinT IO) ()
saveBTCPrice = do
  price <- lift $ getPrice
  createOrUpdate "BTC Price" (BS.pack $ show price)
```

モナド変換子を使って2つのDSLを合成しているのが型からわかると思います。実行するときも新しい何かを定義する必要はありません。

```hs
> manager <- newManager tlsManagerSettings
> ref     <- newIORef ([] :: [(Key, Value)])
> runBitFlyer manager . runIORefDS ref $ saveBTCPrice
> readIORef ref
[("BTC Price","1235755.0")]
```

かなり理想のDIに近づいてきた気がしますね :muscle: 

しかしモナドのスタック順に応じて`lift`をつけたり付けなかったりするのはやっぱり手間ですよね。


:full_moon: Extensible Effects
-------------------------------
Extensible Effectsは[Data types à la carte](http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.101.4131)のようにCoproductとInjectを用いてモナドを合成する方法の延長線上にある手法で、モナド変換子のように順序を気にすることなくモナドを合成することができます[^6]。

Extensible Effectsについても詳しい解説はこの記事では行いませんが、以下の記事がわかりやすいので気になる方は参照してみてください。

* [Freer Monads, More Extensible Effects](https://www.slideshare.net/konn/freer-monads-more-extensible-effects-59411772)
* [Freer Effectsが、だいたいわかった: 0. 導入](https://qiita.com/YoshikuniJujo/items/c71644b5af1f5195cbf3) - 全16章予定

以下のコードの実装には[freer-effects](https://hackage.haskell.org/package/freer-effects)というライブラリを利用します。

さっそくEffモナドを使って`DataStore`を実装してみましょう。

```hs
data DataStore a where
  Create :: Key -> Value -> DataStore ()
  Read   :: Key          -> DataStore (Maybe Value)
  Update :: Key -> Value -> DataStore ()
  Delete :: Key          -> DataStore ()

create k v = send $ Create k v
read   k   = send $ Read   k
update k v = send $ Update k v
delete k v = send $ Delete k
```

`createOrUpdate`の実装は以下のようになります。

```hs
createOrUpdate :: Member DataStore effs => Key -> Value -> Eff effs ()
createOrUpdate k v = do
  peek <- read k
  case peek of
    Just _  -> update k v
    Nothing -> create k v
```

`IORef`を使った実装を作ってみましょう。

```hs
runIORefDS :: Member IO effs => IORef [(Key, Value)] -> Eff (DataStore ': effs) a -> Eff effs a
runIORefDS ref = runNat @IO interpret
  where
    interpret :: forall a. DataStore a -> IO a
    interpret (Create k v) = modifyIORef ref ((k, v):)
    interpret (Read   k)   = lookup k <$> readIORef ref
    interpret (Update k v) = modifyIORef ref (updateList k v)
    interpret (Delete k)   = modifyIORef ref (deleteList k)
```

Freeモナドでの実装と比べると後続の処理すら意識せずに単純な変換を書くだけで済むので簡単です。


```hs
> ref <- newIORef ([] :: [(Key, Value)])
> runM . runIORefDS ref $ createOrUpdate "key" "value"
> readIORef ref
[("key","value")]
```

うまく動いていますね。
次に`Bitcoin`も実装してみましょう。

```hs
data Bitcoin a where
  GetPrice :: Bitcoin Price

getPrice :: Member Bitcoin effs => Eff effs Price
getPrice = send GetPrice

runBitFlyer :: Member IO effs => Manager -> Eff (Bitcoin ': effs) a -> Eff effs a
runBitFlyer manager = runNat @IO interpret
  where
    interpret :: forall a. Bitcoin a -> IO a
    interpret GetPrice = getBitFlyerBitcoinPrice manager
```

これらを組み合わせて`saveBTCPrice`を作ってみましょう。

```hs
saveBTCPrice :: (Member BitFlyer effs, Member DataStore effs) => Eff effs ()
saveBTCPrice = do
  price <- getPrice
  createOrUpdate "BTC Price" (BS.pack $ show price)
```

Tagless Finalの時と同じようにDSLが型の制約として現れていますね。`lift`みたいに順番を意識させる関数なども特に使うことなくそのまま合成できています :clap: 

```hs
> ref     <- newIORef ([] :: [(Key, Value)])
> manager <- newManager tlsManagerSettings
> runM . runBitFlyer manager . runIORefDS ref $ saveBTCPrice
> readIORef ref
[("BTC Price","1234662.0")]
```

動作も期待通りですね :muscle: 

これまでの議論からExtensible Effectsを使えば

* 実装によって返り値の型を変えられる
* 余計なコストを払うことなく2つのDSLが合成できる

というDIに求められる機能が実現できることが分かりました。どうやら実用的なアプリケーションを書いていてDIが必要になった時はExtensible Effectsを使うのが一番良さそうです。

:waning_gibbous_moon: Tagless Final再訪
----------------------------------------
ところでExtensible Effectsの導入によってモナドの合成が`lift`と関数従属性から解き放たれたことによりTagless Finalがまた使えるようになりました。Tagless Finalをフロントエンドとして使い、Extensible Effectsをバックエンドとして使うことで、高いDSLの表現力と柔軟な副作用の合成を同時に実現することができます[^7]。

まずDSLの定義は普通のTagless Finalの時と同じです。

```hs
class Monad repr => DataStoreSYM repr where
  create :: Key -> Value -> repr ()
  read   :: Key          -> repr (Maybe Value)
  update :: Key -> Value -> repr ()
  delete :: Key          -> repr ()

class Monad repr => BitcoinSYM repr where
  getPrice :: repr Price
```

普通のTagless Finalと同様にこれらを組み合わせることができます。

```hs
saveBTCPrice :: (BitcoinSYM repr, DataStoreSYM repr) => repr ()
saveBTCPrice = do
  price <- getPrice
  createOrUpdate "BTC Price" (BS.pack $ show price)
```

次に実装を見てみましょう。

```hs
data IORefDS = IORefDS { getIORefDS :: IORef [(Key, Value)] }

instance (Member (Reader IORefDS) effs, Member IO effs) => DataStoreSYM (Eff effs) where
  create k v = asks getIORefDS >>= (\ref -> send $ modifyIORef ref ((k, v):))
  read   k   = asks getIORefDS >>= (\ref -> send $ lookup k <$> readIORef ref)
  update k v = asks getIORefDS >>= (\ref -> send $ modifyIORef ref (updateList k v))
  delete k   = asks getIORefDS >>= (\ref -> send $ modifyIORef ref (deleteList k))
```

```hs
data BitFlyer = BitFlyer { getBitFlyer ::  Manager }

instance (Member (Reader BitFlyer) effs, Member IO effs) => BitcoinSYM (Eff effs) where
  getPrice = asks getBitFlyer >>= (\manager -> send $ getBitFlyerBitcoinPrice manager)
```

Freerモナドを使うとハンドラを自由に作れて便利なのですが今回はDSLを2回書いてしまうのが手間なので既に用意されているReaderモナドを使って実装しました。では実行してみましょう。

```hs
> ref      <- newIORef ([] :: [(Key, Value)])
> manager  <- newManager tlsManagerSettings
> ds       =  IORefDS ref
> bitflyer =  BitFlyer manager
> runM $ runReader (runReader saveBTCPrice ds) bitflyer
> readIORef ref
[("BTC Price","1286700.0")]
```

期待通りの動作をしていますね :clap: 

Tagless Finalで実装することのメリットは[Higher-order abstract syntax(HOAS)](https://en.wikipedia.org/wiki/Higher-order_abstract_syntax)が利用できることだと思います[^8]。例えばTagless Finalを使った線形ラムダ計算の実装[^9]と組み合わせて、リソース管理の方法も提供するプログラムのDIを実現したりできるかもしれません。

:books: 参考文献
----------------
[^1]: [5 Ways to Test Applications that Access a Database in Haskell](https://functor.tokyo/blog/2015-11-20-testing-db-access)
[^2]: [Typed final (tagless-final) style](http://okmij.org/ftp/tagless-final/index.html)
[^3]: [bitFlyer Lightning - API Document](https://lightning.bitflyer.jp/docs?lang=ja)
[^4]: [If you’re using lift, you’re doing it wrong (probably)](http://blog.ezyang.com/2013/09/if-youre-using-lift-youre-doing-it-wrong-probably/)
[^5]: [Free monad transformers - Haskell for all](http://www.haskellforall.com/2012/07/free-monad-transformers.html)
[^6]: [Extensible Effects: an alternative to Monad Transformers](http://okmij.org/ftp/Haskell/extensible/)
[^7]: [Free and tagless compared - how not to commit to a monad too early](https://softwaremill.com/free-tagless-compared-how-not-to-commit-to-monad-too-early/)
[^8]: [FreeモナドとTagless FinalによるDependency InjectionのためのDSL](https://qiita.com/yyu/items/377513f17fec536b562e#higher-order-abstract-syntax)
[^9]: [Typed Tagless-Final Linear Lambda Calculus](https://www.schoolofhaskell.com/user/mutjida/typed-tagless-final-linear-lambda-calculus)
[^10]: [HaskellでDIする - The curse of λ](https://myuon.github.io/posts/haskell-di/)