initial encodingはpureか？.md

ドメインモデル貧血症はなぜ生まれるのか — Decision パターンで DDD トリレンマを解くについて、Vladimir Khorikov さんなら「いや、それは impure だよ」と言う気がしてきた。説明してみる。

---

まず Khorikov さんは、プロセス外への依存をインターフェースやデリゲートで包んでも、純粋性は回復しないと明言している。これは次のようなものを指す。

interface IViewService {
  boolean isFollowing(UserId viewer, UserId author);
  boolean isVip(UserId viewer);
  boolean hasPurchased(UserId viewer, StoryId story);
}
class View {
  Verdict decideView(IViewService viewService, Story s, UserId viewer) { ... }
}

インターフェースという語は多義的でわかりにくいので、この文章では上記のパターンをDIと呼ぶことにする。

さて、typer さんの提案はGoでinitial encodingを実装したものと見て良い。Goなので複雑になっているが、Haskellで実装するならこんな感じだろう。

data ViewProgram a
  = Return a
  | NeedFollowing UserId UserId (Bool -> ViewProgram a)
  | NeedVIP UserId (Bool -> ViewProgram a)
  | NeedPurchase UserId StoryId (Bool -> ViewProgram a)
  -- typerさんの実装は defunctionalization までしているが、
  -- ここではクロージャーをそのまま保持する。大きな違いはない

instance Monad ViewProgram where ...

-- smart constructors
needFollowing :: UserId -> UserId -> ViewProgram Bool
needFollowing v author = NeedFollowing v author Return

needVIP :: UserId -> ViewProgram Bool
needVIP v = NeedVIP v Return

needPurchase :: UserId -> StoryId -> ViewProgram Bool
needPurchase v story = NeedPurchase v story Return

-- 判定ロジック
data Verdict
  = Allowed | UnknownAudience | NotFollower | NotPurchased
  deriving (Eq, Show)

decideView :: Story -> UserId -> ViewProgram Verdict
decideView s viewer
  | authorId s == viewer = pure Allowed
  | otherwise = case audience s of
      Everyone -> afterAudience
      Followers -> do
        follows <- needFollowing viewer (authorId s)
        if follows then afterAudience else pure NotFollower
      Unknown -> pure UnknownAudience
  where
    afterAudience
      | not (isPaid s) = pure Allowed
      | otherwise = do
          vip <- needVIP viewer
          if vip then pure Allowed else do
            purchased <- needPurchase viewer (storyId s)
            pure (if purchased then Allowed else NotPurchased)

同じ判定ロジックは、final encoding でも表せる。まず、情報取得の操作を型クラスとして定義する。

class Monad m => MonadView m where
  needFollowing :: UserId -> UserId -> m Bool
  needVIP       :: UserId -> m Bool
  needPurchase  :: UserId -> StoryId -> m Bool

decideView の本体はそのままで、シグネチャだけが次のようになる。

decideView :: MonadView m => Story -> UserId -> m Verdict

一般に、これらの操作(need*)で組み立てたプログラムは、判定ロジックの内容によらずに initial 版と final 版を相互に変換できることが知られている。

ところで、Haskell の型クラスの実体は単なる辞書渡しであった。したがって、これは次のように見なせる。

data IViewService m = IViewService
  { needFollowing :: UserId -> UserId -> m Bool
  , needVIP       :: UserId -> m Bool
  , needPurchase  :: UserId -> StoryId -> m Bool
  }

decideView :: Monad m => IViewService m -> Story -> UserId -> m Verdict

これは、冒頭のDIと同じ構造になっている。

つまり、Decision Pattern ≒ initial encoding ≒ final encoding ≒ DI とたどれる。だとすれば、Decision Pattern も Khorikov さんの定義では impure なのではなかろうか。

---

ここまでは、プログラム変換によって「実は Decision Pattern も "impure" なのではないか」という疑いを示した。 しかし、間接的な帰着では（書いてる自分でさえも）煙に巻かれたような心地がするので、別の説明を考えてみる。

見直したいのは、「純粋性は何のために必要なのか」だ（よく考えると、DDDトリレンマのパフォーマンス・純粋性・完全性のうち、純粋性と完全性はそれ自体が目的ではない）。

Khorikov さんは同じ記事で、純粋性を保つ理由として次を挙げている。

• アプリケーションの複雑さを管理可能に保つ（DDDの文脈）
• 参照透過性を保ち、隠れた入出力を避ける（関数型プログラミングの文脈）
• “pure domain model means testable domain model”（ユニットテストの文脈）

参照透過性もそれ自体が目的ではなく、複雑さの管理は評価が難しいから、ここではテストのしやすさに着目することにする。

initial encoding 版で observable behavior をテストすると、たとえばこんな感じになるだろう:

data TestFacts = TestFacts
  { followingFact :: Bool
  , vipFact       :: Bool
  , purchaseFact  :: Bool
  }

runPure :: TestFacts -> ViewProgram a -> a
runPure _     (Return result)            = result
runPure facts (NeedFollowing _ _ resume) = runPure facts (resume (followingFact facts))
runPure facts (NeedVIP _ resume)         = runPure facts (resume (vipFact facts))
runPure facts (NeedPurchase _ _ resume)  = runPure facts (resume (purchaseFact facts))

-- テスト本体
runPure (TestFacts True False False) (decideView followerLimitedPaidStory follower)
  `shouldBe` NotPurchased

final encoding 版ならこう:

newtype TestView a = TestView (Reader TestFacts a)
  deriving (Functor, Applicative, Monad)

instance MonadView TestView where
  needFollowing _ _ = TestView (asks followingFact)
  needVIP _         = TestView (asks vipFact)
  needPurchase _ _  = TestView (asks purchaseFact)

runPure :: TestFacts -> TestView a -> a
runPure facts (TestView computation) = runReader computation facts

-- テスト本体
runPure (TestFacts True False False) (decideView followerLimitedPaidStory follower)
  `shouldBe` NotPurchased

比較用に、冒頭のDIならこう書ける:

var viewService = mock(IViewService.class);
when(viewService.isFollowing(any(), any())).thenReturn(true);
when(viewService.isVip(any())).thenReturn(false);
when(viewService.hasPurchased(any(), any())).thenReturn(false);

assertThat(new View().decideView(viewService, followerLimitedPaidStory, follower))
    .isEqualTo(Verdict.NotPurchased);

initial / final のどちらも、判定結果をテストするためにテスト用のインタープリターを用意している。取得要求にテスト用の値を返す部分は、DIの例における stub と同じ役割を果たしている。

そして、この種の out-of-process dependencies を念頭に置いた¹ セットアップは、Khorikov さん的に良くないテストだったはず。 というわけで、今回扱った書き方はいずれも “pure domain model means testable domain model” の意味では pure でなさそうだ。

---

以上を踏まえて initial encoding の構造を見てみると、NeedFollowing _ _ cont のような情報取得要求を扱う時点で、それは "reach out to out-of-process dependencies" なんじゃないか？という気がしている。cont :: Bool → m a は out-of-process が入るために予約された hole なので

Footnotes

1. 例がシンプルなのでピンと来ないかもしれないが、例えば「相互フォローのみOK」みたいな要求が出てくると、needFollowing が引数をチェックする必要がでてきて、「out-of-process dependenciesを念頭に置いたinteractictionのテスト」になっていく ↩

「相互フォローのみOK」の例をinitialで書いてみた

data Audience
  = Everyone
  | Followers
  | MutualFollowers
  | Unknown

data Verdict
  = Allowed
  | UnknownAudience
  | NotFollower
  | NotMutualFollower
  | NotPurchased
  deriving (Eq, Show)

decideView :: Story -> UserId -> ViewProgram Verdict
decideView s viewer
  | authorId s == viewer = pure Allowed
  | otherwise =
      case audience s of
        Everyone ->
          afterAudience

        Followers -> do
          follows <- needFollowing viewer (authorId s)
          if follows
            then afterAudience
            else pure NotFollower

        MutualFollowers -> do
          viewerFollowsAuthor <-
            needFollowing viewer (authorId s)

          if not viewerFollowsAuthor
            then pure NotMutualFollower
            else do
              authorFollowsViewer <-
                needFollowing (authorId s) viewer

              if authorFollowsViewer
                then afterAudience
                else pure NotMutualFollower

        Unknown ->
          pure UnknownAudience
  where
    afterAudience
      | not (isPaid s) =
          pure Allowed

      | otherwise = do
          vip <- needVIP viewer
          if vip
            then pure Allowed
            else do
              purchased <- needPurchase viewer (storyId s)
              pure $
                if purchased
                  then Allowed
                  else NotPurchased

-- テスト

data TestFacts = TestFacts
  { followingFact :: UserId -> UserId -> Bool
  , vipFact       :: UserId -> Bool
  , purchaseFact  :: UserId -> StoryId -> Bool
  }

runPure :: TestFacts -> ViewProgram a -> a
runPure _ (Return result)                        = result
runPure facts (NeedFollowing from to resume)     = runPure facts $ resume (followingFact facts from to)
runPure facts (NeedVIP viewer resume)            = runPure facts $ resume (vipFact facts viewer)
runPure facts (NeedPurchase viewer story resume) = runPure facts $ resume (purchaseFact facts viewer story)

-- 片思いフォローで弾かれるケース
let facts =
      TestFacts
        { -- Mockitoの以下に相当する
          -- when(viewService.isFollowing(follower, author)).thenReturn(true);
          -- when(viewService.isFollowing(author, follower)).thenReturn(false);
          followingFact = \from to -> \if
            | from == follower && to == author -> True
            | from == author && to == follower -> False
            | otherwise -> undefined
        , vipFact = const False
        , purchaseFact = \_ _ -> False
        }
runPure facts
  (decideView mutualFollowerLimitedStory follower)
  `shouldBe` NotMutualFollower