标题有点不准确,因为我的特殊情况涉及更多点:与第一条记录中的函数不直接作用于第二条记录中的值相反,它们作用于值的列表(或其他可遍历)。可以假设,如果为某个特定领域申请的结果返回与该领域相同类型的值,那么这可以给我们带来任何好处。
例如:
data Foo = Foo { v1 :: Int , v2 :: Double } data FooFuns = FooFuns { v1 :: [Int] -> Int , v2 :: [Double] -> Double }
所以现在的目标是自动构建
result = Foo { v1 = (v1 FooFuns) (v1 <$> listOfFoos) , v2 = (v2 FooFuns) (v2 <$> listOfFoos) }
当前,我将该函数包装在值列表上,作为newtype
(可以被Higgledy的使用HKD
)和GADT用于Traversable约束,但是后一部分可能是不必要的,或者可能更好地建模为类型类:
data TraversableFun a t where TraversableFun :: Traversable t => (t a -> a) -> TraversableFun t a newtype ListFun a = ListFun {unTravFun :: TraversableFun [] a} type RecSummaryFuns a = HKD a ListFun
现在RecSummaryFuns a
应该具有与相同的“字段名称”(构造函数参数)a
。理想情况下会有一种能够方便地适用sFuns
于recs
以下获得一个记录了。
applyStatFuns :: Traversable t => RecSummaryFuns r -> t r -> r applyStatFuns sFuns recs = ???
我也很好奇这是否是对情况建模的最佳方法:基本上,我正在将摘要统计信息应用于记录中保存的值,但是我需要一种方法来封装每种记录类型的摘要统计信息。
现在,RecSummaryFuns应该具有与a相同的“字段名称”(构造函数参数)
此答案使用red-black-record构造“字段通用记录”,这些字段具有与原始记录相同的字段名称Foo
。首先,我们必须自动派生一些支持的类型类:
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- hide some scary types import Data.RBR (FromRecord (..), Record, ToRecord (..), fromNP, insert, toNP, unit) import Data.SOP (I (I), NP) -- from sop-core import Data.SOP.NP (liftA2_NP, liftA_NP) -- useful functions for n-ary products import GHC.Generics data Foo = Foo { v1 :: Int, v2 :: Double } deriving (Show, Generic, FromRecord, ToRecord)
现在,我们可以定义通用记录的值,该记录的字段将包含函数。可悲的是,我们不能采用通常的记录语法:
newtype Func a = Func ([a] -> a) -- helper newtype encapsulating the function type FooFunc = Record Func (RecordCode Foo) -- wrap every field in Func exampleFunc :: FooFunc exampleFunc = insert @"v1" (Func head) -- field names give with TypeApplications . insert @"v2" (Func last) -- same order as in the original record $ unit -- unit is the empty record
下一步是借助sop-core提供的n元产品数据类型定义此通用应用函数:
applyFunc :: _ => Record Func _ -> [r] -> r applyFunc func foos = let foos_NP :: [NP I _] -- a list of n-ary products. I is an identity functor foos_NP = toNP . toRecord <$> foos listfoos_NP :: [NP [] _] -- turn every component into a singleton list listfoos_NP = liftA_NP (\(I x) -> [x]) <$> foos_NP listfoo_NP :: NP [] _ -- a single n-ary product where each component is a list listfoo_NP = mconcat listfoos_NP func_NP :: NP Func _ -- turn the function record into a n-ary prod func_NP = toNP func resultFoo_NP_I :: NP I _ -- apply the functions to each list component resultFoo_NP_I = liftA2_NP (\(Func f) vs -> I (f vs)) func_NP listfoo_NP in fromRecord . fromNP $ resultFoo_NP_I -- go back to the nominal record Foo
放在一起:
main :: IO () main = print $ applyFunc exampleFunc [Foo 0 0.0, Foo 1 1.0] -- result: Foo {v1 = 0, v2 = 1.0}
此解决方案的可能缺点是编译时间较长,并且将列表Foo
转换成内部的Foo
with-list-fields applyFunc
对于长列表而言可能效率不高。
我们可以抛弃红黑记录(我们只是用它来保留通用记录中的字段名称),而直接依赖于sop-core / generics-sop。在这种情况下,字段名称的处理方式将有所不同,或者我们可以仅依靠位置匹配。