通用结合Profunctor：基于generics-sop实现recordSelectorToData函数

目标函数定义 #

我想要实现的核心函数如下：

recordSelectorToData :: forall c a f xs. 
  (All c xs, IsProductType a xs, Applicative f) => 
  (forall b. c b => (a -> b) -> f b) -> f a

其中All和IsProductType来自generics-sop库，参数里的(a -> b)是当前处理字段的记录选择器。它的特化函数profunctorToData能更清晰体现用途：

profunctorToData :: forall c a p xs. 
  (All c xs, IsProductType a xs, Profunctor p, Applicative (p a)) =>
  (forall b. c b => p b b) -> p a a
profunctorToData x = recordSelectorToData @c (`lmap` x)

核心逻辑：如果类型是积类型、所有字段满足约束c，且能为每个字段构造Profunctor（其末值是Applicative），就能组合所有字段的Profunctor得到对应积类型的Profunctor。

autodocodec场景需求 #

我基于autodocodec库开发，它能通过一次定义生成ToJSON、FromJSON和ToSchema实例，核心类型Codec具备Functor、Applicative特性和lmapCodec函数，可以定义为Profunctor。

已手动为部分类型定义了Codec，但对于像MyRecord1这种派生Generic的记录类型，希望借助FieldName类自动生成Codec：

data MyRecord1 = MyRecord1 
{ firstName :: FirstName
, lastName :: LastName
} deriving stock (Generic)

class HasCodec a => FieldName a where
  fieldName :: Text

instance FieldName FirstName where
  fieldName = "firstname"

instance FieldName LastName where
  fieldName = "sirname" 

我还写了makeObjectCodec函数：

makeObjectCodec :: (HasCodec b, FieldName b) => (a -> b) -> Object a b
makeObjectCodec f = requiredField (fieldName @b) .= f

期望通过recordSelectorToData @FieldName makeObjectCodec生成MyRecord1的Codec，但不清楚如何从generics-sop中提取可用的记录选择器函数，只知道需要用projections，求具体实现方案。

实现方案 #

要实现recordSelectorToData，关键是利用generics-sop的projections函数获取记录的所有字段选择器，再结合Applicative的组合能力构造最终的f a。

完整实现代码 #

首先导入必要的模块：

import Generics.SOP
import Generics.SOP.NP
import Control.Applicative

然后实现recordSelectorToData：

recordSelectorToData :: forall c a f xs. 
  (All c xs, IsProductType a xs, Applicative f) => 
  (forall b. c b => (a -> b) -> f b) -> f a
recordSelectorToData f = to . hsequence $ hcpure (Proxy @c) (\proj -> f (unK proj))
  where
    -- 获取当前积类型的所有字段选择器，包装成NP (K (a -> b)) xs
    projections :: NP (K (a -> b)) xs
    projections = projections' (Proxy @xs) (from (error "unused" :: a))

这里的projections'是generics-sop中projections的类型特化版本，它能从a的泛型表示中提取出所有字段的选择器函数，每个选择器被包装在K新类型里。

通过hcpure为每个选择器应用f，得到一个NP f xs，再用hsequence把这个积类型的Applicative值转换成f (NP I xs)，最后用to把泛型表示转换回原始类型a。

测试生成Codec #

现在可以用这个函数为MyRecord1生成Codec：

instance HasCodec MyRecord1 where
  codec = objectCodec $ recordSelectorToData @FieldName makeObjectCodec

这样就能自动为MyRecord1生成包含firstname和sirname字段的Codec，无需手动编写每个字段的定义。

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