Haskell でオブジェクト指向 (2)

id:aufheben:20080413 で書いた「Haskell でオブジェクト指向」ですが、自分の頭ではもう限界なので、顛末だけ書いていったん終了としたいと思います。(^^;)

まず、Person 型と Entity 型、基本的に前回から変わっていませんが、いろいろと試行錯誤がしやすいように、共通部品としてモジュール化しました。
まずは Person モジュールから。

module Person
(
  Person(Person),
  setName,
  setAge
)
  where

data Person =
  Person {
    name :: String,
    age  :: Int
  }
  deriving Show

setName :: String -> Person -> Person
setName newName x = x { name = newName }

setAge :: Int -> Person -> Person
setAge newAge x = x { age = newAge }

続いて、Entity モジュール。

module Entity
(
  Entity,
  makeEntity,
  update,
  replace,
  IdGen(IdGen)
)
  where

data Entity a =
  Entity {
    id      :: Integer,
    version :: Integer,
    state   :: a
  }
  deriving Show

instance Eq (Entity a)
  where
    x == y = Entity.id x == Entity.id y

initialVersion :: Integer
initialVersion = 1

makeEntity :: a -> IdGen -> (Entity a, IdGen)
makeEntity x g =
  let
    (id, g') = nextId g
  in
    (Entity id initialVersion x, g')

update :: (a -> a) -> Entity a -> Entity a
update f (Entity id version x) =
  Entity id (version + 1) (f x)

replace :: a -> Entity a -> Entity a
replace newX = update (const newX)

data IdGen =
  IdGen {
    lastId :: Integer
  }
  deriving Show

nextId :: IdGen -> (Integer, IdGen)
nextId g =
  let
    id = (lastId g) + 1
  in
    (id, IdGen id)

前回 id を eid に変更しましたが、モジュール名を付加すれば良いらしいので、初めの id に戻しました。
また、fmap は、

fmap id  ==  id
fmap (f . g)  ==  fmap f . fmap g

という規則を満たさないといけないらしいので、Functor をインスタンス化するのはやめ、

fmap -> update
updateEntity -> replace

と関数名を変更しています。

メインでは、Entity と Person をインポートし、上記の修正点を反映しました。
また、若干出力を見やすくしてみました。

import Entity
import Person

main =
  let
    g0       = IdGen 1000
    (x1, g1) = makeEntity (Person "Foo" 12) g0
    x2       = update (setName "Bar") x1
    x3       = update (setAge 23) x2
    (y1, g2) = makeEntity (Person "Hoge" 34) g1
    y2       = replace (Person "Fuga" 45) y1
  in do
    trace "g0" g0
    trace "g1" g1
    trace "x1" x1
    trace "x2" x2
    trace "x3" x3
    trace "x1 == x2" $ x1 == x2
    trace "x2 == x3" $ x2 == x3
    trace "g2" g2
    trace "y1" y1
    trace "y2" y2
    trace "x1 == y1" $ x1 == y1
    trace "y1 == y2" $ y1 == y2

trace :: Show a => String -> a -> IO()
trace s x = putStrLn $ s ++ " => " ++ show x

実行結果は以下のとおり。

prompt>runghc entity-example0.hs
g0 => IdGen {lastId = 1000}
g1 => IdGen {lastId = 1001}
x1 => Entity {id = 1001, version = 1, state = Person {name = "Foo", age = 12}}
x2 => Entity {id = 1001, version = 2, state = Person {name = "Bar", age = 12}}
x3 => Entity {id = 1001, version = 3, state = Person {name = "Bar", age = 23}}
x1 == x2 => True
x2 == x3 => True
g2 => IdGen {lastId = 1002}
y1 => Entity {id = 1002, version = 1, state = Person {name = "Hoge", age = 34}}
y2 => Entity {id = 1002, version = 2, state = Person {name = "Fuga", age = 45}}
x1 == y1 => False
y1 == y2 => True