推断两个记录中的公共字段的类型

问题描述 投票：3回答：4

如果这是一个愚蠢的问题，请耐心等待。如何键入一个带有两个记录并返回其公共字段数组的泛型函数？

比方说我有：

type A = { name :: String, color :: String }
type B = { name :: String, address :: Address, color :: String }

myImaginaryFunction :: ???
-- should return ["name", "color"] :: Array of [name color]

我想编写一个函数，它接受任何两种类型的记录并返回一个公共字段数组。一个haskell解决方案也可以工作。

haskell purescript recordtype row-polymorphism
4个回答
5
投票

要在Haskell中表达具有公共字段的两种记录类型，您需要GHC扩展：

{-# LANGUAGE DuplicateRecordFields #-}

并且要反省字段的名称，您需要基于Data类的泛型：

{-# 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的文档。

现在，因为你是一个帮助吸血鬼，我知道你会要求一个类型级别的功能，即使你在问题中没有说什么需要一个类型级别的功能！事实上，我可以看到你已经添加了一个关于你如何感兴趣以某种方式返回name | color数组的评论，尽管Haskell中没有这样的东西，即使你在你的问题中明确地说过你期望得到的术语答案["name", "color"]。

尽管如此，可能还有非吸血鬼有类似的问题，也许这个答案会帮助他们。

4
投票

对于Haskell，我喜欢K.A. Buhr的答案，但我个人不会使用Typeable而是使用GHC Generics。我认为在这一点上可能会有偏好。

对于PureScript，我在本月早些时候的Making Diffs of differently-typed Records in PureScript博客文章中写到了这类问题。这种方法与没有行类型的语言完全不同（不，Elm没有这些。除了使用同类字符串映射之外，你真的没有得到解决方案）。

首先，如果你完全熟悉PureScript，你可能想要使用Union，但这也不会起作用，因为你想做的事情如下：

Union r1' r r1

其中r1'将是您的第一个记录r和r1之间的共享子类型r2的补充。原因是这里有两个未解决的变量，而Union的功能依赖性需要求解Union的三个参数中的任何两个。

因为我们不能直接使用Union，所以我们必须制定某种解决方案。因为我可以获得按键排序的RowList结构，所以我选择使用它来遍历两个不同的记录'RowLists并走出交集：

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。

如果所有这些看起来太复杂，那么您的另一个解决方案可能是将记录强制转换为String Map并获得密钥的集合。我不知道这是否是Elm中的答案，因为字符串映射的运行时表示可能与Record的不匹配。但是对于PureScript，这是一个选项，因为StrMap的运行时表示与Record相同。

2
投票

实际上，在考虑了这个之后，我想可以在现代Haskell中做你真正想做的事情，如果你真正想做的是使用类型级别带有命名字段的记录类型，包括做事情就像使用来自其他两个记录的公共字段的新记录类型的编译时派生一样。

它有点牵扯，有点丑陋，虽然有些位工作得非常好。是的，当然这是“为这么简单的任务举行太多仪式”，但请记住，我们正试图实现一个全新的，非平凡的类型级功能（一种依赖的结构类型）。使这个简单任务的唯一方法是从一开始就将该功能烘焙到语言及其类型系统中;否则，它会变得复杂。

无论如何，在我们获得DependentTypes扩展之前，您必须明确启用少量（ha ha）扩展：

{-# 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用于基本的类型级函数，如Map，Fst和Lookup; TH模块用于生成我们自己的单例并使用Template 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

这个设计决定已经有几个主要的影响：

  • 不同记录类型中的相同字段名称可以引用不同的字段值类型。
  • 字段在记录中排序，因此如果记录类型具有相同的字段，具有相同的类型，则它们的顺序相同。
  • 即使我们提供的访问者功能只访问一个（最后添加的），同一个字段也可以在记录中多次出现。

在依赖类型的程序中，设计决策往往会深入。例如，如果同一个字段不能多次出现，我们需要找到一种方法来反映该类型，然后确保我们所有的功能都能够提供相应字段未添加的适当证据。

无论如何，回到我们的Record类型构造函数。将有两个数据构造函数，一个用于创建空记录的Record构造函数：

  Record :: Record '[]

和一个With构造函数来添加一个字段到记录：

  With :: SSymbol s -> t -> Record fs -> Record ('(s, t) : fs)

请注意，With需要以符号singleton s :: Symbol形式的SSymbol s的运行时代表。方便函数with_将使这个单例隐式：

with_ :: forall s t fs . (SingI s) => t -> Record fs -> Record ('(s, t) : fs)
with_ = With sing

通过允许模糊类型和使用类型应用程序的想法，我们公开了以下合理的succint语法来定义记录。此处不需要显式类型签名，但包含它们是为了明确所创建的内容：

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

field的定义暗示了singletons库的强大功能。我们使用的是类型级别的Lookup函数，该函数是通过模板Haskell从术语级别定义自动生成的，看起来与以下内容完全相同（取自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能够确定：

  1. 因为上下文暗示这个字段会在列表中找到，所以field的第二个参数永远不会是空记录Record，因此没有关于field的不完整模式的警告，事实上如果你尝试，你会得到一个类型错误通过添加大小写来处理这个运行时错误：field s Record = error "ack, something went wrong!"
  2. 如果我们在field分支中，对SFalse的递归调用是类型校正的。也就是说，GHC已经发现，如果我们能够成功地将Lookup列入名单中的关键s，但它不在头脑中，我们必须能够在尾巴中查找它。

（这对我来说很神奇，但无论如何...）

这些是我们记录类型的基础。为了在运行时或编译时自省字段名，我们将引入一个帮助器，我们将使用Template Haskell将其提升到类型级别（即类型级函数Names）：

$(singletons [d|
  names :: [(Symbol, Type)] -> [Symbol]
  names = map fst
  |])

请注意，类型级函数Names可以提供对记录的字段名称的编译时访问，例如在假设类型签名中：

data SomeUIType fs = SomeUIType -- a UI for the given compile-time list of fields
recordUI :: Record fs -> SomeUIType (Names fs)
recordUI _ = SomeUIType

但更可能的是，我们希望在运行时使用字段名称。使用Names，我们可以定义以下函数来获取记录并将其字段名称列表作为单例返回。在这里，SNil和SCons是术语[]和(:)的单身等价物。

sFields :: Record fs -> Sing (Names fs)
sFields Record = SNil
sFields (With s _ r) = SCons s (sFields r)

这是一个返回[Text]而不是单身的版本。

fields :: Record fs -> [Text.Text]
fields = fromSing . sFields

现在，如果您只想获取两个记录的公共字段的运行时列表，您可以执行以下操作：

rec12common = intersect (fields rec1) (fields rec2)
-- value:  ["foo"]

如何在编译时创建具有公共字段的类型？好吧，我们可以定义以下函数来获得具有通用名称的左偏置字段集。 （它是“左偏”的意思是，如果两个记录中的匹配字段具有不同的类型，则它将采用第一个记录的类型。）同样，我们使用singletons包和模板Haskell将其提升为类型 - 级别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类型级函数以及单例级sElem函数（它是从singletons函数的术语级定义中的elem包中自动生成的）。不知何故，通过所有这些复杂性，GHC可以发现如果sElem评估为STrue，我必须在常见字段列表中包含s，而如果它评估为SFalse，我绝不能。尝试摆弄箭头右侧的案例结果 - 如果你弄错了，就不能让他们打字检查！

无论如何，我可以将此功能应用于我的两个示例记录。同样，不需要类型签名，但是用于显示正在生成的内容：

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

请注意，通常，reduce r1 r2和reduce r2 r1不仅会返回不同的值，而且如果r1和r2之间通用名称字段的顺序和/或类型不同，则会返回不同的类型。改变这种行为可能需要重新审视我之前提到的早期和影响深远的设计决策。

为方便起见，这是整个程序，使用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
-2
投票

好吧，既然你的函数确实返回了一个字符串数组，那么返回类型应该只是Array String。

论证的类型是遗传的，因为你事先并不知道类型。如果您确实希望确保这些类型实际上是记录，则可以使通用参数不是自己记录，而是键入行，然后键入值参数Record a。

所以：

myImaginaryFunction :: forall a b. Record a -> Record b -> Array String

这是你输入这样的功能的方法。

或者您的问题是关于如何实施它的？

另外：你有没有注意到作弊（通过添加Haskell标签）并没有给你带来任何帮助，但只有一些责骂？请不要这样做。尊重社区。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.