如何为Rel8库的PrimaryKeyed类型类定义通用的primaryKey类型签名

要让自定义的PrimaryKeyed类型类支持Expr、Result、Name等任意Rel8上下文，核心是结合Rel8的HKD（Higher-Kinded Data）设计和类型类的关联类型，实现多态的主键投影。

1. 定义表结构与PrimaryKeyed类型类 #

首先按照Rel8的规范定义表的HKD类型，然后通过类型类关联表与它的主键类型：

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}

import Rel8
import GHC.Generics

-- 定义表的HKD结构，ctx代表上下文（Expr/Result/Name等）
data BingBong ctx = BingBong
  { bingCol :: ctx Int32
  , bongCol :: ctx Int32
  , extraData :: ctx Text
  } deriving stock (Generic)
deriving anyclass instance Table BingBong

-- 定义PrimaryKeyed类型类，关联表与对应上下文的主键类型
class Table a => PrimaryKeyed a where
  type PrimaryKey a ctx :: Type
  primaryKey :: a ctx -> PrimaryKey a ctx

2. 为表实例化PrimaryKeyed #

针对BingBong表，指定它的主键是bingCol和bongCol的组合，同时让主键类型跟随上下文变化：

instance PrimaryKeyed BingBong where
  type PrimaryKey BingBong ctx = (ctx Int32, ctx Int32)
  primaryKey BingBong{bingCol, bongCol} = (bingCol, bongCol)

3. 适配多场景使用 #

现在primaryKey可以无缝适配所有Rel8上下文：

提取Result上下文的主键 #

-- 从查询结果中提取主键，得到(Result Int32, Result Int32)
extractResultPK :: BingBong Result -> (Result Int32, Result Int32)
extractResultPK = primaryKey

生成Expr上下文的主键 #

-- 从Expr构造的行中提取主键，用于查询条件或Upsert
extractExprPK :: BingBong Expr -> (Expr Int32, Expr Int32)
extractExprPK = primaryKey

构建Upsert操作 #

利用primaryKey直接生成Upsert所需的主键冲突目标：

mkUpsertPK :: (PrimaryKeyed a, Insert a) => a Expr -> Upsert a
mkUpsertPK row = upsert row (primaryKey row)

处理Name上下文（比如指定冲突字段） #

-- 获取表字段的名称，用于Upsert的冲突定义等场景
extractNamePK :: BingBong Name -> (Name Int32, Name Int32)
extractNamePK = primaryKey

核心原理 #

• Rel8的表类型本身就是上下文参数化的HKD结构，类型类的关联类型PrimaryKey a ctx可以跟随上下文动态生成对应类型的主键，避免了固定类型签名的局限性。
• Table a约束确保我们只对合法的Rel8表类型实例化PrimaryKeyed，贴合库的设计规范。

内容的提问来源于stack exchange，提问作者jedediah