Zenn
😋

[PureScript] Tagless Finalのテスト 3種盛り

2023/06/18に公開
PureScript
単体テスト
Test
モナド
tech

はじめに

最近、私はTagless Finalを使って書かれたコードのテストについて色々と考えておりました。
そこで、考えた中から3つのアプローチを紹介したいと思います。

目次を見ていただくと、大体どんなアプローチなのかわかるかと思います。

テストでやりたいこと

当たり前のことを書きますが、最低限下記を満たしたいです。

  1. 関数の実行結果が期待値と合っていることの確認
  2. Unitを返すような関数（例えば出力や保存など）の場合、その関数が期待する引数で呼び出されたかの確認

テスト対象

テスト対象としては次を対象とします。
型クラス2つと、それぞれの型クラスを利用した関数が1つだけ定義してあります。

テスト対象
type User = { id :: String, name :: String, optionId :: String }

type UserOption = { optionId :: String, isTrial :: Boolean }

-- ユーザー情報のリポジトリ
class UserRepository m where
  findUserById :: String -> m User
  findOptionById :: String -> m UserOption

-- ユーザーIDに紐づくユーザーのオプションを返す関数
findUserOptionByUserId :: forall m. Monad m => UserRepository m => String -> m UserOption
findUserOptionByUserId userId = do
  user <- findUserById userId  -- ユーザーIDをもとにユーザーを取得
  findOptionById user.optionId -- オプションIDをもとにオプションを取得

-- 何かを表示するプレゼンター
class Presenter m where
  display :: String -> m Unit

-- ユーザーオプションを受け取り、ユーザーがトライアルユーザーかどうかを出力する関数
displayTrialStatus :: forall m. Monad m => Presenter m => UserOption -> m Unit
displayTrialStatus option = display $ "This User is " <> if option.isTrial then "Trial Account." else "Premium Account."

UserRepositoryは主にユーザー情報を取得する型クラスで、Presenterは何かを表示する型クラスです。
関数findUserOptionByUserIdはユーザーオプションを取得する関数ですが、直接ユーザーオプションを取得するのではなく、まずユーザー情報を取得し、ユーザー情報が持っているオプションのIDをもとにユーザーオプションを取得します。

関数displayTrialStatusは、ユーザーオプションのisTrialの値によってdisplay関数を呼び出す際の引数を変えているだけです。

テストで何を確認したいか

findUserOptionByUserIdのテストで確認したいこと

関数findUserOptionByUserIdはユーザーオプションを取得する関数なので、この関数の実行結果が期待通りの値なのかを確認したいです。
findUserOptionByUserIdの入力となったユーザーIDと、findUserByIdの入力が一致していることも確認したいですし、findUserByIdで取得したユーザー情報のoptionIdとfindOptionByIdの入力が一致しているということも確認したいです。

displayTrialStatusのテストで確認したいこと

関数displayTrialStatusは内部でdisplay関数を呼び出しますが、その際の引数は、与えられたユーザーオプションのisTrialの値によって、変わってきます。
isTrialはBoolean型の値なので、パターンとしては2パターンが考えられます。
それぞれのパターンについて、display関数が期待する引数で呼び出されたかを確認したいです。

3種のアプローチでテストを書く

アプローチその1.「自前で手軽に」

このアプローチは、自前でかつお手軽にやるアプローチです。
テスト用のモックライブラリなどを使用しない場合、大体こんな感じになるのではないかというアプローチです。
テストに便利な関数などは自前で用意します。

findUserOptionByUserIdのテスト

ざっとテストコードを載せます。私はこんな風にテストを書きました。

test
newtype UserRepositoryAff a = UserRepositoryAff (Aff a)
derive newtype instance functorUserRepositoryAff :: Functor UserRepositoryAff
derive newtype instance applyUserRepositoryAff :: Apply UserRepositoryAff
derive newtype instance applicativeUserRepositoryAff :: Applicative UserRepositoryAff
derive newtype instance bindUserRepositoryAff :: Bind UserRepositoryAff
derive newtype instance monadUserRepositoryAff :: Monad UserRepositoryAff

instance userRepositoryForSpec :: UserRepository UserRepositoryAff where
  findUserById id = do
    assert "userId" id
    (UserRepositoryAff $ pure {id: id, name: "userName", optionId: "optionId"})

  findOptionById id = do
    assert "optionId" id
    UserRepositoryAff $ pure {optionId: id, isTrial: true}

runRepository :: forall a. UserRepositoryAff a -> Aff a
runRepository (UserRepositoryAff a) = a

assert :: forall a m. Monad m => Show a => Eq a => a -> a -> m Unit
assert expected actual =
  if expected /= actual then
    unsafePerformEffect $ throw ("expected: " <> show expected <> ", but was: " <> show actual)
  else
    pure unit

spec :: Spec Unit
spec = do
  describe "Tagless Final Spec" do
    it "UserIdをもとにUserOptionを取得することができる" do
      option <- run $ findUserOptionByUserId "userId"
      option `shouldEqual` {optionId: "optionId", isTrial: true}

findUserOptionByUserIdのテストの解説

型クラスUserRepositoryのインスタンスとしてAffを使いたいのですが、それだとOrphan instanceになってしまう(UserRepository・Aff・それらを使うテストがそれぞれ別々のモジュールに定義されているため）ので、仕方なくAffをラップするだけの型UserRepositoryAffを用意しています。
また、制約により型はモナドである必要があるため、諸々derive instanceしています。

そしてUserRepositoryAffからAffを取り出すだけの関数runも用意してあります。

インスタンスの定義では、期待値を固定値として返すようにしています。

固定値を返しているところ
UserRepositoryAff $ pure {optionId: id, isTrial: true}

この固定値をshouldEqualで確認しています。

確認しているところ
option `shouldEqual` {optionId: "optionId", isTrial: true}

また、それぞれの関数の入力を確認する便利関数としてassertを用意しています。

assert(自前)
assert :: forall a m. Monad m => Show a => Eq a => a -> a -> m Unit
assert expected actual =
  if expected /= actual then
    unsafePerformEffect $ throw ("expected: " <> show expected <> ", but was: " <> show actual)
  else
    pure unit

固定値を返す前にこの関数を呼び出すことで、期待しない入力が渡された場合にテストが落ちるようになります。

assertを通り抜けたら固定値を返す
  findUserById id = do
    assert "userId" id -- idが"userId"でなかったらテストが落ちる
    (UserRepositoryAff $ pure {id: id, name: "userName", optionId: "optionId"})

例えばfindUserOptionByUserIdに`UserI"という期待していない値を与えてみるとこんな感じで失敗します。

Error: expected: "userId", but was: "userI"

こんな感じで、やりたいことはまぁ実現できていますが、固定値を返す処理やassertionなどが、インスタンス側に埋め込まれており、テストを実行する側から制御できません。
テストパターンが増えた場合、そのパターンに対応するのはインスタンス側になるでしょう（インスタンス側の処理の中で引数に応じて返す値を変えるとか）。あるいはパターンごとに別のインスタンスを作るとか。あまりそういうことはやりたくないものです。
ただ、場合によってはこれで十分とも言えます。
今回の場合はそうでしょう。

displayTrialStatusのテスト

続いてdisplayTrialStatusの方のテストにいきましょう。
テストコードはこんな感じにしました。

type DisplayState = {message :: String}
newtype PresenterAff a = PresenterAff (StateT DisplayState Aff a)
derive newtype instance functorPresenterAff :: Functor PresenterAff
derive newtype instance applyPresenterAff :: Apply PresenterAff
derive newtype instance applicativePresenterAff :: Applicative PresenterAff
derive newtype instance bindPresenterAff :: Bind PresenterAff
derive newtype instance monadPresenterAff :: Monad PresenterAff

instance presenterForSpec :: Presenter PresenterAff where
  display message = PresenterAff do
    modify_ \_ -> { message: message }
    pure unit

runPresenter :: forall a. DisplayState -> PresenterAff a -> Aff (Tuple a DisplayState)
runPresenter s (PresenterAff m) = runStateT m s

spec :: Spec Unit
spec = do
  describe "Tagless Final Spec" do
    describe "Presenterのテスト" do
      it "トライアルユーザーかどうかを出力する - トライアルユーザーの場合" do
        result <- displayTrialStatus {optionId: "optionId", isTrial: true} 
          # runPresenter {message: ""}
        (snd result).message `shouldEqual` "This User is Trial Account."

      it "トライアルユーザーかどうかを出力する - トライアルユーザでない場合" do
        result <- displayTrialStatus {optionId: "optionId", isTrial: false} 
          # runPresenter {message: ""}
        (snd result).message `shouldEqual` "This User is Premium Account."

displayTrialStatusのテストの解説

ユーザーオプションのisTrialの値によって、displayの入力が変わるので、そこの確認をしたい※のですが、その確認のためにStateTモナドを利用しています。
(※isTrialがtrueなら"This User is Trial Account."、falseなら"This User is Premium Account."になることを確認したい）

type DisplayState = {message :: String}
newtype PresenterAff a = PresenterAff (StateT DisplayState Aff a)

display関数が呼ばれたらDisplayStateを書き換えておき、テスト対象の関数の実行後、その値を参照して確認に使おうというわけです。

instance presenterForSpec :: Presenter PresenterAff where
  display message = PresenterAff do
    modify_ \_ -> { message: message } -- ここでstateを書き換える
    pure unit

こんな感じで確認しています。結果のDisplayStateはTupleで返ってくるので、値を取り出してshouldEqualで期待値と一致しているか確認しています。

result <- displayTrialStatus {optionId: "optionId", isTrial: true} 
  # runPresenter {message: ""}
(snd result).message `shouldEqual` "This User is Trial Account."

今回はStateTを使いましたが、読み込みはしないのでWriterTでもよかったかもしれません。

アプローチその2. 「モナド変換子とモックで立ち向かう」

アプローチその1でも一部取り入れていたモナド変換子をガッツリ使います。

具体的にはReaderTを使います。
このReaderTでモック関数を読み取れるようにしておき、インスタンスの実装ではaskで取り出したモック関数に処理を委譲させます。

これがこのアプローチの骨子です。

モック関数は自前で作ってもよいのですが、今回は以前作ったpmockというモックライブラリを使います。

これは具体的なコードを見た方がわかりやすいでしょう。

findUserOptionByUserIdのテスト

まずは全体像から

type UserRepositoryFunctions = {
  findUserById :: String -> User,
  findOptionById :: String -> UserOption
}

newtype UserRepositoryMockT a = UserRepositoryMockT (ReaderT UserRepositoryFunctions Aff a)
derive newtype instance functorUserRepositoryMockT :: Functor UserRepositoryMockT
derive newtype instance applyUserRepositoryMockT :: Apply UserRepositoryMockT
derive newtype instance applicativeUserRepositoryMockT :: Applicative UserRepositoryMockT
derive newtype instance bindUserRepositoryMockT :: Bind UserRepositoryMockT
derive newtype instance monadUserRepositoryMockT :: Monad UserRepositoryMockT

instance userRepositoryMockT :: UserRepository UserRepositoryMockT where
  findUserById userId = UserRepositoryMockT do
    f <- ask
    pure $ f.findUserById userId
  findOptionById optionId = UserRepositoryMockT do
    f <- ask
    pure $ f.findOptionById optionId

runRepository :: UserRepositoryFunctions -> UserRepositoryMockT ~> Aff
runRepository f (UserRepositoryMockT m) = runReaderT m f

-- テスト本体
spec :: Spec Unit
spec = do
  describe "Tagless Final With Monad Transformer Spec" do
    describe "UserRepositryのテスト" do
      it "指定したIDのユーザーのオプションを取得することができる" do
        let
          functions = {
            findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
            findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: true}
          }
        option <- findUserOptionByUserId "userId"
                  # runRepository functions 
        option `shouldEqual` {optionId: "optionId", isTrial: true}

findUserOptionByUserIdのテストの解説

この節の冒頭で伝えた通り、ReaderTを使っています。
面倒ですがOrphan Instanceを避けるため新しいラッパー型UserRepositoryPresenterMockTを用意しています。
この型は関数を集めたレコードをReaderTで読み取れるようにしています。このレコードにはモック関数を設定します。
モナドはテスト的に都合がよかったAffにしています。

モナド変換子の部分
type UserRepositoryFunctions = {
  findUserById :: String -> User,
  findOptionById :: String -> UserOption
}

newtype UserRepositoryMockT a = UserRepositoryMockT (ReaderT UserRepositoryFunctions Aff a)

インスタンスの定義では、askでモック関数を取り出して処理を委譲しています。

instance
instance userRepositoryMockT :: UserRepository UserRepositoryMockT where
  findUserById userId = UserRepositoryMockT do
    f <- ask
    pure $ f.findUserById userId
  findOptionById optionId = UserRepositoryMockT do
    f <- ask
    pure $ f.findOptionById optionId

テストはこうです。
モック関数を用意して、実行時に渡しています。
ちなみにそれぞれの関数に期待しない入力が与えられたらテストは失敗します。

test
it "指定したIDのユーザーのオプションを取得することができる" do
  let
    functions = {
      findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
      findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: true}
    }
  option <- findUserOptionByUserId "userId"
            # runRepository functions 
  option `shouldEqual` {optionId: "optionId", isTrial: true}

最初のアプローチと比べると、テストケースの方で途中呼ばれる関数の入力値や、期待値などのコントロールができるようになっていると思います。

displayTrialStatusのテスト

全体像です。

type DisplayFunctions = {
  display :: String -> Unit
}

newtype PresenterMockT a = PresenterMockT (ReaderT DisplayFunctions Aff a)
derive newtype instance functorPresenterMockT :: Functor PresenterMockT
derive newtype instance applyPresenterMockT :: Apply PresenterMockT
derive newtype instance applicativePresenterMockT :: Applicative PresenterMockT
derive newtype instance bindPresenterMockT :: Bind PresenterMockT
derive newtype instance monadPresenterMockT :: Monad PresenterMockT

instance presenterMockT :: Presenter PresenterMockT where
  display message = PresenterMockT do
    f <- ask
    pure $ f.display message

runPresenter :: DisplayFunctions -> PresenterMockT ~> Aff
runPresenter f (PresenterMockT m) = runReaderT m f

spec :: Spec Unit
spec = do
  describe "Tagless Final With Monad Transformer Spec" do   
    describe "Presenterのテスト" do
      it "トライアルユーザーかどうかを出力する - トライアルユーザーの場合" do
        let
          displayMock = mock $ any :> unit
        displayTrialStatus {optionId: "optionId", isTrial: true} 
          # runPresenter { display: fun displayMock } 
        verify displayMock "This User is Trial Account."

      it "トライアルユーザーかどうかを出力する - トライアルユーザでない場合" do
        let
          displayMock = mock $ any :> unit
        displayTrialStatus {optionId: "optionId", isTrial: false}
          # runPresenter { display: fun displayMock } 
        verify displayMock "This User is Premium Account."

displayTrialStatusのテストの解説

こちらもReaderTを使っているのは同じです。

type DisplayFunctions = {
  display :: String -> Unit
}

newtype PresenterMockT a = PresenterMockT (ReaderT DisplayFunctions Aff a)

インスタンスの定義も同様で、モック関数に処理を委譲しています。

instance presenterMockT :: Presenter PresenterMockT where
  display message = PresenterMockT do
    f <- ask
    pure $ f.display message

こちらのテストの場合、実行した結果はUnitなので、実行結果の値を確認するのではなく、
verify関数を使って、期待する値でモック関数が呼び出されたかどうかを検証しています。
このテストの場合は上記の通りdisplay関数がモック関数に委譲されており、その関数の引数を検証しています。

spec :: Spec Unit
spec = do
  describe "Tagless Final With Monad Transformer Spec" do   
    describe "Presenterのテスト" do
      it "トライアルユーザーかどうかを出力する - トライアルユーザーの場合" do
        let
          displayMock = mock $ any :> unit
        displayTrialStatus {optionId: "optionId", isTrial: true} 
          # runPresenter { display: fun displayMock } 
        verify displayMock "This User is Trial Account."

      it "トライアルユーザーかどうかを出力する - トライアルユーザでない場合" do
        let
          displayMock = mock $ any :> unit
        displayTrialStatus {optionId: "optionId", isTrial: false}
          # runPresenter { display: fun displayMock } 
        verify displayMock "This User is Premium Account."

こちらの場合は、アプローチその1と「呼び出したときの値をとっておいて後で検証に使う」という意味で似たようなノリになっています。

アプローチその3. 「モナド作るの面倒なんでFreeモナド使います」

これまでのアプローチは、Orphan Instanceの問題を避けるために新しい型を作っていたので、必然型をモナドにするためderive instanceしまくりという状況でした。
ならば、いっそ簡単に作れるFreeモナドを作ってインスタンスにしてしまおうというアプローチです。
そんなら最初からFreeモナドでいいんじゃね？と言い出すとこの話は終わってしまうので、先を続けます。

findUserOptionByUserIdのテスト

Freeモナドを作る

まずこんな感じでFreeモナドを作って、UserRepositoryのインスタンスにします。

Freeモナドをインスタンスにする
data UserRepositoryF a
  = FindUserById String (User -> a)
  | FindOptionById String (UserOption -> a)

derive instance functorUserRepositoryF :: Functor UserRepositoryF

type FreeUserRepository = Free UserRepositoryF

instance userRepositoryFree :: UserRepository FreeUserRepository where
  findUserById userId = liftF $ FindUserById userId identity
  findOptionById optionId = liftF $ FindOptionById optionId identity

テスト本体

テストコードの全体はこんな感じです。

test
type UserRepositoryFunctions = {
  findUserById :: String -> User,
  findOptionById :: String -> UserOption
}

runRepository :: UserRepositoryFunctions -> FreeUserRepository ~> Aff
runRepository f m = foldFree (interpretUserRepository f) m

interpretUserRepository ::  UserRepositoryFunctions -> UserRepositoryF ~> Aff
interpretUserRepository f (FindUserById id next) = pure $ next $ f.findUserById id
interpretUserRepository f (FindOptionById id next) = pure $ next $ f.findOptionById id

spec :: Spec Unit
spec = do
  describe "Tagless Final With Free Spec" do
    describe "UserRepositryのテスト" do
      it "指定したIDのユーザーのオプションを取得することができる" do
        -- モック関数の用意
        let
          mockFunctions = {
            findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
            findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: true}
          }
	
	-- 実行
        option <- findUserOptionByUserId "userId"
                  # runRepository mockFunctions 
	
	-- 確認
        option `shouldEqual` {optionId: "optionId", isTrial: true}

findUserOptionByUserIdのテストの解説

モナド変換子を使った場合、入力の期待値や返したい値などをテスト側からコントロールできましたが、Freeモナドを用いた場合も、データ型に対しての実装の部分で外側からコントロールできます。

UserRepositoryFunctionsは差し込むモック関数をまとめたものです。
interpretUserRepositoryでは、処理をモック関数に委譲しています。
ちなみにrunRepositoryはinterpretUserRepositoryを使ってFreeモナドを実行してるだけです。

-- モック関数をまとめたもの
type UserRepositoryFunctions = {
  findUserById :: String -> User,
  findOptionById :: String -> UserOption
}

-- Freeモナドを実行するやつ
runRepository :: UserRepositoryFunctions -> FreeUserRepository ~> Aff
runRepository f m = foldFree (interpretUserRepository f) m

-- 処理はモック関数に委譲する
interpretUserRepository ::  UserRepositoryFunctions -> UserRepositoryF ~> Aff
interpretUserRepository f (FindUserById id next) = pure $ next $ f.findUserById id
interpretUserRepository f (FindOptionById id next) = pure $ next $ f.findOptionById id

テスト本体ではmockFunでモック関数を生成しています。
テスト本体のコードはモナド変換子を使ったアプローチとまるで変わりませんね。

spec :: Spec Unit
spec = do
  describe "Tagless Final With Free Spec" do
    describe "UserRepositryのテスト" do
      it "指定したIDのユーザーのオプションを取得することができる" do
        -- モック関数の用意
        let
          mockFunctions = {
            findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
            findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: true}
          }
	
	-- 実行
        option <- findUserOptionByUserId "userId"
                  # runRepository mockFunctions 
	
	-- 確認
        option `shouldEqual` {optionId: "optionId", isTrial: true}

displayTrialStatusのテスト

Freeモナドを作る

Freeモナドをインスタンスにする
class Presenter m where
  display :: String -> m Unit

displayTrialStatus :: forall m. Monad m => Presenter m => UserOption -> m Unit
displayTrialStatus option = display $ "This User is " <> if option.isTrial then "Trial Account." else "Premium Account."

data PresenterF a = Display String a
derive instance functorPresenterF :: Functor PresenterF
type FreePresenter = Free PresenterF

instance presenterFree :: Presenter FreePresenter where
  display message = liftF $ Display message unit

Freeモナドの使い方などはさきほどと同じなので、特段説明は不要だと思います。

テスト本体

こちらも先にテストコードの全体を載せます。

type DisplayFunctions = {
  display :: String -> Effect Unit
}

runPresenter :: DisplayFunctions -> FreePresenter ~> Aff
runPresenter f m = foldFree (interpretPresenter f) m

interpretPresenter :: DisplayFunctions -> PresenterF ~> Aff
interpretPresenter f (Display message a) = liftEffect $ f.display message >>= \_ -> pure a

spec :: Spec Unit
spec = do
  describe "Tagless Final With Free Spec" do
    describe "Presenterのテスト" do
      it "トライアルユーザーかどうかを出力する - トライアルユーザーの場合" do
        let
          displayMock = mock $ any :> (pure unit :: Effect Unit)
        displayTrialStatus {optionId: "optionId", isTrial: true} 
          # runPresenter { display: fun displayMock } 
        verify displayMock "This User is Trial Account."

      it "トライアルユーザーかどうかを出力する - トライアルユーザでない場合" do
        let
          displayMock = mock $ any :> (pure unit :: Effect Unit)
        displayTrialStatus {optionId: "optionId", isTrial: false}
          # runPresenter { display: fun displayMock } 
        verify displayMock "This User is Premium Account."

displayTrialStatusの解説

findUserOptionByUserIdの場合とアプローチはまったく同じです。
モック関数を差し込めるようにして処理を委譲、テストコード側からテストパターンごとのモック関数を差し込みます。

-- モック関数(関数は一つなのでレコードである必要はないかもしれない)
type DisplayFunctions = {
  display :: String -> Effect Unit
}

-- Freeモナドの実行
runPresenter :: DisplayFunctions -> FreePresenter ~> Aff
runPresenter f m = foldFree (interpretPresenter f) m

-- display関数の処理をモック関数に委譲
interpretPresenter :: DisplayFunctions -> PresenterF ~> Aff
interpretPresenter f (Display message a) = liftEffect $ f.display message >>= \_ -> pure a

テスト部分はこうです。

spec :: Spec Unit
spec = do
  describe "Tagless Final With Free Spec" do
    describe "Presenterのテスト" do
      it "トライアルユーザーかどうかを出力する - トライアルユーザーの場合" do
        -- モック関数の用意(verifyでしっかり確認するので引数はanyでよい)
        let
          displayMock = mock $ any :> (pure unit :: Effect Unit)

        -- 実行
        displayTrialStatus {optionId: "optionId", isTrial: true} 
          # runPresenter { display: fun displayMock } 

        -- 検証
        verify displayMock "This User is Trial Account."

      it "トライアルユーザーかどうかを出力する - トライアルユーザでない場合" do
        -- モック関数の用意(verifyでしっかり確認するので引数はanyでよい)
        let
          displayMock = mock $ any :> (pure unit :: Effect Unit)

        -- 実行
        displayTrialStatus {optionId: "optionId", isTrial: false}
          # runPresenter { display: fun displayMock } 

        -- 検証
        verify displayMock "This User is Premium Account."

こちらの場合もテスト本体の方はアプローチその2とほとんど変わらないですね。

2つのTagless Finalを合成した場合のテスト

よくあるように2つのTagless Finalを合成した場合、テストはどうなるでしょうか？
アプローチその1はだるすぎるので、アプローチその2と3のパターンでテストを書いてみたいと思います。

テスト対象の関数

テスト対象にするのはこのような関数です。
これまで見てきた2つのTagless Finalが同時に使われています。

findUserWithDisplayTrialStatus :: forall m. Monad m => UserRepository m => Presenter m => String -> m Unit
findUserWithDisplayTrialStatus userId = do
  option <- findUserOptionByUserId userId
  displayTrialStatus option

アプローチその2の場合

type UserRepositoryPresenterFunctions = {
  findUserById :: String -> User,
  findOptionById :: String -> UserOption,
  display :: String -> Unit
}
newtype UserRepositoryPresenterMockT a = UserRepositoryPresenterMockT (ReaderT UserRepositoryPresenterFunctions Aff a)

derive newtype instance functorUserRepositoryPresenterMockT :: Functor UserRepositoryPresenterMockT
derive newtype instance applyUserRepositoryPresenterMockT :: Apply UserRepositoryPresenterMockT
derive newtype instance applicativeUserRepositoryPresenterMockT :: Applicative UserRepositoryPresenterMockT
derive newtype instance bindUserRepositoryPresenterMockT :: Bind UserRepositoryPresenterMockT
derive newtype instance monadUserRepositoryPresenterMockT :: Monad UserRepositoryPresenterMockT

instance userRepositoryUserRepositoryPresenterMockT :: UserRepository UserRepositoryPresenterMockT where
  findUserById userId = UserRepositoryPresenterMockT do
    f <- ask
    pure $ f.findUserById userId
  findOptionById optionId = UserRepositoryPresenterMockT do
    f <- ask
    pure $ f.findOptionById optionId

instance presenterUserRepositoryPresenterMockT :: Presenter UserRepositoryPresenterMockT where
  display message = UserRepositoryPresenterMockT do
    f <- ask
    pure $ f.display message

runComposeFunctions :: UserRepositoryPresenterFunctions -> UserRepositoryPresenterMockT ~> Aff
runComposeFunctions f (UserRepositoryPresenterMockT m) = runReaderT m f

spec :: Spec Unit
spec = do
  describe "Tagless Final With Monad Transformer Spec" do
    describe "UserRepository + Presenterのテスト" do
      it "指定したIDのユーザーが、トライアルユーザーかどうかを出力する - トライアルユーザーの場合" do
        let
          displayMock = mock $ any :> unit
          functions = {
            findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
            findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: true},
            display: fun displayMock
          }
        findUserWithDisplayTrialStatus "userId" 
          # runComposeFunctions functions
        verify displayMock "This User is Trial Account."

      it "指定したIDのユーザーが、トライアルユーザーかどうかを出力する - トライアルユーザでない場合" do
        let
          displayMock = mock $ any :> unit
          functions = {
            findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
            findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: false},
            display: fun displayMock
          }
        findUserWithDisplayTrialStatus "userId" 
          # runComposeFunctions functions
        verify displayMock "This User is Premium Account."

必要なすべての関数をまとめたUserRepositoryPresenterFunctionsを用意して、これまでとは別の型を作っています。
もちろんderive instanceも必要です。
新しく作った型に対して、インスタンス定義は当然2つ必要になります。
ここまで用意できれば、これまでと対して変わらずテストを実現できます。

アプローチその3の場合

type UserRepositoryPresenterF = Coproduct UserRepositoryF PresenterF
type FreeUserRepositoryPresenter = Free UserRepositoryPresenterF

instance dataStoreCompose :: UserRepository FreeUserRepositoryPresenter where
  findUserById id = liftF <<< inj $ FindUserById id identity
  findOptionById id = liftF <<< inj $ FindOptionById id identity

instance keyFinderCompose :: Presenter FreeUserRepositoryPresenter where
  display msg = liftF <<< inj $ Display msg unit

-- util
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

runComposeFunctions :: UserRepositoryFunctions -> DisplayFunctions -> FreeUserRepositoryPresenter ~> Aff
runComposeFunctions f g m = foldFree (interpretUserRepository f `or` interpretPresenter g) m

spec :: Spec Unit
spec = do
  describe "Tagless Final With Free Spec" do
    describe "UserRepository + Presenterのテスト" do
      it "指定したIDのユーザーが、トライアルユーザーかどうかを出力する - トライアルユーザーの場合" do
        let
          displayMock = mock $ any :> (pure unit :: Effect Unit)
          userRepositoryFunctions = {
            findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
            findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: true}
          }
          presenterFunctions = { display: fun displayMock } 
        findUserWithDisplayTrialStatus "userId" 
          # runComposeFunctions userRepositoryFunctions presenterFunctions
        verify displayMock "This User is Trial Account."

      it "指定したIDのユーザーが、トライアルユーザーかどうかを出力する - トライアルユーザでない場合" do
        let
          displayMock = mock $ any :> (pure unit :: Effect Unit)
          userRepositoryFunctions = {
            findUserById: mockFun $ "userId" :> {id: "userId", name: "userName", optionId: "optionId"},
            findOptionById: mockFun $ "optionId" :> {optionId: "optionId", isTrial: false}
          }
          presenterFunctions = { display: fun displayMock } 
        findUserWithDisplayTrialStatus "userId" 
          # runComposeFunctions userRepositoryFunctions presenterFunctions
        verify displayMock "This User is Premium Account."

Coproductを使って、2つのデータ型の直和型を作り出しています。
そしてその型を使って新たなFreeモナドを作っています。
アプローチその2と比べて、既存の型を流用できるのでコードが少なくて済んでいます。

type UserRepositoryPresenterF = Coproduct UserRepositoryF PresenterF
type FreeUserRepositoryPresenter = Free UserRepositoryPresenterF

インスタンス定義はやはり2つ必要です。

instance dataStoreCompose :: UserRepository FreeUserRepositoryPresenter where
  findUserById id = liftF <<< inj $ FindUserById id identity
  findOptionById id = liftF <<< inj $ FindOptionById id identity

instance keyFinderCompose :: Presenter FreeUserRepositoryPresenter where
  display msg = liftF <<< inj $ Display msg unit

実行の際も、アプローチその2とは異なり、UserRepositoryFunctionsやDisplayFunctionsやinterpretUserRepositoryやinterpretPresenterといったこれまでに作った関数を再利用できています！！

runComposeFunctions :: UserRepositoryFunctions -> DisplayFunctions -> FreeUserRepositoryPresenter ~> Aff
runComposeFunctions f g m = foldFree (interpretUserRepository f `or` interpretPresenter g) m

おわりに

さて、3つのアプローチ、いかがだったでしょうか？

私自身考えはしたものの、最初のアプローチはとらないと思います。
理由は、期待値の制御や検証などの処理が一部インスタンス定義の方にあるため、テストケース側から制御しづらいからです。

なので私ならば（今は）モナド変換子かFreeモナドを使ってモック関数を差し込むアプローチをとるかと思います。
もちろん他にもアプローチはあるでしょう。

ちなみにFreeモナドを使うアプローチですが、恐らく意味不明だと思われたかと思います。しかしTagless Finalを合成するような場合には既存の関数を再利用できるので、一定メリットがあるのではないでしょうか。

ちなみに本記事のコードはこちらにあります。
https://github.com/pujoheadsoft/purescript-example-tagless-final-test

Discussion