如何在Haskell中建模混合/multiple接口？

Question

我看到了如何在Haskell中建模继承问题，这让我想起我自己有一个更复杂版本的同样问题。我会采用那里的例子，因为它比我自己想出来的更容易理解。

假设你的程序包含多个类型：

data Camera = Camera ...
data Light = SpotLight ... | DirectionalLight ...
data Object = Monster ... | Player ... | NPC ...

现在您想要实现一些基本物理，因此您希望它们都有一个位置和速度，比如说使用某种类型的Vec3。

一种方法是声明一个Physical类型类，具有pos和vel函数，并使所有类型成为其实例。但这意味着您必须修改所有类型以包含两个Vec3，如果您已经定义了很多不错的类型并且只想在其上添加一点功能，则这很麻烦。克里斯·泰勒提出的基于镜头的解决方案也面临同样的问题。

我觉得更整洁的解决方案是声明一个新的类型构造器，

data Physical a = Physical a Vec3 Vec3

然后，您只需要实现pos、vel和Functor实例一次，就可以保留所有现有类型声明。

但是...这并不很好地组合。如果你现在想要能够将你的对象涂成蓝色、绿色或紫色，你可能也想用颜色做同样的事情：

data Coloured a = Coloured a Colour

但是，如果您有一个彩色物理相机，那么根据您想查看其颜色、位置或焦距，您必须进行不同数量的fmap。而且，彩色物理相机应该与物理彩色相机是相同的东西，但它并不是。所以这不是一种优雅的解决方案。

有没有一种好的方法来混合不同的功能集到Haskell类型中？一个简单的解决方案，在没有语言扩展或大量样板的情况下工作的普通Haskell将是理想的，但如果透镜相关的库真的是解决问题的最佳方式，我也可以学习它们。

（这个旧问题关于mixins-style代码复用似乎相关，但恐怕我不完全理解问题或接受的解决方案。）

- user445408

Answer 1

也许我们可以学习不被重视的mtl包，将之前建议的两种方法结合起来：声明两个类型构造器（并使它们成为functor），并声明相应的typeclasses/instances。

但这里的技巧是：我们将使用transformers中的Data.Functor.Compose来组合functors，然后定义额外的“传递”实例，以使内部层的方法在外部层可用。就像mtl为monad transformers所做的一样！

首先，一些预备工作：

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}

import Data.Functor.Compose

data Camera = Camera
data Light = SpotLight | DirectionalLight 
data Object = Monster | Player | NPC

data Vec3 = Vec3C -- dummy type 
data Colour = ColourC -- dummy type

数据定义：

data Physical a = Physical a Vec3 Vec3 deriving Functor
data Coloured a = Coloured a Colour deriving Functor

相应的类型类：

class Functor g => FunctorPhysical g where
    vecs :: g a -> (Vec3,Vec3)  

class Functor g => FunctorColoured g where
    colour :: g a -> Colour

基本实例：

instance FunctorPhysical Physical where
    vecs (Physical _ v1 v2) = (v1,v2) 

instance FunctorColoured Coloured where
    colour (Coloured _ c) = c

现在让我们来介绍mtl灵感启发的技巧——透传实例！

instance Functor f => FunctorPhysical (Compose Physical f) where
    vecs (Compose f) = vecs f

instance Functor f => FunctorColoured (Compose Coloured f) where
    colour (Compose f) = colour f

instance FunctorPhysical f => FunctorPhysical (Compose Coloured f) where
    vecs (Compose (Coloured a _)) = vecs a

instance FunctorColoured f => FunctorColoured (Compose Physical f) where
    colour (Compose (Physical a _ _)) = colour a

一个示例值：

exampleLight :: Compose Physical Coloured Light
exampleLight = Compose (Physical (Coloured SpotLight ColourC) Vec3C Vec3C) 

您应该能够使用上述值的vecs和colour。

编辑：上述解决方案存在一个问题，即访问原始包装值很麻烦。这里是另一个使用共范畴的版本，它允许您使用extract来获取包装的值。

import Control.Comonad
import Control.Comonad.Trans.Class
import Control.Comonad.Trans.Env
import Data.Functor.Identity

data PhysicalT w a = PhysicalT { unPhy :: EnvT (Vec3,Vec3) w a } 

instance Functor w => Functor (PhysicalT w) where
  fmap g (PhysicalT wa) = PhysicalT (fmap g wa)

instance Comonad w => Comonad (PhysicalT w) where
  duplicate (PhysicalT wa) = PhysicalT (extend PhysicalT wa)
  extract (PhysicalT wa) = extract wa

instance ComonadTrans PhysicalT where
  lower = lower . unPhy

--
data ColouredT w a = ColouredT { unCol :: EnvT Colour w a } 

instance Functor w => Functor (ColouredT w) where
  fmap g (ColouredT wa) = ColouredT (fmap g wa)

instance Comonad w => Comonad (ColouredT w) where
  duplicate (ColouredT wa) = ColouredT (extend ColouredT wa)
  extract (ColouredT wa) = extract wa

instance ComonadTrans ColouredT where
  lower = lower . unCol

class Functor g => FunctorPhysical g where
    vecs :: g a -> (Vec3,Vec3)  

class Functor g => FunctorColoured g where
    colour :: g a -> Colour

instance Comonad c => FunctorPhysical (PhysicalT c) where
    vecs = ask . unPhy

instance Comonad c => FunctorColoured (ColouredT c) where
    colour = ask . unCol

-- passthrough instances    
instance (Comonad c, FunctorPhysical c) => FunctorPhysical (ColouredT c) where
    vecs = vecs . lower

instance (Comonad c, FunctorColoured c) => FunctorColoured (PhysicalT c) where
    colour = colour . lower

-- example value
exampleLight :: PhysicalT (ColouredT Identity) Light
exampleLight = PhysicalT . EnvT (Vec3C,Vec3C) $ 
               ColouredT . EnvT ColourC       $ Identity SpotLight

很遗憾，它需要更多的样板文件。就我个人而言，我会使用嵌套的EnvT变换器，代价是访问不够统一。

- danidiaz

---

有趣的想法。不幸的是，似乎“Compose”方法需要对n个mixin进行O(n^2)遍历实例声明。 - user445408

然而，由于它们都是常规的，您可能可以使用Template Haskell来生成这些函数。 - user1937198

Answer 2

您是否知道元组（Tuple）的元数为2时具有Functor实例，它可以对第二个项进行映射？我们可以利用它来获得好处。

data PositionAndVelocity = PositionAndVelocity Vec3 Vec3
data Colour = ...

f1 :: (PositionAndVelocity, Camera) -> ...
f2 :: (Colour, Camera) -> ...

- Nikita Volkov

---

它并没有解决可组合性问题，即对于(Colour, (PositionAndVelocity, Camera))的嵌套fmap以及(Colour, (PositionAndVelocity, Camera)) ≠ (PositionAndVelocity, (Colour, Camera))这一事实。 - user445408

Answer 3

进一步思考后，我认为这基本上是可扩展记录的工作，假设其具有置换性。据我所知，您只需处理形式为(r，a)的值，其中r是包含所有混合数据的记录，而a是您想要的原始值。对于第二个参数，成对已经是一个Functor，因此您可以fmap所有现有函数。对于混入，您可以定义诸如

pos :: (r <: {_pos :: Vec3}) => (r, a) -> Vec3
pos (r, a) = r._pos

等等，一个有颜色的物理相机只是类型为(r, Camera)的值，其中r <: {_pos :: Vec3，_vel :: Vec3，_colour :: Colour}。

很遗憾，所有这些在标准Haskell中都不存在。噢，那我去看看可扩展记录库吧。

- user445408

Answer 4

尽管我仍怀疑我们应该从另一个角度思考整个事情，减少面向对象的影响，这里提供另一种可能的解决方案。虽然二维图形程序似乎是更好的例子，但我将坚持使用 Monsters 的示例。

{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, DeriveFunctor, FlexibleContexts #-}

import Control.Monad.Identity

class (Functor f, Functor (PropT f p)) => AttachProp f p where
  type PropT f p :: * -> *
  attachProp :: p -> f o -> PropT f p o
  detachProp :: PropT f p o -> (p, f o)

fmapProp :: (AttachProp f p, AttachProp f p')
  => f o -- dummy parameter (unevaluated), because type-functions aren't injective
         -> (p -> p') -> PropT f p o -> PropT f p' o
fmapProp q f pt = let (p, fo) = detachProp pt
                  in attachProp (f p) $ fo `asTypeOf` q


data R3Phys = R3Phys { position, momentum :: Vec3 }
data Colour = Colour

data Physical a = Physical R3Phys a deriving (Functor)
data Coloured a = Coloured Colour a deriving (Functor)
data PhysColoured a = PhysColoured Colour R3Phys a deriving (Functor)

instance AttachProp Identity R3Phys where
  type PropT Identity R3Phys = Physical
  attachProp rp = Physical rp . runIdentity
  detachProp (Physical rp o) = (rp, Identity o)
instance AttachProp Identity Colour where
  type PropT Identity Colour = Coloured
  attachProp c = Coloured c . runIdentity
  detachProp (Coloured c o) = (c, Identity o)
instance AttachProp Coloured R3Phys where
  type PropT Coloured R3Phys = PhysColoured
  attachProp rp (Coloured c o) = PhysColoured c rp o
  detachProp (PhysColoured c rp o) = (rp, Coloured c o)
instance AttachProp Physical Colour where
  type PropT Physical Colour = PhysColoured
  attachProp c (Physical rp o) = PhysColoured c rp o
  detachProp (PhysColoured c rp o) = (c, Physical rp o)

请注意，PropT（PropT Identity R3Phys）Colour a和PropT（PropT Identity Colour）R3Phys a是同一类型，即PhysColoured a。当然，对于n个混合物，我们需要再次使用O（n²）个实例。虽然可以很容易地使用Template Haskell完成，但显然如果您想要那样做，应该三思而后行。

- leftaroundabout

---

那么，非面向对象编程的实现会是什么样子呢？ - The Coding Wombat

Answer 5

也许这个颜色示例并不是特别好，但在我看来，你永远不应该真正需要它，如果它起作用了，那么实际上也不会很好。

Physical确实是您提出的方式非常自然：一个Monster、Camera等本身没有位置，而是通过将这样的对象与一些空间结合使用来获得位置。

但是Coloured是不同的，因为颜色是物体本身的属性，并且对于怪物和相机来说，其含义可能会有很大的不同，因此与Physical不同，类型类在这里似乎是合理的。如果有的话——也许更好的方法是手动处理各种颜色的单态函数。

当然，您可能会想以这种方式考虑：事物本身没有颜色，但它们穿着有颜色的外皮。我认为这不应该是拥有颜色的唯一方式，但是...好吧，我们显然可以提供这样的“外皮”，使无色的对象也变得有色：

data ClSkin a = ClSkind { clSkinColour :: Colour
                        , clSkinned :: a         }
instance Coloured (Clsskin a) where
  colour = clSkinColour

现在你说使用Physical (ClSkin a)或ClSkin (Physical a)并不重要。我认为它确实很重要。再次强调，Physical是一种对象和其所在空间的组合。当然，您不希望给整个空间上色！因此，Physical (ClSkin a)是唯一有意义的变体。或者，您可以说颜色只对物理空间中的对象有意义。那么，您只需将颜色作为该数据的额外字段即可！

data Physical a = Physical a Vec3 Vec3 (Maybe Colour)

- leftaroundabout

---

假设“物理”和“彩色”的语义只是（不是特别好的）例子，而我可以提出其他其中所需属性的正交性较少受到质疑的例子。按照陈述的技术问题能否解决？ - user445408

例如，如果我正在编写一个2D绘图程序，并且已经实现了基本形状，我希望为它们附加填充颜色、分层顺序、序列化标识等属性。 - user445408

@RahulNarain 或许，你可以尝试将每个方面存储在单独的映射中，而不是使用mixin。这个其他问题可能会有所帮助：https://dev59.com/wnjZa4cB1Zd3GeqPbTl_#19502945 - danidiaz