はじめに

少し前、『PureScript で TDD + Clean Architecture (with pmock)』という記事を投稿しました。

そこでは、モックライブラリ pmock の実用的な使い方を紹介するための題材として、Clean Architecture を取り上げていたのですが、Use Caseの関数の定義がどうにも気になっていたのです。
気になっていたのは、PortをDI(Dependency Injection)的に依存性を注入したいのを、引数で直接渡していたところです。
他にやりようはないのだろうか、と。
そこで Extensible Effects を使うアプローチを試してみたので、ご紹介したいと思います。
コードはこちらです。

Extensible Effectsとは

Extensible Effectsはめちゃくちゃ簡単にいうと
『モナドをいい感じに合成してくれるやつ』
です。
モナドの合成というと、モナド変換子が有名ですが、モナド変換子はモナドをスタックしていくため、合成するモナドが多くなるとやや扱いづらいのです。
Extensible Effectsはそこをクリアしており、合成したモナドをフラット（という表現が正しいかわからないですが）に扱えます。
（ただ、いまは合成するモナドの数が少ないならモナド変換子でいいや、という風潮なのかな？となんとなく感じています。）
ちなみに、以前PureScriptにおけるDIの手法を調べているとき、このスライドで知りました。

PureScriptでは、purescript-runというライブラリがあり、そちらを使います。

解説

説明に使うコードのユースケースは、前回の記事と同じで『指定されたユーザーIDのユーザーに紐づくTODOのリストのうちステータスが『完了』のものを出力する』です。
違いがわかりやすいように、極力レイヤーや名前などは前回のものと揃えています。

Use Case

Use Caseはこうなりました。

Usecases.DisplayCompletedTodos

execute 
  :: UserId
  -> Logics
  -> Run (TODO_PORT + TODO_OUTPUT_PORT + AFF + ()) Unit
execute id logics = do
  result <- findTodos id
  case result of
    Right todos -> display $ logics.completed todos
    Left e -> displayError e

前回のはこう。

Usecases.DisplayCompletedTodos

execute 
  :: UserId
  -> Logics
  -> TodoPort
  -> TodoOutputPort
  -> Aff Unit
execute id logics todoPort outputPort = do
  result <- todoPort.findTodos id
  case result of
    Right todos -> outputPort.display $ logics.completed todos
    Left e -> outputPort.displayError e

引数からPortが消えて、変わりに戻り値の型がRun (TODO_PORT + TODO_OUTPUT_PORT + AFF + ()) Unitという型になっています。
このRunがExtensible Effectsを実現する型で、これのおかげでexecute関数の中でいきなりfindTodosやdisplayなどが呼び出せています。
Runの括弧の中が副作用の部分で、この定義からはTODO_PORT TODO_OUTPUT_PORT AFFといった副作用が合成されていることが読み取れます。
前よりはDIっぽくなったのではないでしょうか。

Port

Use Caseが扱うPortは、このようになっています。

Usecases.TodoPort

type TodoPortType = {
  findTodos :: UserId -> Aff (Either Error Todos)
}

data TodoPort a
  = FindTodos UserId ((Either Error Todos) -> a)

-- The following is almost boilerplate
derive instance todoPortF :: Functor TodoPort
type TODO_PORT r = (todoPort :: TodoPort | r)
_todoPort = Proxy :: Proxy "todoPort"

findTodos :: forall r. UserId -> Run (TODO_PORT + r) (Either Error Todos)
findTodos userId = lift _todoPort (FindTodos userId identity)

runPort :: forall r. TodoPortType -> Run (TODO_PORT + AFF + r) ~> Run (AFF + r)
runPort t run = interpret (on _todoPort (todoPortHandler t) send) run

todoPortHandler :: forall r. TodoPortType -> TodoPort ~> Run (AFF + r)
todoPortHandler t r = case r of
  FindTodos userId next -> do
    todos <- liftAff $ t.findTodos userId
    pure $ next todos

Usecases.TodoOutputPort

type TodoOutputPortType = {
  display :: Todos -> Aff Unit,
  displayError :: Error -> Aff Unit
}

data TodoOutputPort a
  = Display Todos a
  | DisplayError Error a

-- The following is almost boilerplate
derive instance todoOutputPortF :: Functor TodoOutputPort
type TODO_OUTPUT_PORT r = (todoOutputPort :: TodoOutputPort | r)
_todoOutputPort = Proxy :: Proxy "todoOutputPort"

display :: forall r. Todos -> Run (TODO_OUTPUT_PORT + r) Unit
display todos = lift _todoOutputPort (Display todos unit)

displayError :: forall r. Error -> Run (TODO_OUTPUT_PORT + r) Unit
displayError error = lift _todoOutputPort (DisplayError error unit)

runOutputPort :: forall r. TodoOutputPortType -> Run (TODO_OUTPUT_PORT + AFF + r) ~> Run (AFF + r)
runOutputPort t run = interpret (on _todoOutputPort (todoOutputHandler t) send) run

todoOutputHandler :: forall r. TodoOutputPortType -> TodoOutputPort ~> Run (AFF + r)
todoOutputHandler t r = case r of
  Display todos a -> do
    liftAff $ t.display todos
    pure a
  DisplayError e a -> do
    liftAff $ t.displayError e
    pure a

前回の記事でTodoPortだったものは、今回TodoPortTypeという名前になっています。
data TodoPortを定義したからです。
行数は多いですが、Runを使う上でのボイラープレート（大体お決まりのやつ）の部分が多いです。
Extensible Effectsを使うと、インタフェース部分と、実装（ハンドラ）部分を分けることができるのですが、この例でいうとFindTodosやfindTodosのあたりがインタフェース部分で、todoPortHandlerがハンドラ部分です。
このように分けられるのでClean Architecureに使えると思ったんですね。
当初はハンドラ部分をGatewayやPresenterに持っていこうとしていたのですが、結局ハンドラは型をcaseで分岐して、処理の本体を実行して、継続を呼び出したり呼び出さなかったりという決まったことをやるので、処理の本体は外側に追い出してしまい、そちらをGatewayなどで実装するようにしました。
それがTodoPortType TodoOutputPortTypeです。
テスト側でまったく同じようなハンドラを書くのもだるいですしね。

ちなみに名前以外は前回と全く同じです。

前回の定義

type TodoPort = {
  findTodos :: UserId -> Aff (Either Error Todos)
}

type TodoOutputPort = {
  display :: Todos -> Aff Unit,
  displayError :: Error -> Aff Unit
}

GatewayとPresenter

こちらはほぼ前と変わらないです。
TodoPortやTodoOutputPortの末尾にTypeがついただけです。

Gateways.TodoGateway

type TodoJson = {
  title :: String,
  completed :: Boolean
}

type TodosJson = Array TodoJson

createTodoPort :: TodoPortType
createTodoPort = { findTodos: findTodos }

findTodos :: UserId -> Aff (Either Error Todos)
findTodos (UserId id) = do
  res <- get string $ "https://jsonplaceholder.typicode.com/users/" <> show id <> "/todos"
  case res of
    Left err -> do
      pure $ Left $ Error $ "GET /api response failed to decode: " <> printError err
    Right response -> do
      case readJSON response.body of
        Right (todos :: TodosJson) -> do
          pure $ Right $ todos <#> (\{title, completed} -> todo (TodoTitle title) if completed then Completed else InCompleted)
        Left e -> do
          pure $ Left $ Error $ "Can't parse JSON. " <> show e

Presenters.TodoPresenter

createOutputPort :: TodoOutputPortType
createOutputPort = {
  display: display,
  displayError: displayError
}

display :: Todos -> Aff Unit
display todos = do
  affLog $ "[Completed Todo Title]\n" <> joinWith "\n" (todos <#> (\(Todo {title: TodoTitle t}) -> t))

displayError :: Error -> Aff Unit
displayError (Error e) = do
  affLog e

affLog :: String -> Aff Unit
affLog = liftEffect <<< log

Test

テストの方もexecuteの実行方法以外前と変わらないです。
同じようにmockで検証できています。

Test.Usecases.DisplayCompletedTodosSpec

spec :: Spec Unit
spec = do
  describe "DisplayCompletedTodos Test" do
    it "指定されたユーザーIDに紐づくTodoのうち完了したTodoをすべて表示する" do
      let
        userId = UserId 1
        todo1 = todo (TodoTitle "Todo1") Completed
        todo2 = todo (TodoTitle "Todo2") InCompleted
        todos = [todo1, todo2]
        completedTodos = [todo1]

        findTodosFun = mockFun $ userId :> (pure $ Right todos :: Aff (Either Error Todos))
        completedTodosFun = mockFun $ todos :> completedTodos

        displayMock = mock $ completedTodos :> (pure unit :: Aff Unit)

        logics = { completed: completedTodosFun }
        todoPort = { findTodos: findTodosFun }
        todoOutputPort = { 
          display: fun displayMock,
          displayError: unsafeCoerce
        }

      _ <- execute (UserId 1) logics
        # runPort todoPort
        # runOutputPort todoOutputPort
        # runBaseAff
      
      verify displayMock completedTodos

    it "Todoの取得でエラーが発生した場合、エラーメッセージを表示する" do
      let
        userId = UserId 1

        findTodosFun = mockFun $ userId :> (pure $ Left $ Error "todo find error" :: Aff (Either Error Todos))

        displayMock = mock $ (any :: Param Todos) :> (pure unit :: Aff Unit)
        displayErrorMock = mock $ Error "todo find error" :> (pure unit :: Aff Unit)

        logics = { completed: unsafeCoerce }
        todoPort = { findTodos: findTodosFun }
        todoOutputPort = {
          display: fun displayMock,
          displayError: fun displayErrorMock
        }

      _ <- execute (UserId 1) logics
        # runPort todoPort
        # runOutputPort todoOutputPort
        # runBaseAff

      verify displayErrorMock $ Error "todo find error"
      verifyCount displayMock 0 (any :: Param Todos)

main

main関数はこうなりました。

main :: Effect Unit
main =
  launchAff_ do
    let
      todoLogics = logics
    execute (UserId 1) todoLogics
      # runPort createTodoPort
      # runOutputPort createOutputPort
      # runBaseAff

Runを使っているので、単にexecuteを呼び出すだけでは駄目で色々やっています。
簡単に説明するとrunXXX関数を呼び出すことで一つずつ副作用を剥がしていく感じです。
executeの定義はRun (TODO_PORT + TODO_OUTPUT_PORT + AFF + ()) Unitとなっており、
runPortを呼び出すとRun (TODO_OUTPUT_PORT + AFF + ()) Unit、
更にrunOutputPortを呼び出すとRun (AFF + ()) Unit、
更にrunBaseAffを呼び出すとやっと終わりです。
値を返す場合はまた別なのですが、今回はこれで終わりです。

終わりに

いかがだったでしょうか。
ボイラープレートはありますが、宣言はスッキリしましたし、テストも問題なく書けていたと思います。
反面、Extensible Effects自体の理解や、Runというライブラリの使い方を知っている必要があるという意味では、ハードルが高いかもしれないとも感じました。
（自分はRunを理解して使えるようにするのに大分苦労して、コードを読むだけでは仕組みを理解できず写経したりデバッグしたりした）
機会があったらRun自体の説明もしてみようと思います。

Discussion