6

标题有点不准确，因为我的特殊情况涉及更多：不是第一个记录中的函数直接作用于第二个记录中的值，而是作用于值的列表（或其他可遍历）。特定字段的应用程序结果返回与该字段相同类型的值，我们可以假设，如果这对我们有任何好处。

一个例子是这样的：

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)
}

目前，我正在将值列表中的函数包装为 a 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 = ???

我也很好奇这是否是模拟这种情况的最佳方式：基本上我将汇总统计信息应用于记录中保存的值，但我需要一种方法来封装每种记录类型的汇总统计信息。

4

1 回答 1

5

现在 RecSummaryFuns a 应该具有与 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-ary product数据类型的帮助下定义这个通用的 apply 函数：

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}

此解决方案的可能缺点是编译时间较长，而且将 list-of- Foos 转换为Foo内部的 -with-list-fieldsapplyFunc可能对于长列表效率低下。

我们可以抛弃red-black-record ——我们只使用它来保存通用记录中的字段名称——并直接依赖sop-core / generics-sop；在这种情况下，字段名称的处理方式会有所不同——或者我们可以简单地依赖位置匹配。

于 2019-11-16T11:27:02.780 回答