推断两个记录中公共字段的类型
infer a type for common fields in two records
如果这是一个愚蠢的问题，请多多包涵。我怎样才能 键入 一个通用函数，它接受两条记录并且 return 是它们的公共字段的数组？
假设我有：
type A = { name :: String, color :: String }
type B = { name :: String, address :: Address, color :: String }
myImaginaryFunction :: ???
-- should return ["name", "color"] :: Array of [name color]
我想编写一个函数，它接受 ANY 两种类型的记录和 return 一组公共字段。 haskell 解决方案也可以。
好吧，既然你的函数确实 return 是一个字符串数组，那么 return 类型应该只是 Array String.
参数类型将是遗传的，因为您事先不知道类型。如果你真的想确保这些类型实际上是记录，你可以让你的泛型参数不是记录本身，而是 type rows，然后 type value parameters as Record a。
所以：
myImaginaryFunction :: forall a b. Record a -> Record b -> Array String
你就是这样输入这样的函数的。
或者您的问题真的是关于如何实施吗？
另外：你有没有注意到作弊（通过添加 Haskell 标签）并没有真正给你带来任何帮助，而只是一些责骂？请不要这样做。尊重社区。
要在 Haskell 中表达具有公共字段的两种记录类型，您需要一个 GHC 扩展：
{-# LANGUAGE DuplicateRecordFields #-}
要反省字段名称，您需要基于 Data class:
的泛型
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Data ( Data, Typeable, DataRep(AlgRep), dataTypeRep
, dataTypeOf, constrFields)
import Data.List (intersect)
import Data.Proxy (Proxy(..), asProxyTypeOf)
这将允许您使用相同的字段名称定义两种数据类型：
data Address = Address String deriving (Typeable, Data)
data A = A { name :: String, color :: String }
deriving (Typeable, Data)
data B = B { name :: String, address :: Address, color :: String}
deriving (Typeable, Data)
然后您可以使用以下方法检索字段名称：
fieldNames :: (Data t) => Proxy t -> [String]
fieldNames t = case dataTypeRep $ dataTypeOf $ asProxyTypeOf undefined t of
AlgRep [con] -> constrFields con
并获取公共字段：
commonFields :: (Data t1, Data t2) => Proxy t1 -> Proxy t2 -> [String]
commonFields t1 t2 = intersect (fieldNames t1) (fieldNames t2)
之后将执行以下操作：
ghci> commonFields (Proxy :: Proxy A) (Proxy :: Proxy B)
["name", "color"]
ghci>
请注意，上面 fieldNames 的实现假定只有具有单个构造函数的记录类型才会被自省。如果您想概括它，请参阅 Data.Data 的文档。
现在，因为你是一个吸血鬼，我知道你会需要一个类型级别的函数，即使你在你的问题中没有说需要一个 type-level 函数！事实上，我可以看到您已经添加了一条评论，说明您如何有兴趣以某种方式返回 name | color 的数组，尽管 Haskell 中不存在这样的东西，即使您在问题中明确表示您期望 term-level 答案 ["name", "color"].
不过，可能会有 non-vampires 有类似的问题，也许这个答案会对他们有所帮助。
对于Haskell，我喜欢K.A。 Buhr 的回答，但我个人不会使用 Typeable，而是使用 GHC Generics。不过，我认为这可能是目前的偏好。
对于 PureScript，我本月早些时候在我的博客 post Making Diffs of differently-typed Records in PureScript 中写过此类问题。该方法与您使用没有行类型的语言所采用的方法完全不同（不，Elm 没有这些。除了使用同类字符串映射之外，您真的没有其他解决方案）。
首先，如果您完全熟悉 PureScript，您可能想使用 Union，但这也行不通，因为您想要执行类似以下操作：
Union r1' r r1
其中 r1' 是第一个记录 r1 和 r2 之间共享子类型 r 的补充。原因是这里有两个未求解的变量，并且 Union 的函数依赖性要求求解 Union 的三个参数中的任意两个。
因此，由于我们不能直接使用 Union，因此我们必须制定某种解决方案。由于我可以获得按键排序的 RowList 结构，因此我选择使用它遍历两个不同记录的 RowList 并找出交集：
class RowListIntersection
(xs :: RowList)
(ys :: RowList)
(res :: RowList)
| xs ys -> res
instance rliNilXS :: RowListIntersection Nil (Cons name ty tail) Nil
instance rliNilYS :: RowListIntersection (Cons name ty tail) Nil Nil
instance rliNilNil :: RowListIntersection Nil Nil Nil
instance rliConsCons ::
( CompareSymbol xname yname ord
, Equals ord EQ isEq
, Equals ord LT isLt
, Or isEq isLt isEqOrLt
, If isEq xty trashty yty
, If isEq xty trashty2 zty
, If isEq (SProxy xname) trashname (SProxy zname)
, If isEq
(RLProxy (Cons zname zty res'))
(RLProxy res')
(RLProxy res)
, If isEqOrLt
(RLProxy xs)
(RLProxy (Cons xname xty xs))
(RLProxy xs')
, If isLt
(RLProxy (Cons xname yty ys))
(RLProxy ys)
(RLProxy ys')
, RowListIntersection xs' ys' res'
) => RowListIntersection (Cons xname xty xs) (Cons yname yty ys) res
然后我使用了一个简短的定义来获取结果 RowList 的键：
class Keys (xs :: RowList) where
keysImpl :: RLProxy xs -> List String
instance nilKeys :: Keys Nil where
keysImpl _ = mempty
instance consKeys ::
( IsSymbol name
, Keys tail
) => Keys (Cons name ty tail) where
keysImpl _ = first : rest
where
first = reflectSymbol (SProxy :: SProxy name)
rest = keysImpl (RLProxy :: RLProxy tail)
因此，我可以一起定义一个函数来获取共享标签：
getSharedLabels
:: forall r1 rl1 r2 rl2 rl
. RowToList r1 rl1
=> RowToList r2 rl2
=> RowListIntersection rl1 rl2 rl
=> Keys rl
=> Record r1
-> Record r2
-> List String
getSharedLabels _ _ = keysImpl (RLProxy :: RLProxy rl)
然后就可以看到我们期待的结果了：
main = do
logShow <<< Array.fromFoldable $
getSharedLabels
{ a: 123, b: "abc" }
{ a: 123, b: "abc", c: true }
-- logs out ["a","b"] as expected
如果您是 RowList/RowToList 的新手，可以考虑通读我的 RowList Fun With PureScript 2nd Edition 幻灯片。
我把这个答案的代码放在 here。
如果这一切看起来过于复杂，您的其他解决方案可能是将记录强制转换为字符串映射并获取键的集合并集。我不知道这是否是 Elm 中的答案，因为 String Map 的运行时表示可能与 Record 不匹配。但是对于 PureScript，这是一个选项，因为 StrMap 的运行时表示与 Record 相同。
实际上，经过更多考虑后，我想 有可能做你实际上想做的事 =206=]，如果您实际上 想要做的是在类型级别使用具有命名字段的记录类型，包括执行诸如 compile-time 推导新记录之类的事情使用其他两个记录的公共字段键入。
它有点复杂而且有点难看，尽管有些位工作得非常好。是的，当然是 "too much ceremony for such a simple task"，但请记住，我们正在尝试实现一个全新的 non-trivial、type-level 功能（一种依赖结构类型）。使这项任务变得简单的唯一方法是从一开始就将该功能融入语言及其类型系统；否则会很复杂。
无论如何，在我们获得 DependentTypes 扩展之前，您必须显式启用少量（哈哈）扩展：
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wincomplete-patterns #-}
module Records where
我们将充分利用 singletons 包及其子模块：Prelude 用于基本 type-level 功能，如 Map、Fst, 和 Lookup; TH 模块，用于使用模板 Haskell 拼接生成我们自己的单例和提升函数；和 TypeLits 用于使用 Symbol 类型（即，类型级别的字符串文字）。
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Singletons.TypeLits
我们还需要一些其他的杂物。之所以需要 Text，是因为它是 Symbol.
的未提升 ("demoted") 版本
import Data.Function ((&))
import Data.Kind (Type)
import Data.List (intersect)
import qualified Data.Text as Text
我们将无法处理通常的 Haskell 记录。相反，我们将定义一个 Record 类型的构造函数。此类型构造函数将由 (Symbol, Type) 对列表索引，其中 Symbol 给出字段名称，Type 给出存储在该字段中的值的类型。
data Record :: [(Symbol, Type)] -> Type where
这个设计决策已经有几个主要影响：
- 不同记录类型中的相同字段名可以引用不同的字段值类型。
- 字段在记录中是有序的，所以记录类型只有在具有相同字段、相同类型、相同顺序.[=171=时才相同]
- 同一字段可以在一条记录中出现多次，即使我们提供的访问器函数只会访问一个（最后添加的）。
在依赖类型的程序中，设计决策往往 运行 很深。例如，如果同一个字段不能出现多次，我们需要找到一种方法在类型中反映这一点，然后确保我们所有的函数都能够提供适当的证据，证明没有添加重复的字段.
无论如何，回到我们的 Record 类型构造函数。将有两个数据构造函数，一个 Record 构造函数来创建一个空记录：
Record :: Record '[]
和一个 With 构造函数，用于向记录添加字段：
With :: SSymbol s -> t -> Record fs -> Record ('(s, t) : fs)
注意With需要一个运行时间代表s :: Symbol以符号单例SSymbol s的形式方便函数with_将使这个单例隐式：
with_ :: forall s t fs . (SingI s) => t -> Record fs -> Record ('(s, t) : fs)
with_ = With sing
我们的想法是，通过允许不明确的类型和使用类型应用程序，我们公开了以下用于定义记录的合理简洁的语法。显式类型签名在这里不是必需的，但包括在内以明确正在创建的内容：
rec1 :: Record '[ '("bar", [Char]), '("foo", Int)]
rec1 = Record & with_ @"foo" (10 :: Int)
& with_ @"bar" "Hello, world"
-- i.e., rec1 = { foo = 10, bar = "Hello, world" } :: { foo :: Int, bar :: String }
rec2 :: Record '[ '("quux", Maybe Double), '("foo", Int)]
rec2 = Record & with_ @"foo" (20 :: Int)
& with_ @"quux" (Just 1.0 :: Maybe Double)
-- i.e., rec2 = { foo = 20, quux = Just 1.0 } :: { foo :: Int, quux :: Maybe Double }
为了证明这种记录类型是有用的，我们将定义一个type-safe 字段访问器。这是一个使用显式单例 select 字段的方法：
field :: forall s t fs . (Lookup s fs ~ Just t) => SSymbol s -> Record fs -> t
field s (With s' t r)
= case s %:== s' of
STrue -> t
SFalse -> field s r
和一个带有隐含单例的助手：
field_ :: forall s t fs . (Lookup s fs ~ Just t, SingI s) => Record fs -> t
field_ = field @s sing
旨在与这样的类型应用程序一起使用：
exField = field_ @"foo" rec1
请注意，尝试访问不存在的字段不会 type-check。错误消息并不理想，但至少是 compile-time 错误：
-- badField = field_ @"baz" rec1 -- gives: Couldn't match type Nothing with Just t
field 的定义暗示了 singletons 库的强大功能。我们正在使用 type-level Lookup 函数，该函数是通过模板 Haskell 从 term-level 定义中自动生成的，该定义看起来与以下内容完全相同（取自 singletons 来源并重命名以避免冲突）：
lookup' :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup' _key [] = Nothing
lookup' key ((x,y):xys) = if key == x then Just y else lookup' key xys
仅使用上下文 Lookup s fs ~ Just t，GHC 能够确定：
因为上下文暗示这个字段会在列表中找到，所以field的第二个参数永远不能是空记录Record，所以没有警告field 的不完整模式，事实上，如果您尝试通过添加大小写将其作为 运行 时间错误来处理，您将收到类型错误：field s Record = error "ack, something went wrong!"
如果我们在 SFalse 分支中，对 field 的递归调用是 type-correct。也就是说，GHC 已经计算出，如果我们可以成功 Lookup 列表中的键 s 但它不在头部，我们必须能够在尾部查找它。
（这对我来说太棒了，但无论如何......）
这些是我们记录类型的基础。为了在 运行 时间或编译时间检查字段名称，我们将引入一个帮助程序，我们将其提升到类型级别即，type-level 函数 Names) 使用模板 Haskell:
$(singletons [d|
names :: [(Symbol, Type)] -> [Symbol]
names = map fst
|])
请注意，type-level 函数 Names 可以提供 compile-time 访问记录的字段名称，例如在假设的类型签名中：
data SomeUIType fs = SomeUIType -- a UI for the given compile-time list of fields
recordUI :: Record fs -> SomeUIType (Names fs)
recordUI _ = SomeUIType
不过，我们更有可能希望在 运行 时使用字段名称。使用 Names，我们可以定义以下函数来获取记录和 return 其字段名称列表作为单例。这里，SNil 和 SCons 是术语 [] 和 (:).
的单例等价物
sFields :: Record fs -> Sing (Names fs)
sFields Record = SNil
sFields (With s _ r) = SCons s (sFields r)
这里有一个 return 是 [Text] 而不是单例的版本。
fields :: Record fs -> [Text.Text]
fields = fromSing . sFields
现在，如果你只想得到一个运行两条记录的公共字段时间列表，你可以这样做：
rec12common = intersect (fields rec1) (fields rec2)
-- value: ["foo"]
在编译时创建具有公共字段的类型怎么样？好吧，我们可以定义以下函数来获取 left-biased 具有通用名称的字段集。 （它是 "left-biased" 的意思是，如果两个记录中的匹配字段具有不同的类型，它将采用第一个记录的类型。）同样，我们使用 singletons 包和模板 Haskell 将其提升为 type-level Common 函数：
$(singletons [d|
common :: [(Symbol,Type)] -> [(Symbol,Type)] -> [(Symbol,Type)]
common [] _ = []
common (x@(a,b):xs) ys
= if elem a (map fst ys)
then x:common xs ys
else common xs ys
|])
这允许我们定义一个函数，它接受两条记录并将第一条记录缩减为与第二条记录中的字段同名的字段集：
reduce :: Record fs1 -> Record fs2 -> Record (Common fs1 fs2)
reduce Record _ = Record
reduce (With s x r1) r2
= case sElem s (sFields r2) of STrue -> With s x (reduce r1 r2)
SFalse -> reduce r1 r2
同样，单例库在这里真的很了不起。我正在使用我自动生成的 Common type-level 函数和 singleton-level sElem 函数（它是在 singletons 包中自动生成的 term-level elem 函数的定义）。不知何故，通过所有这些复杂性，GHC 可以计算出如果 sElem 计算为 STrue，我必须在公共字段列表中包含 s，而如果它计算为 SFalse， 我不应该。尝试在箭头的 right-hand 一侧摆弄案例结果——如果你弄错了，你就无法让它们进行类型检查！
无论如何，我可以将此功能应用于我的两个示例记录。同样，类型签名不是必需的，但它用于显示正在生成的内容：
rec3 :: Record '[ '("foo", Int)]
rec3 = reduce rec1 rec2
与任何其他记录一样，我有 运行 时间访问其字段名称和 compile-time type-check 字段访问权限：
-- fields rec3 gives ["foo"], the common field names
-- field_ @"foo" rec3 gives 10, the field value for rec1
请注意，一般来说，reduce r1 r2 和 reduce r2 r1 将 return 不仅是不同的值，而且 类型 如果顺序 and/or r1 和 r2 之间常用名称字段的类型不同。改变这种行为可能需要重新审视我之前提到的那些早期 far-reaching 设计决策。
为方便起见，这是使用 Stack lts-10.5（使用单例 2.3.1）测试的整个程序：
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wincomplete-patterns #-}
module Records where
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Singletons.TypeLits
import Data.Function ((&))
import Data.Kind (Type)
import Data.List (intersect)
import qualified Data.Text as Text
data Record :: [(Symbol, Type)] -> Type where
Record :: Record '[]
With :: SSymbol s -> t -> Record fs -> Record ('(s, t) : fs)
with_ :: forall s t fs . (SingI s) => t -> Record fs -> Record ('(s, t) : fs)
with_ = With sing
rec1 :: Record '[ '("bar", [Char]), '("foo", Int)]
rec1 = Record & with_ @"foo" (10 :: Int)
& with_ @"bar" "Hello, world"
-- i.e., rec1 = { foo = 10, bar = "Hello, world" } :: { foo :: Int, bar :: String }
rec2 :: Record '[ '("quux", Maybe Double), '("foo", Int)]
rec2 = Record & with_ @"foo" (20 :: Int)
& with_ @"quux" (Just 1.0 :: Maybe Double)
-- i.e., rec2 = { foo = 20, quux = Just 1.0 } :: { foo :: Int, quux :: Maybe Double }
field :: forall s t fs . (Lookup s fs ~ Just t) => SSymbol s -> Record fs -> t
field s (With s' t r)
= case s %:== s' of
STrue -> t
SFalse -> field s r
field_ :: forall s t fs . (Lookup s fs ~ Just t, SingI s) => Record fs -> t
field_ = field @s sing
exField = field_ @"foo" rec1
-- badField = field_ @"baz" rec1 -- gives: Couldn't match type Nothing with Just t
lookup' :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup' _key [] = Nothing
lookup' key ((x,y):xys) = if key == x then Just y else lookup' key xys
$(singletons [d|
names :: [(Symbol, Type)] -> [Symbol]
names = map fst
|])
data SomeUIType fs = SomeUIType -- a UI for the given compile-time list of fields
recordUI :: Record fs -> SomeUIType (Names fs)
recordUI _ = SomeUIType
sFields :: Record fs -> Sing (Names fs)
sFields Record = SNil
sFields (With s _ r) = SCons s (sFields r)
fields :: Record fs -> [Text.Text]
fields = fromSing . sFields
rec12common = intersect (fields rec1) (fields rec2)
-- value: ["foo"]
$(singletons [d|
common :: [(Symbol,Type)] -> [(Symbol,Type)] -> [(Symbol,Type)]
common [] _ = []
common (x@(a,b):xs) ys
= if elem a (map fst ys)
then x:common xs ys
else common xs ys
|])
reduce :: Record fs1 -> Record fs2 -> Record (Common fs1 fs2)
reduce Record _ = Record
reduce (With s x r1) r2
= case sElem s (sFields r2) of STrue -> With s x (reduce r1 r2)
SFalse -> reduce r1 r2
rec3 :: Record '[ '("foo", Int)]
rec3 = reduce rec1 rec2
-- fields rec3 gives ["foo"], the common field names
-- field_ @"foo" rec3 gives 10, the field value for rec1
如果这是一个愚蠢的问题，请多多包涵。我怎样才能 键入 一个通用函数，它接受两条记录并且 return 是它们的公共字段的数组？
假设我有：
type A = { name :: String, color :: String }
type B = { name :: String, address :: Address, color :: String }
myImaginaryFunction :: ???
-- should return ["name", "color"] :: Array of [name color]
我想编写一个函数，它接受 ANY 两种类型的记录和 return 一组公共字段。 haskell 解决方案也可以。
好吧，既然你的函数确实 return 是一个字符串数组，那么 return 类型应该只是 Array String.
参数类型将是遗传的，因为您事先不知道类型。如果你真的想确保这些类型实际上是记录，你可以让你的泛型参数不是记录本身，而是 type rows，然后 type value parameters as Record a。
所以：
myImaginaryFunction :: forall a b. Record a -> Record b -> Array String
你就是这样输入这样的函数的。
或者您的问题真的是关于如何实施吗？
另外：你有没有注意到作弊（通过添加 Haskell 标签）并没有真正给你带来任何帮助，而只是一些责骂？请不要这样做。尊重社区。
要在 Haskell 中表达具有公共字段的两种记录类型，您需要一个 GHC 扩展：
{-# LANGUAGE DuplicateRecordFields #-}
要反省字段名称，您需要基于 Data class:
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Data ( Data, Typeable, DataRep(AlgRep), dataTypeRep
, dataTypeOf, constrFields)
import Data.List (intersect)
import Data.Proxy (Proxy(..), asProxyTypeOf)
这将允许您使用相同的字段名称定义两种数据类型：
data Address = Address String deriving (Typeable, Data)
data A = A { name :: String, color :: String }
deriving (Typeable, Data)
data B = B { name :: String, address :: Address, color :: String}
deriving (Typeable, Data)
然后您可以使用以下方法检索字段名称：
fieldNames :: (Data t) => Proxy t -> [String]
fieldNames t = case dataTypeRep $ dataTypeOf $ asProxyTypeOf undefined t of
AlgRep [con] -> constrFields con
并获取公共字段：
commonFields :: (Data t1, Data t2) => Proxy t1 -> Proxy t2 -> [String]
commonFields t1 t2 = intersect (fieldNames t1) (fieldNames t2)
之后将执行以下操作：
ghci> commonFields (Proxy :: Proxy A) (Proxy :: Proxy B)
["name", "color"]
ghci>
请注意，上面 fieldNames 的实现假定只有具有单个构造函数的记录类型才会被自省。如果您想概括它，请参阅 Data.Data 的文档。
现在，因为你是一个吸血鬼，我知道你会需要一个类型级别的函数，即使你在你的问题中没有说需要一个 type-level 函数！事实上，我可以看到您已经添加了一条评论，说明您如何有兴趣以某种方式返回 name | color 的数组，尽管 Haskell 中不存在这样的东西，即使您在问题中明确表示您期望 term-level 答案 ["name", "color"].
不过，可能会有 non-vampires 有类似的问题，也许这个答案会对他们有所帮助。
对于Haskell，我喜欢K.A。 Buhr 的回答，但我个人不会使用 Typeable，而是使用 GHC Generics。不过，我认为这可能是目前的偏好。
对于 PureScript，我本月早些时候在我的博客 post Making Diffs of differently-typed Records in PureScript 中写过此类问题。该方法与您使用没有行类型的语言所采用的方法完全不同（不，Elm 没有这些。除了使用同类字符串映射之外，您真的没有其他解决方案）。
首先，如果您完全熟悉 PureScript，您可能想使用 Union，但这也行不通，因为您想要执行类似以下操作：
Union r1' r r1
其中 r1' 是第一个记录 r1 和 r2 之间共享子类型 r 的补充。原因是这里有两个未求解的变量，并且 Union 的函数依赖性要求求解 Union 的三个参数中的任意两个。
因此，由于我们不能直接使用 Union，因此我们必须制定某种解决方案。由于我可以获得按键排序的 RowList 结构，因此我选择使用它遍历两个不同记录的 RowList 并找出交集：
class RowListIntersection
(xs :: RowList)
(ys :: RowList)
(res :: RowList)
| xs ys -> res
instance rliNilXS :: RowListIntersection Nil (Cons name ty tail) Nil
instance rliNilYS :: RowListIntersection (Cons name ty tail) Nil Nil
instance rliNilNil :: RowListIntersection Nil Nil Nil
instance rliConsCons ::
( CompareSymbol xname yname ord
, Equals ord EQ isEq
, Equals ord LT isLt
, Or isEq isLt isEqOrLt
, If isEq xty trashty yty
, If isEq xty trashty2 zty
, If isEq (SProxy xname) trashname (SProxy zname)
, If isEq
(RLProxy (Cons zname zty res'))
(RLProxy res')
(RLProxy res)
, If isEqOrLt
(RLProxy xs)
(RLProxy (Cons xname xty xs))
(RLProxy xs')
, If isLt
(RLProxy (Cons xname yty ys))
(RLProxy ys)
(RLProxy ys')
, RowListIntersection xs' ys' res'
) => RowListIntersection (Cons xname xty xs) (Cons yname yty ys) res
然后我使用了一个简短的定义来获取结果 RowList 的键：
class Keys (xs :: RowList) where
keysImpl :: RLProxy xs -> List String
instance nilKeys :: Keys Nil where
keysImpl _ = mempty
instance consKeys ::
( IsSymbol name
, Keys tail
) => Keys (Cons name ty tail) where
keysImpl _ = first : rest
where
first = reflectSymbol (SProxy :: SProxy name)
rest = keysImpl (RLProxy :: RLProxy tail)
因此，我可以一起定义一个函数来获取共享标签：
getSharedLabels
:: forall r1 rl1 r2 rl2 rl
. RowToList r1 rl1
=> RowToList r2 rl2
=> RowListIntersection rl1 rl2 rl
=> Keys rl
=> Record r1
-> Record r2
-> List String
getSharedLabels _ _ = keysImpl (RLProxy :: RLProxy rl)
然后就可以看到我们期待的结果了：
main = do
logShow <<< Array.fromFoldable $
getSharedLabels
{ a: 123, b: "abc" }
{ a: 123, b: "abc", c: true }
-- logs out ["a","b"] as expected
如果您是 RowList/RowToList 的新手，可以考虑通读我的 RowList Fun With PureScript 2nd Edition 幻灯片。
我把这个答案的代码放在 here。
如果这一切看起来过于复杂，您的其他解决方案可能是将记录强制转换为字符串映射并获取键的集合并集。我不知道这是否是 Elm 中的答案，因为 String Map 的运行时表示可能与 Record 不匹配。但是对于 PureScript，这是一个选项，因为 StrMap 的运行时表示与 Record 相同。
实际上，经过更多考虑后，我想 有可能做你实际上想做的事 =206=]，如果您实际上 想要做的是在类型级别使用具有命名字段的记录类型，包括执行诸如 compile-time 推导新记录之类的事情使用其他两个记录的公共字段键入。
它有点复杂而且有点难看，尽管有些位工作得非常好。是的，当然是 "too much ceremony for such a simple task"，但请记住，我们正在尝试实现一个全新的 non-trivial、type-level 功能（一种依赖结构类型）。使这项任务变得简单的唯一方法是从一开始就将该功能融入语言及其类型系统；否则会很复杂。
无论如何，在我们获得 DependentTypes 扩展之前，您必须显式启用少量（哈哈）扩展：
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wincomplete-patterns #-}
module Records where
我们将充分利用 singletons 包及其子模块：Prelude 用于基本 type-level 功能，如 Map、Fst, 和 Lookup; TH 模块，用于使用模板 Haskell 拼接生成我们自己的单例和提升函数；和 TypeLits 用于使用 Symbol 类型（即，类型级别的字符串文字）。
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Singletons.TypeLits
我们还需要一些其他的杂物。之所以需要 Text，是因为它是 Symbol.
import Data.Function ((&))
import Data.Kind (Type)
import Data.List (intersect)
import qualified Data.Text as Text
我们将无法处理通常的 Haskell 记录。相反，我们将定义一个 Record 类型的构造函数。此类型构造函数将由 (Symbol, Type) 对列表索引，其中 Symbol 给出字段名称，Type 给出存储在该字段中的值的类型。
data Record :: [(Symbol, Type)] -> Type where
这个设计决策已经有几个主要影响：
- 不同记录类型中的相同字段名可以引用不同的字段值类型。
- 字段在记录中是有序的，所以记录类型只有在具有相同字段、相同类型、相同顺序.[=171=时才相同]
- 同一字段可以在一条记录中出现多次，即使我们提供的访问器函数只会访问一个（最后添加的）。
在依赖类型的程序中，设计决策往往 运行 很深。例如，如果同一个字段不能出现多次，我们需要找到一种方法在类型中反映这一点，然后确保我们所有的函数都能够提供适当的证据，证明没有添加重复的字段.
无论如何，回到我们的 Record 类型构造函数。将有两个数据构造函数，一个 Record 构造函数来创建一个空记录：
Record :: Record '[]
和一个 With 构造函数，用于向记录添加字段：
With :: SSymbol s -> t -> Record fs -> Record ('(s, t) : fs)
注意With需要一个运行时间代表s :: Symbol以符号单例SSymbol s的形式方便函数with_将使这个单例隐式：
with_ :: forall s t fs . (SingI s) => t -> Record fs -> Record ('(s, t) : fs)
with_ = With sing
我们的想法是，通过允许不明确的类型和使用类型应用程序，我们公开了以下用于定义记录的合理简洁的语法。显式类型签名在这里不是必需的，但包括在内以明确正在创建的内容：
rec1 :: Record '[ '("bar", [Char]), '("foo", Int)]
rec1 = Record & with_ @"foo" (10 :: Int)
& with_ @"bar" "Hello, world"
-- i.e., rec1 = { foo = 10, bar = "Hello, world" } :: { foo :: Int, bar :: String }
rec2 :: Record '[ '("quux", Maybe Double), '("foo", Int)]
rec2 = Record & with_ @"foo" (20 :: Int)
& with_ @"quux" (Just 1.0 :: Maybe Double)
-- i.e., rec2 = { foo = 20, quux = Just 1.0 } :: { foo :: Int, quux :: Maybe Double }
为了证明这种记录类型是有用的，我们将定义一个type-safe 字段访问器。这是一个使用显式单例 select 字段的方法：
field :: forall s t fs . (Lookup s fs ~ Just t) => SSymbol s -> Record fs -> t
field s (With s' t r)
= case s %:== s' of
STrue -> t
SFalse -> field s r
和一个带有隐含单例的助手：
field_ :: forall s t fs . (Lookup s fs ~ Just t, SingI s) => Record fs -> t
field_ = field @s sing
旨在与这样的类型应用程序一起使用：
exField = field_ @"foo" rec1
请注意，尝试访问不存在的字段不会 type-check。错误消息并不理想，但至少是 compile-time 错误：
-- badField = field_ @"baz" rec1 -- gives: Couldn't match type Nothing with Just t
field 的定义暗示了 singletons 库的强大功能。我们正在使用 type-level Lookup 函数，该函数是通过模板 Haskell 从 term-level 定义中自动生成的，该定义看起来与以下内容完全相同（取自 singletons 来源并重命名以避免冲突）：
lookup' :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup' _key [] = Nothing
lookup' key ((x,y):xys) = if key == x then Just y else lookup' key xys
仅使用上下文 Lookup s fs ~ Just t，GHC 能够确定：
因为上下文暗示这个字段会在列表中找到，所以
field的第二个参数永远不能是空记录Record，所以没有警告field的不完整模式，事实上，如果您尝试通过添加大小写将其作为 运行 时间错误来处理，您将收到类型错误：field s Record = error "ack, something went wrong!"如果我们在
SFalse分支中，对field的递归调用是 type-correct。也就是说，GHC 已经计算出，如果我们可以成功Lookup列表中的键s但它不在头部，我们必须能够在尾部查找它。
（这对我来说太棒了，但无论如何......）
这些是我们记录类型的基础。为了在 运行 时间或编译时间检查字段名称，我们将引入一个帮助程序，我们将其提升到类型级别即，type-level 函数 Names) 使用模板 Haskell:
$(singletons [d|
names :: [(Symbol, Type)] -> [Symbol]
names = map fst
|])
请注意，type-level 函数 Names 可以提供 compile-time 访问记录的字段名称，例如在假设的类型签名中：
data SomeUIType fs = SomeUIType -- a UI for the given compile-time list of fields
recordUI :: Record fs -> SomeUIType (Names fs)
recordUI _ = SomeUIType
不过，我们更有可能希望在 运行 时使用字段名称。使用 Names，我们可以定义以下函数来获取记录和 return 其字段名称列表作为单例。这里，SNil 和 SCons 是术语 [] 和 (:).
sFields :: Record fs -> Sing (Names fs)
sFields Record = SNil
sFields (With s _ r) = SCons s (sFields r)
这里有一个 return 是 [Text] 而不是单例的版本。
fields :: Record fs -> [Text.Text]
fields = fromSing . sFields
现在，如果你只想得到一个运行两条记录的公共字段时间列表，你可以这样做：
rec12common = intersect (fields rec1) (fields rec2)
-- value: ["foo"]
在编译时创建具有公共字段的类型怎么样？好吧，我们可以定义以下函数来获取 left-biased 具有通用名称的字段集。 （它是 "left-biased" 的意思是，如果两个记录中的匹配字段具有不同的类型，它将采用第一个记录的类型。）同样，我们使用 singletons 包和模板 Haskell 将其提升为 type-level Common 函数：
$(singletons [d|
common :: [(Symbol,Type)] -> [(Symbol,Type)] -> [(Symbol,Type)]
common [] _ = []
common (x@(a,b):xs) ys
= if elem a (map fst ys)
then x:common xs ys
else common xs ys
|])
这允许我们定义一个函数，它接受两条记录并将第一条记录缩减为与第二条记录中的字段同名的字段集：
reduce :: Record fs1 -> Record fs2 -> Record (Common fs1 fs2)
reduce Record _ = Record
reduce (With s x r1) r2
= case sElem s (sFields r2) of STrue -> With s x (reduce r1 r2)
SFalse -> reduce r1 r2
同样，单例库在这里真的很了不起。我正在使用我自动生成的 Common type-level 函数和 singleton-level sElem 函数（它是在 singletons 包中自动生成的 term-level elem 函数的定义）。不知何故，通过所有这些复杂性，GHC 可以计算出如果 sElem 计算为 STrue，我必须在公共字段列表中包含 s，而如果它计算为 SFalse， 我不应该。尝试在箭头的 right-hand 一侧摆弄案例结果——如果你弄错了，你就无法让它们进行类型检查！
无论如何，我可以将此功能应用于我的两个示例记录。同样，类型签名不是必需的，但它用于显示正在生成的内容：
rec3 :: Record '[ '("foo", Int)]
rec3 = reduce rec1 rec2
与任何其他记录一样，我有 运行 时间访问其字段名称和 compile-time type-check 字段访问权限：
-- fields rec3 gives ["foo"], the common field names
-- field_ @"foo" rec3 gives 10, the field value for rec1
请注意，一般来说，reduce r1 r2 和 reduce r2 r1 将 return 不仅是不同的值，而且 类型 如果顺序 and/or r1 和 r2 之间常用名称字段的类型不同。改变这种行为可能需要重新审视我之前提到的那些早期 far-reaching 设计决策。
为方便起见，这是使用 Stack lts-10.5（使用单例 2.3.1）测试的整个程序：
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wincomplete-patterns #-}
module Records where
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Singletons.TypeLits
import Data.Function ((&))
import Data.Kind (Type)
import Data.List (intersect)
import qualified Data.Text as Text
data Record :: [(Symbol, Type)] -> Type where
Record :: Record '[]
With :: SSymbol s -> t -> Record fs -> Record ('(s, t) : fs)
with_ :: forall s t fs . (SingI s) => t -> Record fs -> Record ('(s, t) : fs)
with_ = With sing
rec1 :: Record '[ '("bar", [Char]), '("foo", Int)]
rec1 = Record & with_ @"foo" (10 :: Int)
& with_ @"bar" "Hello, world"
-- i.e., rec1 = { foo = 10, bar = "Hello, world" } :: { foo :: Int, bar :: String }
rec2 :: Record '[ '("quux", Maybe Double), '("foo", Int)]
rec2 = Record & with_ @"foo" (20 :: Int)
& with_ @"quux" (Just 1.0 :: Maybe Double)
-- i.e., rec2 = { foo = 20, quux = Just 1.0 } :: { foo :: Int, quux :: Maybe Double }
field :: forall s t fs . (Lookup s fs ~ Just t) => SSymbol s -> Record fs -> t
field s (With s' t r)
= case s %:== s' of
STrue -> t
SFalse -> field s r
field_ :: forall s t fs . (Lookup s fs ~ Just t, SingI s) => Record fs -> t
field_ = field @s sing
exField = field_ @"foo" rec1
-- badField = field_ @"baz" rec1 -- gives: Couldn't match type Nothing with Just t
lookup' :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup' _key [] = Nothing
lookup' key ((x,y):xys) = if key == x then Just y else lookup' key xys
$(singletons [d|
names :: [(Symbol, Type)] -> [Symbol]
names = map fst
|])
data SomeUIType fs = SomeUIType -- a UI for the given compile-time list of fields
recordUI :: Record fs -> SomeUIType (Names fs)
recordUI _ = SomeUIType
sFields :: Record fs -> Sing (Names fs)
sFields Record = SNil
sFields (With s _ r) = SCons s (sFields r)
fields :: Record fs -> [Text.Text]
fields = fromSing . sFields
rec12common = intersect (fields rec1) (fields rec2)
-- value: ["foo"]
$(singletons [d|
common :: [(Symbol,Type)] -> [(Symbol,Type)] -> [(Symbol,Type)]
common [] _ = []
common (x@(a,b):xs) ys
= if elem a (map fst ys)
then x:common xs ys
else common xs ys
|])
reduce :: Record fs1 -> Record fs2 -> Record (Common fs1 fs2)
reduce Record _ = Record
reduce (With s x r1) r2
= case sElem s (sFields r2) of STrue -> With s x (reduce r1 r2)
SFalse -> reduce r1 r2
rec3 :: Record '[ '("foo", Int)]
rec3 = reduce rec1 rec2
-- fields rec3 gives ["foo"], the common field names
-- field_ @"foo" rec3 gives 10, the field value for rec1