实际上,在考虑了更多之后,我想可以在现代 Haskell 中做你真正想做的事情,如果你真正想做的是在类型级别使用具有命名字段的记录类型,包括做事就像使用来自其他两个记录的公共字段的新记录类型的编译时派生一样。
它有点复杂而且有点难看,尽管有些部分的效果出奇的好。是的,当然它“对于这样一个简单的任务来说太过繁琐了”,但请记住,我们正在尝试实现一个全新的、非平凡的、类型级别的功能(一种依赖结构类型)。使这成为一项简单任务的唯一方法是从一开始就将该功能融入语言及其类型系统中;否则,它会很复杂。
无论如何,在我们获得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
用于基本类型级函数,如Map
、Fst
和Lookup
; 使用 Template Haskell 拼接生成我们自己的单例和提升函数的TH
模块;以及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
需要以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 }
为了证明这种记录类型是有用的,我们将定义一个类型安全的字段访问器。这是一个使用显式单例来选择字段的方法:
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
图书馆的力量。我们正在使用通过 Template Haskell 从术语级定义自动生成的类型级Lookup
函数,该定义看起来与以下完全一样(取自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
仅使用 context Lookup s fs ~ Just t
,GHC 能够确定:
因为上下文暗示该字段将在列表中找到,所以 的第二个参数field
永远不能是空记录Record
,所以没有关于 不完整模式的警告field
,事实上,如果你尝试处理这个,你会得到一个类型错误通过添加案例作为运行时错误:field s Record = error "ack, something went wrong!"
field
如果我们在SFalse
分支中,递归调用是类型正确的。也就是说,GHC 已经想通了,如果我们能够成功地在列表中找到Lookup
keys
但它不在头部,我们必须能够在尾部查找它。
(这对我来说很神奇,但无论如何......)
这些是我们记录类型的基础。Names
为了在运行时或编译时检查字段名称,我们将引入一个帮助器,我们将使用 Template Haskell将其提升到类型级别(即类型级别函数):
$(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)
这是一个返回 a[Text]
而不是单例的版本。
fields :: Record fs -> [Text.Text]
fields = fromSing . sFields
现在,如果您只想获取两条记录的公共字段的运行时列表,您可以执行以下操作:
rec12common = intersect (fields rec1) (fields rec2)
-- value: ["foo"]
在编译时创建具有公共字段的类型怎么样?好吧,我们可以定义以下函数来获取具有通用名称的左偏字段集。(从某种意义上说,如果两个记录中的匹配字段具有不同的类型,则它是“左偏”的,它将采用第一个记录的类型。)再次,我们使用singletons
包和 Template 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