为 Haskell 中的类型派生自定义类的实例

Question

我正在尝试减少 Copilot 中的样板数量。

在最近的版本中，我们添加了结构，使用它们需要声明两个实例。来自Copilot's repo 的示例如下。

对于数据类型：

data TestStruct = TestStruct
  { i :: Field "i" Int8
  }

我们需要实例：

instance Struct TestStruct where
  typename _ = "teststruct"
  toValues t = [ Value Int8 (i t) ]

instance Typed TestStruct where
  typeOf = Struct (TestStruct { i = Field 0 })

我想通过自动生成实例来使其更易于使用。

我一直在研究泛型，之前也使用过 Template Haskell，但过去几年情况发生了很大变化。许多软件包和推荐的解决方案现在已经过时了，我需要几个月的时间来浏览过去 10 年的论文和图书馆，后来才发现它们不再使用了。我无法理解编译器已经可以自动执行的操作、我应该使用哪些泛型扩展或包（如果有的话），并且通常无法找到一种有效且将继续有效的最新方法。

自动为这些类生成实例的最佳方法是什么？ （如果可能，我想避免使用 TH，但我知道从今天起可能无法实现。）

Answer 1

在大多数情况下，只需咨询GHC.Generics documentation即可实现最简单的实现。

@Jon Purdy 在评论中描述的方法很有价值，我以此为基础回答。

派生Typed

足够简单 - 为基本类型和泛型类型生成默认值的实现已经存在。 data-default-class 似乎很适合，尽管这不是建议：我刚刚选择了第一个 Hoogle 结果。

default typeOf :: (Typeable a, Struct a, Default a) => Typed a
typeOf = Struct def

然后可以只派生 Default 和 Typed 以获得良好的实现。

上面需要Default 的Field 实例，但这几乎是显而易见的

instance (Default f) => Default (Field n f) where
  def = Field def

派生Struct

这是一个比较棘手的问题，因为它需要触及泛型的核心。但是，看看 Copilot 的具体用例，我们似乎可以忽略很多可能的事情（比如多个构造函数等）。

这个答案的较长形式也可以说为D1 和C1 之类的东西提供递归实例，如果它们被证明是必要的。

派生typename

没有必要 - 只需使用 type constructor metadata。如果你真的想要，定义一个类

class TypeName' f where
  typename' :: f p -> String

但它只需要 D1 的单个实例。

派生toValues

这需要constructor argument representation。定义一个类

class ToValues' a f where
  toValues' :: Proxy a -> f p -> [Value a]

a 是一个类参数，因为它在机械上必须是，而Proxy 是一个函数参数，因为否则 GHC 会抱怨 a 没有出现 - 并且没有资金可以帮助解决这个问题。

多个字段的表示是通过产品表示:*:组合多个字段来完成的。这意味着需要有一个用于单例字段 S1 的实例和一个用于两个子实例的乘积的实例。

定义实例并不难

instance (Typed c, KnownSymbol fieldName) => ToValues' a (S1 m (Rec0 (Field fieldName c))) where
  toValues' p (M1 (K1 field)) = [Value (typeOf @c) field]

上面的实例给每个字段一个单例，产品可以进行拼接

instance (ToValues' a l, ToValues' a r) => ToValues' a (l :*: r) where
  toValues' p (l :*: r) = toValues' p l ++ toValues' p r

实例

我在这里使用类型统一~ 进行类型级别的模式匹配。

default typename :: (Generic a, Rep a ~ D1 ('MetaData typeName m p nt) f), KnownSymbol typeName) => a -> String
typename _ = toLower (symbolVal (Proxy @typeName))

default toValues :: (Generic a, Rep a ~ D1 m1 (C1 m2 f), ToValues' a f) => a -> [Value a]
toValues a = toValues' (Proxy @a) fields
  where (M1 (M1 fields)) = (from a)

toLower 只是一个String-lowercasing 函数，尽管您必须定义它。 symbolVal 为类型级别的Symbol 提供String。

toValues 代码通过将Rep a 约束为D1 _ (C1 _ _) 的形式，假设有一个数据构造函数。

和以前一样，现在可以只派生Generic 和Struct 来获得这个有用的实例。