PureScript で Extensible Effects による Clean Architecture
はじめに
少し前、『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
はこうなりました。
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
前回のはこう。
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
は、このようになっています。
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
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がついただけです。
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
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
で検証できています。
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