在基于回合的游戏中实现用户可扩展移动效果的通用方法？

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

在该设置中，游戏具有初始状态、有效走法类型和一个函数，该函数根据每个玩家在该回合中选择的走法来计算下一个状态(或获胜者)。这个定义足以创建任何一种基于回合的游戏-从像石头-剪刀这样简单的东西，到一个功能齐全的战斗RPG。下面是一个简单的决斗游戏：

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)]

然而，这种抽象存在一个问题:添加新的移动需要编辑类型的定义，从而编辑turn的源代码。如果你想让你的用户定义他们自己的动作，这是不够的。对于类似的基于回合的游戏，有没有什么抽象的东西，可以优雅地添加新的动作，而不需要修改原始代码？

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