ハトクラモナドをごにょごにょ - モナドで問題をどう解決するか

ボドゲ楽しいよね。 最近、家族で遊べないかなぁと思ってドミニオンの標準パックを買ってみたところ、 わりと好評だったのでほくほくしてます。

はい、てなわけで、ちゅーんさんですおばんです。

さて、今日ははる君(@haru2036)が書いた、ハトクラのモナドの記事

http://haru2036.hatenablog.com/entry/2014/12/17/014142

を楽しく読みました。 こういう何か題材を見つけてHaskellで解決しようみたいなアプローチ、 なかなか無いので貴重です。 とても面白い題材なのですが、いくつか気になった点があったのでがばっと改善してみました。

えっ、自分の進捗ですか？ それは聞かない約束です( ｰ`дｰ´)ｷﾘｯ

ActionPhaseの定義と役割について考えてみる

そもそもモナドのなんたるかについては、 ruiccさんの「モナド入門以前」という記事がおもろいのでこっち読むと良いと思います。

http://qiita.com/ruicc/items/6ba44359d86c3bf84492

ここでも何度も述べられているのですが、モナドは「プログラム」そのものを表すクラスであり、 チューリング完全なDSLを構築するための道具なのであります。

さて、ここで元記事のActionPhaseの定義を見てみましょう。

type ActionPhase = StateT Field (Either (Coins, Field)) Coins

--もしくは

type ActionPhase = EitherT Coins (State Field) Coins

どちらも、最後の型引数がCoinsになってしまっています。 ActionPhaseが「ハトクラのアクションフェーズに行う一連の手続き」を担うDSLなのであれば、 他のモナドインスタンスのように、多相型であるべきでしょう。

何故ならば、あるモナドm aの型引数aというのは、 命令形プログラムにおけるファンクションの返却値の型に相当するからです。 もしあなたが使うDSLで、ファンクションで返せる値の型が限定されていたら嫌でしょう？

あと、それから、EitherTは実質僕が提案したものではあるのですが、MaybeTに変更します。 後ほどまた説明しますが、実際に書いてみたところCoinsはFieldの中に入れたらスッキリするからです。 それを踏まえて、ActionPhaseは次のような定義になりました。

type ActionPhase a = MaybeT (State Field) a

さて、元のコードでは、カードそのものを表す型が次のように定義されています。

type Card = Coins -> ActionPhase

Cardの持つ効果は実質、アクションフェーズのDSLとして記述出来るので、良いセン行っているのですが、 こうしてしまうとCardという名前からActionPhaseというDSLのプログラムであるという情報を得られないのにも関わらず、 DSL内でファンクション呼び出しのように使う事が出来てしまうというややこしい問題が起こります。

特定のモナドアクションm aの型変数aを固定して、型の別名を付けてしまうのは、 Hackageなんかでもたびたび見かけるのですが、個人的にはかなーり悪手だと思います。 ってかIOでコレをやられた時はキレそうになりましたし、Qモナドもめちゃくちゃ混乱しました。

ひとまず、Card型は次のように定義しましょう。

newtype Card = Card { play :: ActionPhase () }

こうする事によって、playというフィールドは、次のような型を持ったActionPhaseモナドアクションとなります。

ghci> :t play
play :: Card -> ActionPhase ()

使い方は型を見れば明らかですね。 こうする事によって、次のようにわかりやすくカードをプレイして行く様を表現できます、

sample :: ActionPhase ()
sample = do
  play farm --農園
  play farm --農園
  play farm --農園
  play alchemist --錬金術士
  ...

Coinsを状態に持たせた事で、カードをプレイする事によって自動的に購入フェーズで使えるコイン数は集計されます。

Fieldに関するもろもろ

ハトクラでは「カードの連結」という表現をしているのですが、基本的に、

• 右にのみ連結出来るカードは、ドミニオンの＋１アクション
• 右と下に連結出来るカードは、ドミニオンの＋２アクション

と同等なので、残りアクション数を記録するactionフィールドを定義しますでしょ。 あと、くどいようですが、コインの枚数も状態で持たせますでしょ。 それから、山札、手札、捨て札も状態として持たせます。これは好みの問題ではあるのですが、元コードでCardsという型定義をしているのは、 Stringのような特別なアイデンティティがあるわけでは無いので、個人的には[Card]とそのまま書くほうが好きです。

そういえば元記事ではinheritanceRightsっていうフィールドを持っていましたが、何に使うのか良くわからなかったです。

data Field = Field
  { _coins :: Int
  , _action :: Int
  , _hand :: [Card]
  , _deck :: [Card]
  , _trash :: [Card]
  }

makeLenses ''Field

さて、ActionPhaseの型定義がややこしいので、なかなか気付きにくくはあるのですが、 実は、MaybeTとStateの合成はMonadState型クラスのインスタンスになります。

MonadState型クラスのインスタンスであれば、特にliftしなくてもgetとかput出来るのです。 で、さらに状態に持っている型FieldがLensになっている事に注目しましょう。 実はLensには次のような演算子が定義されていて、状態への操作がめちゃんこ楽に行えるんですね。

ghci> :t (.=) --代入
(.=) --代入 :: MonadState s m => Setter s s a a -> a -> m ()
ghci> :t (+=) --加算
(+=) --加算 :: (Num a, MonadState s m) => Setter s s a a -> a -> m ()

あー、ちなみにこの型定義はちゅーんさんの作ったちっこいLensの定義になってます。 中身は一緒ですが、公式のLensだとちょっと違う表記になってるかもかも。

で、この事を利用すると、例えば農園のカードは次のように定義する事ができるのです。

farm :: Card
farm = Card $ do 
  coins += 1 --＋１コスト
  action += 1 --＋１アクション

アクションの終了判定をどこでやるか

まず、アクションフェーズを終了するstopアクションは次のようになっていましたが・・・

stop :: Card
stop c = do
  fld <- (lift get)
  left c

ActionPhaseの定義に合わせて、次のように書き換えます。 ぶっちゃけ、このくらいの関数は標準で定義しておいて欲しい気はしますが。

stop :: ActionPhase ()
stop = MaybeT $ return Nothing

そして、終了判定を行い、終了条件を満たしていたらstopする、judgeアクションを定義しましょう。

judge :: ActionPhase ()
judge = do
  action -= 1
  act <- use action
  if act < 0 then
    stop
  else
    return ()

尚、use関数は、状態からフィールドの値を取り出すLensの関数です。

ghci> :t use
use :: MonadState s m => Getting a s a -> m a

さて、カードをプレイする度に毎回judgeアクションを呼び出すのはアホらしいので、 Card型とplayアクションを次のように書き換えてしまいましょう。

newtype Card = Card (ActionPhase ())

play :: Card -> ActionPhase ()
play (Card cardAction) = do
  cardAction
  judge

あー、ちなみに、手元で試してみたらmakeLenses関数の評価のタイミングの関係で、定義する場所気をつけないとエラーになるっぽい。 実際の記述順は最後にコード全体載せるのでそちらを参考にしてくらはい。

これもちゅーんさんの小さいLens特有の問題かしら、公式のLensではまだ試してないです。

とにかくこれで、カードをプレイする度に判定処理が行われて、アクションの残りが負数になったら、 その後の記述を無視して結果を返すようになりました。

ActionPhaseモナドと純粋な計算を繋ぐ

通常、モナドによって作られた言語内DSLと純粋な計算を繋ぐ・・・即ち、DSLを実行する関数には、 run〜という名前が付けられるのが定例です。 そのルールに則り、runActionPhase関数を定義しましょう。

runActionPhase :: Field -> ActionPhase a -> (Maybe a, Field)
runActionPhase fld = flip runState (resetField fld) . runMaybeT
  where
    resetField :: Field -> Field
    resetField f = f { _coins = 0, _action = 0 }

あー、なんかFieldの定義が納得いかない。resetFieldとかめっちゃダサい。 というワケで型定義をこんなんにして・・・

data ActionPhaseState = ActionPhaseState 
  { _coins :: Int
  , _action :: Int
  , _field :: Field
  }

data Field = Field
  { _hand :: [Card]
  , _deck :: [Card]
  , _trash :: [Card]
  }

makeLenses ''ActionPhaseState
makeLenses ''Field

で、こんなんにしてみました。

runActionPhase :: Field -> ActionPhase a -> (Maybe a, ActionPhaseState)
runActionPhase fld = flip runState (mkState fld) . runMaybeT
  where
    mkState :: Field -> ActionPhaseState
    mkState f = ActionPhaseState { _coins = 0, _action = 0, _field = f }

型定義が上手く出来ていたので、書き換える所はわりと少なくて済んだようです。まる。

残りの部分について

というわけで、元のプログラムから根本的な設計の部分を見なおしてみました。 手札や山札など、Fieldそのものに纏わる操作については触れませんでしたが、 何れもActionPhaseモナドの状態として管理しており、makeLensesしているので、 この辺を操作するためのアクションを提供するのも難しくは無いでしょう。

以上、この記事を通してHaskellでモナドを使った設計手法が、 少しでも多くの人に伝わってたら嬉しいなーとか思います。

そいでは、今回書いたコードをひと通り整理しておわります。

{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Monad.Trans.Maybe
import Control.Monad.State
import Control.Lens

type ActionPhase a = MaybeT (State ActionPhaseState) a

type Coins = Int

newtype Card = Card (ActionPhase ())

data ActionPhaseState = ActionPhaseState 
  { _coins :: Int
  , _action :: Int
  , _field :: Field
  }

data Field = Field
  { _hand :: [Card]
  , _deck :: [Card]
  , _trash :: [Card]
  }

makeLenses ''ActionPhaseState
makeLenses ''Field

----

play :: Card -> ActionPhase ()
play (Card cardAction) = do
  cardAction
  judge

stop :: ActionPhase ()
stop = MaybeT $ return Nothing

judge :: ActionPhase ()
judge = do
  action -= 1
  act <- use action
  if act < 0 then
    stop
  else
    return ()

runActionPhase :: Field -> ActionPhase a -> (Maybe a, ActionPhaseState)
runActionPhase fld = flip runState (mkState fld) . runMaybeT
  where
    mkState :: Field -> ActionPhaseState
    mkState f = ActionPhaseState { _coins = 0, _action = 0, _field = f }

----

farm :: Card
farm = Card $ do 
  coins += 1
  action += 1

city :: Card
city = Card $ do 
  coins += 2
  action += 1

alchemist :: Card
alchemist = Card $ do
  --読者への課題とする（ドヤ顔ダブルピース
  return ()

------

sample :: ActionPhase ()
sample = do
  play farm
  play farm
  play city
  play alchemist
  --これ以降はアクション数が足りないため無視される。
  play city
  play farm

sampleField :: Field
sampleField = Field
  { _hand = []
  , _deck = []
  , _trash = []
  }
  
main :: IO ()
main = do
  (a, s) <- return $ runActionPhase sampleField sample
  print $ a
  print $ s^.coins 

でわでわのしのし。