LoginSignup
30
14

More than 3 years have passed since last update.

@ryota-ka(Ryota Kameoka)in株式会社HERP

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

Last updated at Posted at 2019-11-29
1 / 52

自己紹介

ToC

  • ドメインロジックとは
  • なぜドメインロジック記述が重要か？
  • extensible effects
  • ドメインロジックの記述
  • ドメインロジックの実行
  • ドメインロジックのテスト

注意事項

ToC

  • ドメインロジックとは
  • なぜドメインロジック記述が重要か？
  • extensible effects
  • ドメインロジックの記述
  • ドメインロジックの実行
  • ドメインロジックのテスト

ドメインロジックとは

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

ドメインロジックとは

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

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 より引用

ドメインロジックとは

hexagonal architecture.png

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

ドメインロジックとは

hexagonal architecture konohen.png

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

ドメインロジックとは

clean architecture koreno.png

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

ドメインロジックとは

clean architecture konohen.png

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

ToC

  • ドメインロジックとは
  • なぜドメインロジック記述が重要か？
  • extensible effects
  • ドメインロジックの記述
  • ドメインロジックの実行
  • ドメインロジックのテスト

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

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

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

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

ToC

  • ドメインロジックとは
  • なぜドメインロジック記述が重要か？
  • extensible effects
  • ドメインロジックの記述
  • ドメインロジックの実行
  • ドメインロジックのテスト

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

ToC

  • ドメインロジックとは
  • なぜドメインロジック記述が重要か？
  • extensible effects
  • ドメインロジックの記述
  • ドメインロジックの実行
  • ドメインロジックのテスト

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

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                   -- 作られたタレントを返す

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

ToC

  • ドメインロジックとは
  • なぜドメインロジック記述が重要か？
  • extensible effects
  • ドメインロジックの記述
  • ドメインロジックの実行
  • ドメインロジックのテスト

ドメインロジックの実行

  • タレント名を受け取る
  • 現在時刻を取得する (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 に押し付けてあとでまとめて解決するか

作戦会議

effect handling on server.png

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}%

ToC

  • ドメインロジックとは
  • なぜドメインロジック記述が重要か？
  • extensible effects
  • ドメインロジックの記述
  • ドメインロジックの実行
  • ドメインロジックのテスト

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

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

作戦会議

effect handling on test.png

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 に実行可能

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

30
14
1

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
30
14