为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，但是在过去几年中，情况发生了很大变化。现在，许多软件包和推荐的解决方案已经过时了，我花了几个月的时间浏览了过去十年的论文和图书馆，才发现后来它们不再使用了。我无法理解编译器可以自动执行的操作，应该使用的泛型扩展或程序包（如果有），并且通常无法找到一种可行且将继续有效的最新方法。

自动为这些类生成实例的最佳方法是什么？ （如果可能，我想避免使用TH，但据我所知，到目前为止，这是不可能的。）

Answer 1

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

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

派生GHC.Generics

非常简单-已经存在用于为基本类型和泛型类型生成默认值的实现。 Typed似乎很适合，但不建议这样做：我只是选择了第一个Hoogle结果之一。

data-default-class

然后可以导出data-default-class和

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

以获得良好的实现。

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

Default

派生Field

这是一个比较棘手的问题，因为它需要触摸泛型的胆量。但是，从Copilot的特定用例来看，似乎我们可以忽略很多可能的事情（例如多个构造函数等）。

此答案的较长形式也可以说是为

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

和Struct之类的对象提供了递归实例，如果发现它们是必需的。

派生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]

是一个函数参数，因为否则GHC会抱怨a不出现-并且没有任何胃底有助于解决该问题。

多个字段的表示是通过结合多个字段的产品表示Proxy完成的。这意味着单例字段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的symbolVal。

String代码通过将Symbol约束为toValues的形式，假设存在单个数据构造函数。

像以前一样，现在可以仅导出Rep a和D1 _ (C1 _ _)来获得此有用的实例。