Haskell中的类型见证（附详细代码）

如果你在Haskell或其他具有类似类型系统的语言中阅读描述一些高级类型级别的文章，你有可能会遇到这种叫做 "类型见证 "或 "运行时证据 "的东西。在这篇文章中，我们将试图了解它到底是什么。

简单地说，运行时证据是一个值，它以某种方式持有与多态值相关的一些类型级信息，并将其提供给类型检查过程。

但这是令人困惑的，因为类型检查是在编译时发生的，而值往往只在运行时可用。 那么，值怎么能在编译时提供类型信息呢？

这是有可能的，因为即使值只在运行时可用，如果代码中有一个分支（if-then-else，case语句）在一个值上有分支，我们可以在每个分支内对这个值进行假设。

因此，举例来说，如果在代码中有一个分支，如：

if (i == 1) then { -- block 1 -- } else { -- block 2 -- }

我们可以安全地假设，如果我们发现自己处于第1块，那么i 在该块内将是1，如果我们发现自己处于第2块，那么i 不是1。

因此，在编译时，我们将有一些关于一个值的信息，在代码的条件分支中，对所述值进行分支。类型见证技术的核心思想是利用这些信息使编译器推断出多态类型的属性，比如推断出的类型是什么，它是如何被约束的，等等。

为此，我们首先需要一种方法，将一个值与一些类型级的细节联系起来。在Haskell中，我们有GADTs 扩展，它使我们能够定义以下形式的数据类型：

data MyData a where
  MyValue1 :: MyData Int
  MyValue2 :: MyData String
  MyValue3 :: MyData Char

这种数据定义的强大之处在于，它使我们能够明确地将构造函数标记为某种具体类型。

因此，我们已经声明值MyValue1,MyValue2, 和MyValue3 分别具有类型MyData Int,MyData String, 和MyData Char 。因此，这些值现在可以指向MyData a 中的类型a 是什么。

现在，让我们看看这个类型如何充当 "证人"。

考虑一下下面的函数。你可以看到，通过对MyData a 值的分支，我们能够弄清楚a 是什么：

func1 :: MyData a -> a
func1 myData =
  case myData of
    MyValue1 -> 10 -- `a` is Int here
    MyValue2 -> "I am a string" -- `a` is String here
    MyValue3 -> 'c' -- `a` is Char here

但是，"见证 "这个名字是如何合理的呢？它所见证的是什么？

想象一下，这个函数是一个表达式的一部分，例如：

(10 :: Int) + (func1 MyValue1)

MyValue1 构造函数作为调用站点的一部分，见证了只有在那里才能得到的信息，也就是说，在调用站点所需要的类型实际上是Int 。因此被称为 "类型见证"。我们可以有见证其他事情的证人，比如a 与b 是同一类型，或者a 已经以某种方式被约束，等等。

单项式

我们看到，MyData a 的值可以指向a 是什么。此外，由于MyData a 的每个多态变体都包含一个且仅有一个值，MyData a 的具体类型也可以指向值，因为对于任何给定的变体都只有一个可能的值。这种在值和类型之间存在一对一对应关系的类型被称为Singletons。

那么，这有什么用呢/我为什么要关心？

静态类型系统在开始的时候可能会感觉到非常限制性，但是，如果它们足够先进，你会发现你可以得到一些动态类型语言的灵活性，同时保留了静态类型的安全性。

让我们来看看这个例子，它也涉及到类型见证的使用。

想象一下，你正在构建一个有不同权限的用户的应用程序。 我们用一个类型来表示可能的权限：

data UserPrivilege = Member | Admin | Guest

而用户现在可以用类似的东西来表示：

data User = User { userId :: Integer, userName :: String, userPrivilege :: UserPrivilege }

由于我们对类型安全感兴趣，我们希望使userPrivilege 属性处于类型级别，这样，如果我们将一个权限为Member 的用户传递给一个需要权限为Admin 的用户的函数，编译器将在编译时捕获它。

为了做到这一点，我们给User 类型添加一个类型参数。我们还启用了DataKinds扩展，这样，UserPrivilege 的构造函数就可以在类型级别上用来标记User 类型。所以，我们最终得到了这样的结果。

data User (ut :: UserPrivilege) = User { userId :: Integer, userName :: String }

现在，我们在类型层有用户权限，这将防止我们把User 'Member 传递给需要User 'Admin 的函数。

但是我们发现现在不可能写一个从数据库中读取用户的函数，而不明确指定该用户拥有哪种权限。因此，举例来说，我们尝试用下面的类型来实现这个函数：

fetchUserById :: Int -> IO (User a)

User a 但这是不可能的，因为如果你从数据库中读取用户并发现用户是 "成员 "类型，你将无法从函数中返回具体的类型User 'Member ，因为签名说它应该能够返回所有 a 。

多态值User a 的概念是它应该能够具体化为任何类型，就像使用多态值的表达式所要求的那样。所以在这里，在fetchUserById 函数中，如果我们发现从数据库中读取的用户的权限是Admin ，我们只有在检查这个函数的调用者确实要求User 'Admin ，才能返回具体值。我们在前面看到的func1 函数中已经看到了如何做到这一点。但在这里，我们将无法使用这样的东西，原因很简单，因为我们在调用fetchUserById 的时候，并不知道用户的权限。

解决这个问题的一个办法是将user 类型包裹在另一个类型中，这个类型将有多个构造函数，每个构造函数包裹一个不同类型的用户，从而将类型级别的权限隐藏在它们后面：

data UserWrapper
  = MemberUser (User 'Member)
  | AdminUser (User 'Admin)
  | GuestUser (User 'Guest)

这种方法的一个问题是，每次从db中读取user ，对它做任何事情时，你都必须在所有这些构造函数上进行匹配，即使你不关心用户的权限。

另一种隐藏类型级权限的方法是使用一个GADT 包装类型，将类型级权限隐藏在GADT构造函数后面。

data SomeUser where
  SomeUser :: forall a. User a -> SomeUser

由于SomeUser 类型构造函数没有类型参数，我们可以把它包裹在一个任何权限的User a ，并从我们的数据库读取函数中返回。

但是现在，我们会发现，从SomeUser 类型中解开的User a 只能用于接受多态用户的函数，也就是User a ，而不能用于需要具体类型的函数，比如User 'Admin 。

这正是我们一开始想要的结果。我们被阻止将一个未知权限的用户传递给一个需要管理员权限的函数。但现在看来，我们根本就不能进行这种调用。 我们怎样才能让类型检查器相信从SomeUser 解除的User a 实际上是User 'Admin ？

我们可以通过使用一个类型见证来做到这一点。我们添加以下类型来作为见证：

data WitnessPrivilege up where
  WitnessMember :: WitnessPrivilege Member
  WitnessGuest :: WitnessPrivilege Guest
  WitnessAdmin :: WitnessPrivilege Admin

然后我们改变User 的类型，将这个见证作为它的一个字段。

data User (up :: UserPrivilege) = User
  { userId :: Integer
  , userName :: String
  , userPrivilege :: WitnessPrivilege up
  }

就这样了。当你想把一个从SomeUser解除包装的User a 转换为一个具体的类型，比如User 'Admin ，你只需要在userPrivilege 字段上进行模式匹配。只要你在WitnessAdmin分支上得到一个匹配，GHC就会推断出User a 是一个User 'Admin ，并允许你调用需要User 'Admin 的函数。

由于包含了类型见证，我们得到了两全其美的结果；当你不需要它的时候，一个类型级的用户权限就会消失，但在你需要它的时候又会突然出现。

完整的代码示例

{-# Language GADTs #-}
{-# Language DataKinds #-}
{-# Language KindSignatures #-}
{-# Language ExistentialQuantification #-}
{-# Language ScopedTypeVariables #-}

module Main where

import Data.List

-- User privileges for our users
data UserPrivilege = Member | Admin | Guest

-- Our type witness
data WitnessPrivilege up where
  WitnessMember :: WitnessPrivilege Member
  WitnessGuest :: WitnessPrivilege Guest
  WitnessAdmin :: WitnessPrivilege Admin

-- Our user type
data User (up :: UserPrivilege) = User
  { userId :: Integer
  , userName :: String
  , userPrivilege :: WitnessPrivilege up
  }

-- The type that we use to hide the privilege type variable
data SomeUser where
  SomeUser :: User a -> SomeUser

-- A function that accept a user id (Integer), and reads
-- the corresponding user from the database. Note that the return
-- type level privilege is hidden in the return value `SomeUser`.
readUser :: Integer -> IO SomeUser
readUser userId = pure $ case find ((== userId) . (\(a, _, _) -> a)) dbRows of
  Just (id_, name_, type_) ->
    case type_ of
      "member" -> SomeUser (User id_ name_ WitnessMember)
      "guest" -> SomeUser (User id_ name_ WitnessGuest)
      "admin" -> SomeUser (User id_ name_ WitnessAdmin)
  Nothing -> error "User not found"

-- This is a function that does not care
-- about user privilege
getUserName :: User up -> String
getUserName = userName

-- This is a function only allows user
-- with Admin privilege.
deleteStuffAsAdmin :: User 'Admin -> IO ()
deleteStuffAsAdmin _ = pure ()

main :: IO ()
main = do
  (SomeUser user) <- readUser 12

  putStrLn $ getUserName user -- We don't care about user privilege here

  case userPrivilege user of -- But here we do.
    -- So we bring the type-level user privilege in scope by matching
    -- on `userPrivilege` field and then GHC knows that `user`
    -- is actually `User 'Admin`, and so we can call `deleteStuffAsAdmin`
    -- with `user`.
    WitnessAdmin ->
      deleteStuffAsAdmin user
    _ -> error "Need admin user"

dbRows :: [(Integer, String, String)]
dbRows =
  [ (10, "John", "member")
  , (11, "alice", "guest")
  , (12, "bob", "admin")
  ]