haskell - 回合制游戏中用户可扩展移动效果的一般方法？

Question

回合制游戏的简单形式可以用函数式语言抽象为:

data Player 
  = PlayerA
  | PlayerB
  deriving Show

data Game state move = Game {
  start :: state,
  turn :: (move, move)
    -> state
    -> Either Player state}

play :: [(m, m)] -> Game s m -> Maybe Player
play moves game 
  = either Just (const Nothing) 
  $ foldr tick (Right (start game)) moves where
    tick move (Right state) = turn game move state
    tick move p = p

在该设置中，游戏有一个初始状态、一种有效移动，以及一个根据每个玩家在该回合选择的移动计算下一个状态(或获胜者)的函数。这个定义足以创建任何类型的回合制游戏——从简单的剪刀石头布到功能齐全的战斗角色扮演游戏。这是一个简单的决斗游戏:

data DuelMove = Punch | Guard | Rest

data DuelState = DuelState {
  p1hp :: Int,
  p2hp :: Int}
  deriving Show

duel :: Game DuelState DuelMove 
duel = Game start turn where

  start = DuelState 4 4

  turn (ma,mb) (DuelState p1 p2) 
    | p1 <= 0 = Left PlayerB
    | p2 <= 0 = Left PlayerA
    | otherwise = attack ma mb where
      attack Punch Punch = Right (DuelState (p1-1) (p2-1))
      attack Punch Guard = Right (DuelState (p1-2) (p2+0))
      attack Punch  Rest = Right (DuelState (p1+0) (p2-2))
      attack Guard Punch = Right (DuelState (p1+0) (p2-2))
      attack Guard Guard = Right (DuelState (p1+0) (p2+0))
      attack Guard  Rest = Right (DuelState (p1+0) (p2+2))
      attack  Rest Punch = Right (DuelState (p1-2) (p2+0))
      attack  Rest Guard = Right (DuelState (p1+0) (p2+2))
      attack  Rest  Rest = Right (DuelState (p1+2) (p2+2))

main :: IO ()
main = print $ play moves duel where
  moves = [
    (Punch, Punch),
    (Punch, Guard),
    (Guard, Punch),
    (Rest, Rest),
    (Punch, Guard),
    (Guard, Punch),
    (Punch, Rest)]

不过，这种抽象存在一个问题:添加新 Action 需要编辑类型的定义，因此需要编辑 turn 的源代码。如果您想让您的用户定义他们自己的 Action ，这还不够。是否有类似回合制游戏的抽象，优雅地允许在不修改原始代码的情况下添加新 Action ？

Answer 1

一个简单的技巧是参数化 turn 函数。因此:

type DuelMovePlus = Either DuelMove

turn :: (a -> DuelMove -> Either Player DuelState)
     -> (DuelMove -> a -> Either Player DuelState)
     -> (a -> a        -> Either Player DuelState)
     -> DuelMovePlus a -> DuelMovePlus a -> Either Player DuelState
turn userL userR userLR = \case
    (Left  l, Left  r) -> {- same code as before -}
    (Left  l, Right r) -> userR  l r
    (Right l, Left  r) -> userL  l r
    (Right l, Right r) -> userLR l r