More than 5 years have passed since last update.

株式会社HERP

extensible effects でやっていくドメインロジック記述

Last updated at 2019-11-29Posted at 2019-11-29

1 / 52

自己紹介

亀岡亮太 (Ryota Kameoka)
株式会社HERP リードエンジニア
Twitter @ryotakameoka
GitHub @ryota-ka

注意事項

スライドのコードはかなり端折ってます
- 実際の実装は GitHub をご覧ください

ドメインロジックとは

コドメインロジックの双対

ドメインロジックとは

~~コドメインロジックの双対~~
ビジネスロジックとも呼ばれる

In computer software, business logic or domain logic is the part of the program that encodes the real-world business rules that determine how data can be created, stored, and changed.

https://en.wikipedia.org/wiki/Business_logic より引用

ドメインロジックとは

CC BY-SA 4.0
created by Cth027
https://en.wikipedia.org/wiki/Hexagonal_architecture_(software)#/media/File:Hexagonal_Architecture.svg
一部改変

ドメインロジックとは

CC BY-SA 4.0
created by Cth027
https://en.wikipedia.org/wiki/Hexagonal_architecture_(software)#/media/File:Hexagonal_Architecture.svg
一部改変

ドメインロジックとは

https://blog.cleancoder.com/uncle-bob/2012/08/13/the-clean-architecture.html より引用・一部改変

ドメインロジックとは

https://blog.cleancoder.com/uncle-bob/2012/08/13/the-clean-architecture.html より引用・一部改変

なぜドメインロジック記述が重要か？

実装詳細に依存しない (抽象化の壁)
変更に強いコードベース
複雑性を減らす

どのようにドメインロジックを記述したいか？

関心の分離
拡張性
合成性
テスタビリティ

extensible effects

なんかいい感じのモナドの合成手法
- 複数の計算効果をなんかいい感じに混ぜることができる
Kiselyov and Ishii (2015) "Freer Monads, More Extensible Effects" のスライドを15回ぐらい眺めるとわかる
複数の関心事を含んだ "プログラム" (monad) を上手く書ける
理論的背景や実装方法は本題じゃないので詳しくは懇親会で (誰かに聞いてください)

extensible effects

ざっくり言うと

"プログラムそのもの" が書ける (free(r) monads)
型 f a を「関心事 f :: Type -> Type が付いた型 a」と見る
- f によって写されている
複数の関心事を混ぜることができる
- f, g, h :: Type -> Type

例) 新しいタレントを追加する

addTalent ユースケース

タレント:

data Talent
    = Talent
    { id      :: TalentID      -- ^ 'Text' の newtype
    , name    :: TalentName    -- ^ 'Text' の newtype
    , addedAt :: TalentAddedAt -- ^ 'UTCTime' の newtype
    }

例) 新しいタレントを追加する

タレント名を受け取る
現在時刻を取得する
IDを発番する
タレントを永続化する
作られたタレントを返す

例) 新しいタレントを追加する

タレント名を受け取る (引数)
現在時刻を取得する
IDを発番する
タレントを永続化する
作られたタレントを返す (戻り値)

TalentName -> m Talent

例) 新しいタレントを追加する

タレント名を受け取る
現在時刻を取得する (effect)
IDを発番する (effect)
タレントを永続化する (effect)
作られたタレントを返す

例) 新しいタレントを追加する

タレント名を受け取る
現在時刻を取得する (Clock effect)
IDを発番する (TalentIDGenerator effect)
タレントを永続化する (TalentRepository effect)
作られたタレントを返す

名前をつけてやる (関心の分離)

`Clock` effect

出来合いの effect を使う

module Effects.Clock where

import Data.Extensible (ReaderEff)
import Data.Time (UTCTime)

type AnonEff = ReaderEff UTCTime
type HasEff effs = _

ask :: forall effs. HasEff effs => Eff effs UTCTime
ask = _

`TalentIDGenerator` effect

出来合いの effect を使う

module Effects.TalentIDGenerator where

import Data.Extensible (ReaderEff)
import DomainObjects.Talent (TalentID)

type AnonEff = ReaderEff TalentID
type HasEff effs = _

next :: forall effs. HasEff effs => Eff effs TalentID
next = _

`TalentRepository` effect

自分で effect を定義する

module Effects.TalentRepository where

type AnonEff = TalentRepository
type HasEff effs = _

data TalentRepository a where
    Find  :: TalentID -> TalentRepository (Maybe Talent)
    Store :: Talent   -> TalentRepository ()

find :: forall effs. HasEff effs => TalentID -> Eff effs (Maybe Talent)
find talentID = _

store :: forall effs. HasEff effs => Talent -> Eff effs ()
store talent = _

`addTalent` ユースケース

addTalent
    :: forall effs
     . ( Clock.HasEff effs
       , TalentIDGenerator.HasEff effs
       , TalentRepository.HasEff effs
       )
    => TalentName
    -> Eff effs Talent
addTalent name = do               -- タレント名を受け取る

例) 新しいタレントを追加する

addTalent
    :: forall effs
     . ( Clock.HasEff effs
       , TalentIDGenerator.HasEff effs
       , TalentRepository.HasEff effs
       )
    => TalentName
    -> Eff effs Talent
addTalent name = do               -- タレント名を受け取る
    now <- Clock.ask              -- 現在時刻を取得する

例) 新しいタレントを追加する

addTalent
    :: forall effs
     . ( Clock.HasEff effs
       , TalentIDGenerator.HasEff effs
       , TalentRepository.HasEff effs
       )
    => TalentName
    -> Eff effs Talent
addTalent name = do               -- タレント名を受け取る
    now <- Clock.ask              -- 現在時刻を取得する
    id  <- TalentIDGenerator.next -- IDを発番する

例) 新しいタレントを追加する

addTalent
    :: forall effs
     . ( Clock.HasEff effs
       , TalentIDGenerator.HasEff effs
       , TalentRepository.HasEff effs
       )
    => TalentName
    -> Eff effs Talent
addTalent name = do               -- タレント名を受け取る
    now <- Clock.ask              -- 現在時刻を取得する
    id  <- TalentIDGenerator.next -- IDを発番する

    let addedAt = TalentAddedAt.fromUTCTime now
        talent  = Talent { id, name, addedAt }

例) 新しいタレントを追加する

addTalent
    :: forall effs
     . ( Clock.HasEff effs
       , TalentIDGenerator.HasEff effs
       , TalentRepository.HasEff effs
       )
    => TalentName
    -> Eff effs Talent
addTalent name = do               -- タレント名を受け取る
    now <- Clock.ask              -- 現在時刻を取得する
    id  <- TalentIDGenerator.next -- IDを発番する

    let addedAt = TalentAddedAt.fromUTCTime now
        talent  = Talent { id, name, addedAt }

    TalentRepository.store talent -- タレントを永続化する

例) 新しいタレントを追加する

addTalent
    :: forall effs
     . ( Clock.HasEff effs
       , TalentIDGenerator.HasEff effs
       , TalentRepository.HasEff effs
       )
    => TalentName
    -> Eff effs Talent
addTalent name = do               -- タレント名を受け取る
    now <- Clock.ask              -- 現在時刻を取得する
    id  <- TalentIDGenerator.next -- IDを発番する

    let addedAt = TalentAddedAt.fromUTCTime now
        talent  = Talent { id, name, addedAt }

    TalentRepository.store talent -- タレントを永続化する

    pure talent                   -- 作られたタレントを返す

何をやっているのかがわかる！！

ドメインロジックの実行

タレント名を受け取る
現在時刻を取得する (Clock effect)
IDを発番する (TalentIDGenerator effect)
タレントを永続化する (TalentRepository effect)
作られたタレントを返す

3つの effect を handle すればユースケースを"実行"できる

作戦会議

Clock effect
- システム・コールで現在時刻を取得する
  - IO っぽい
TalentIDGenerator effect
- IDを発番する (UUID v4 とかで)
  - IO っぽい
TalentRepository effect
- タレントを永続化する
  - ホンマは RDB に入れたいけど今日のところは IORef で勘弁しといたるか……
    - IO っぽい

作戦会議

Clock effect
- システム・コールで現在時刻を取得する
  - IO っぽい
TalentIDGenerator effect
- IDを発番する (UUID v4 とかで)
  - IO っぽい
TalentRepository effect
- タレントを永続化する
  - ホンマは RDB に入れたいけど今日のところは IORef で勘弁しといたるか……
    - IO っぽい

→ 一旦それぞれ IO に押し付けてあとでまとめて解決するか

作戦会議

`Clock` effect を handle する

run
    :: forall effs a
     . IO.HasEff effs                 -- 残りの effects に IO が含まれていることを要求
    => Eff (Clock.NamedEff ': effs) a -- Clock effect を剥がす
    -> Eff effs a
run = peelEff0 pure interpret
  where
    interpret
        :: forall r
         . Clock.AnonEff r
        -> (r -> Eff effs a)
        -> Eff effs a
    interpret Refl k = do
        now <- IO.lift getCurrentTime -- IO に押し付ける
        k now

`TalentIDGenerator` effect を handle する

run
    :: forall effs a
     . IO.HasEff effs                             -- 残りの effects に IO が含まれていることを要求
    => Eff (TalentIDGenerator.NamedEff ': effs) a -- TalentIDGenerator effect を剥がす
    -> Eff effs a
run = peelEff0 pure interpret
  where
    interpret
        :: forall r
         . TalentIDGenerator.AnonEff r
        -> (r -> Eff effs a)
        -> Eff effs a
    interpret Refl k = do
        uuid <- IO.lift UUID.nextRandom           -- IO に押し付ける
        let text     = UUID.toText uuid
            talentID = TalentID.shamefullyConvertFromText text
        k talentID

`TalentRepository` effect を handle する


run
    :: forall effs a
     . IO.HasEff effs
    => IORef (Map Talent.ID Talent)
    -> Eff (TalentRepository.NamedEff ': effs) a
    -> Eff effs a
run ref effs = peelEff0 pure interpret effs
  where
    interpret :: forall r . TalentRepository.AnonEff r -> (r -> Eff effs a) -> Eff effs a
    interpret (Find id) k = do
        repo <- IO.lift $ readIORef ref
        let mtalent = Map.lookup id repo
        k mtalent
    interpret (Store talent@Talent { id }) k = do
        IO.lift $ atomicModifyIORef' ref (\repo -> (Map.insert id talent repo, ()))
        k ()

Webサーバから呼び出す

run :: IO ()
run = do
    talentRepo <- newIORef mempty

    let runUseCase
            :: forall a
             . Eff '[TalentRepository.NamedEff, TalentIDGenerator.NamedEff, Clock.NamedEff, IO.NamedEff] a
            -> IO a
        runUseCase = retractEff . Clock.run . TalentIDGenerator.run . TalentRepository.run talentRepo

    scotty 3000 $ do
        -- タレントの数を返す
        get "/talents.count" $ do
            repo <- liftIO $ readIORef talentRepo
            let count = length repo
            json $ object ["count" .= count]

        -- タレントを追加する
        post "/talents.add" $ do
            name <- param "name"
            _    <- liftIO . runUseCase $ do -- use case 呼び出し
                addTalent (TalentName.shamefullyConvertFromText name)
            status status201
            json $ object ["ok" .= True]

$ curl -X GET localhost:3000/talents.count
{"count":0}%

$ curl -X POST -d name=Alice localhost:3000/talents.add
{"ok":true}%

$ curl -X POST -d name=Bob localhost:3000/talents.add
{"ok":true}%

$ curl -X GET localhost:3000/talents.count
{"count":2}%

ドメインロジックのテスト

このようにして記述したドメインロジックは容易にテスト可能
副作用を起こさずに pure に handle する

作戦会議

`Clock` を pure に handle する

run
    :: forall effs a
     . UTCTime
    -> Eff (Clock.NamedEff ': effs) a
    -> Eff effs a
run = flip runReaderEff

普通に Reader

`TalentIDGenerator` を pure に handle する

run
    :: forall effs a
     . Eff (TalentIDGenerator.NamedEff ': effs) a
    -> Eff effs a
run effs = peelEff1 (\x _ -> pure x) interpret effs 0
  where
    interpret :: forall r . TalentIDGenerator.AnonEff r -> (r -> Integer -> Eff effs a) -> Integer -> Eff effs a
    interpret Refl k n = do
        let text     = T.pack (show n)
            talentID = TalentID.shamefullyConvertFromText text
        k talentID (n + 1)

TalentID "0"
TalentID "1"
TalentID "2"
...

を順に生成

`TalentRepository` を pure に handle する

run
    :: forall effs a
     . Map Talent.ID Talent
    -> Eff (TalentRepository.NamedEff ': effs) a
    -> Eff effs (a, Map Talent.ID Talent)
run initState effs = peelEff1 (\a s -> pure (a, s)) interpret effs initState
  where
    interpret
        :: forall r
         . TalentRepository.AnonEff r
        -> (r -> Map Talent.ID Talent -> Eff effs (a, Map Talent.ID Talent))
        -> Map Talent.ID Talent
        -> Eff effs (a, Map Talent.ID Talent)
    interpret (Find  id) k repo = k (Map.lookup id repo) repo
    interpret (Store talent@Talent { id }) k repo =
        let repo' = Map.insert id talent repo
         in k () repo'

テストコード

pure な handler でユースケースを実行

now :: UTCTime
now = posixSecondsToUTCTime 1234567890

runUseCase
    :: Eff '[TalentRepository.NamedEff, TalentIDGenerator.NamedEff, Clock.NamedEff] a -> (a, Map Talent.ID Talent)
runUseCase = leaveEff . Clock.run now . TalentIDGenerator.run . TalentRepository.run mempty

spec :: Spec
spec = describe "addTalent" $ do
    it "increments the number of talents in the repository" $ do
        let name      = TalentName.shamefullyConvertFromText "John Doe"
            (_, repo) = runUseCase $ addTalent name
        length repo `shouldBe` 1

ユースケースのテスト

$ stack test use-cases:test:spec
use-cases> test (suite: spec)


UseCases.AddTalent
  addTalent
    increments the number of talents in the repository

Finished in 0.0003 seconds
1 example, 0 failures

use-cases> Test suite spec passed

まとめ

extensible effects でロメインロジックを記述すると何が嬉しいか？

関心の分離
- effect を個別に定義できる
拡張性
- 新たな effect に対して開かれている (open union)
合成性
- monadic に合成可能
テスタビリティ
- pure に実行可能

ご清聴ありがとうございました！

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up

extensible effects でやっていくドメインロジック記述

自己紹介

ToC

注意事項

ToC

ドメインロジックとは

ドメインロジックとは

ドメインロジックとは

ドメインロジックとは

ドメインロジックとは

ドメインロジックとは

ToC

なぜドメインロジック記述が重要か？

どのようにドメインロジックを記述したいか？

ToC

extensible effects

extensible effects

ToC

例) 新しいタレントを追加する

例) 新しいタレントを追加する

例) 新しいタレントを追加する

例) 新しいタレントを追加する

例) 新しいタレントを追加する

Clock effect

TalentIDGenerator effect

TalentRepository effect

addTalent ユースケース

例) 新しいタレントを追加する

例) 新しいタレントを追加する

例) 新しいタレントを追加する

例) 新しいタレントを追加する

例) 新しいタレントを追加する

何をやっているのかがわかる！！

ToC

ドメインロジックの実行

作戦会議

作戦会議

作戦会議

Clock effect を handle する

TalentIDGenerator effect を handle する

TalentRepository effect を handle する

Webサーバから呼び出す

ToC

ドメインロジックのテスト

作戦会議

Clock を pure に handle する

TalentIDGenerator を pure に handle する

TalentRepository を pure に handle する

テストコード

ユースケースのテスト

まとめ

ご清聴ありがとうございました！

`Clock` effect

`TalentIDGenerator` effect

`TalentRepository` effect

`addTalent` ユースケース

`Clock` effect を handle する

`TalentIDGenerator` effect を handle する

`TalentRepository` effect を handle する

`Clock` を pure に handle する

`TalentIDGenerator` を pure に handle する

`TalentRepository` を pure に handle する