类型检查器可以帮助我吗？也许是类型家庭？

Question

所以我写这个小soccer game 有一段时间了，有一件事从一开始就让我烦恼。游戏遵循Yampa Arcade 模式，因此游戏中的“对象”有一个求和类型：

data ObjState = Ball Id Pos Velo
              | Player Id Team Number Pos Velo
              | Game Id Score

对象对消息做出反应，因此还有另一种 sum 类型：

data Msg = BallMsg BM
         | PlayerMsg PM
         | GameMsg GM
data BM = Gained | Lost
data PM = GoTo Position | Shoot
data GM = GoalScored | BallOutOfBounds

Yampa 框架依赖于所谓的信号函数。在我们的例子中，有球、球员和比赛行为的信号函数。粗略简化：

ballObj, playerObj, gameObj :: (Time -> (GameInput, [Msg])) 
                               -> (Time -> (ObjState, [(Id, Msg)]))

例如ballObj 接受一个函数，该函数产生 GameInput（击键，游戏状态，...）和在任何给定时间专门针对球的消息列表，并返回一个函数，该函数产生球的状态和它对其他对象的消息（球，游戏，玩家）在任何给定时间。在 Yampa 中，类型签名实际上看起来更好一些：

ballObj, playerObj, gameObj :: SF (GameInput, [Msg]) (ObjState, [(Id, Msg)])

这种统一的类型签名对于 Yampa 框架很重要：（再次，非常粗略地简化）它从 11 + 11（玩家）+1（球）+1（游戏）信号函数的列表中构建了一个大信号函数然后运行（通过 reactimate）的相同类型（通过 dpSwitch）。

所以现在，让我烦恼的是：将 BallMsg 发送给 Ball 或 PlayerMsg 发送给 Player 才有意义。例如，如果有人向 Ball 发送 GameMsg，程序就会崩溃。有没有办法让类型检查器就位以避免这种情况？我最近阅读了这篇关于类型族的精彩Pokemon 帖子，似乎有一些类比。所以也许这可能是一个起点：

class Receiver a where
  Msg a :: *
  putAddress :: Msg a -> a -> Msg a

data BallObj = ...
data GameObj = ...
data PlayerObj = ...

instance Receiver BallObj where
  Msg BallObj = Gained | Lost
(...)

现在，SF 函数可能看起来像这样：

forall b . (Receiver a, Receiver b) => SF (GameInput, [Msg a]) (a, [(b, Msg b)])

这会带我去任何地方吗？

Answer 1

浏览 yampa 街机纸，您似乎有一个从他们的示例中提取的 route 函数。

我的建议是你改变route，这样它就不需要一个对象列表，而是一个游戏对象、一个球对象和一组玩家对象。然后有

data BallMsg = ...
data PlayerMsg = ...
data GameMsg = ...

data AnyMsg = ABallMsg BallMsg
            | APlayerMsg PlayerMsg
            | AGameMsg GameMsg

现在route 处理统一的AnyMsg，但它会根据它们的内容将它们分派到正确的目的地。

Answer 2

乍一看，您的设计存在一个主要问题：您将完全不同的实体Ball、Player 和Game 结合在一个类型下。如果您需要对这些实体使用联合类型，请采用与消息相同的方式，将它们设为单独的类型，即：

data AnyObject = AnyObjectBall Ball
               | AnyObjectPlayer Player
               | AnyObjectGame Game

这样您就可以同时表达特定功能 (Ball -> BallMsg -> ...) 和一般功能 (AnyObject -> AnyMsg -> ...)。

但如果我正确理解您的问题，我想我有一个不需要联合类型的解决方案：

class Signal object message where
  signal :: SF (GameInput, [message]) (object, [(Id, message)])

data Ball = Ball Id Pos Velo
data BallMsg = BallMsgGained | BallMsgLost
instance Signal Ball BallMsg where
  -- ...

-- so on for Player and Game