将存在主义提升到类型级别

Question

tl;dr：我正在尝试重写一些依赖类型的代码，这些代码在 Haskell 中有一个 sigma 类型的列表，但我似乎无法为存在的生成单例，在其他此代码失败的话：

data Foo :: Type where
  Foo :: forall foo. Sing foo -> Foo

$(genSingletons [''Foo])

后面是更长的版本。

假设此 Idris 代码为模型：

data AddrType = Post | Email | Office

data AddrFields : AddrType -> Type where
  PostFields : (city : String) -> (street : String) -> AddrFields Post
  EmailFields : (email : String) -> AddrFields Email
  OfficeFields : (floor : Int) -> (desk : Nat) -> AddrFields Office

Addr : Type
Addr = (t : AddrType ** AddrFields t)

someCoolPredicate : List AddrType -> Bool

data AddrList : List Addr -> Type where
  MkAddrList : (lst : List Addr) -> {auto prf : So (someCoolPredicate lst)} -> AddrList lst

基本上，当我们得到一个 AddrList lst 类型的值时，我们知道 lst : List Addr 并且 someCoolPredicate 对那个列表成立。

我在现代 Haskell 中取得的最接近的结果是，假设 singletons-2.5:

import Data.Singletons.TH
import Data.Singletons.Prelude
import Data.Singletons.Prelude.List

data AddrType = Post | Email | Office
              deriving (Eq, Ord, Show)

$(genSingletons [''AddrType])
$(singEqInstances [''AddrType])

data family AddrFields (a :: AddrType)

data instance AddrFields 'Post    = PostFields { city :: String, street :: String } deriving (Eq, Ord, Show)
data instance AddrFields 'Email   = EmailFields { email :: String } deriving (Eq, Ord, Show)
data instance AddrFields 'Office  = OfficeFields { flr :: Int, desk :: Int} deriving (Eq, Ord, Show)

data Addr :: Type where
  Addr :: { addrType :: Sing addrType
          , addrTypeVal :: AddrType
          , fields :: AddrFields addrType
          } -> Addr

$(promote [d|
  someCoolPredicate :: [Addr] -> Bool
  someCoolPredicate = ...
  |])

data AddrList :: [Addr] -> Type where
  AddrList :: { addrs :: Sing addrs, prf :: SomeCoolPredicate addrs :~: 'True } -> AddrList addrs

但是在给定 [Addr] 的情况下，我如何实际构建这种类型的值？换句话说，我如何在 Idris 中表达如下内容？

*Addrs> MkAddrList [(Post ** PostFields "Foo" "Bar")]
MkAddrList [(Post ** PostFields "Foo" "Bar")] : AddrList [(Post ** PostFields "Foo" "Bar")]

问题是，看起来我必须能够执行 toSing 或 Addr 列表中的等效操作，但 $(genSingletons [''Addr]) 失败了。事实上，即使 tl;dr 部分中的代码也会失败。那除了放弃这个想法我该怎么办？

Answer 1

这个问题的解决需要单例的单例，在singletons-2.6中介绍过。首先，所需的语言扩展和导入：

{-# LANGUAGE TemplateHaskell, GADTs, ScopedTypeVariables, PolyKinds, DataKinds,
             TypeFamilies, TypeOperators, UndecidableInstances, InstanceSigs,
             TypeApplications, FlexibleInstances, StandaloneDeriving #-}

module AddrSing where

import GHC.TypeLits
import Data.Kind
import Data.Singletons.TH
import Data.Singletons.Sigma

现在我们可以定义 AddrType 并为其生成单例:

singletons
  [d| data AddrType = Post | Email | Office
        deriving Show
  |]

到目前为止没什么特别的，但是我们有 AddrFields，这有点棘手：

data AddrFields :: AddrType -> Type where
  PostFields :: { city :: Symbol, street :: Symbol } -> AddrFields Post
  EmailFields :: { email :: Symbol } -> AddrFields Email
  OfficeFields :: { floor :: Nat, desk :: Nat } -> AddrFields Office

deriving instance Show (AddrFields addrType)

而不是 String 和 Integer 我不得不使用 Symbol 和 Nat，因为后者可以被提升。然后，由于 AddrFields 本身就是一个 GADT，我们必须手动将其单例化：

data SAddrFields :: forall addrType. AddrFields addrType -> Type where
  SPostFields :: Sing city -> Sing street -> SAddrFields (PostFields city street)
  SEmailFields :: Sing email -> SAddrFields (EmailFields email)
  SOfficeFields :: Sing floor -> Sing desk -> SAddrFields (OfficeFields floor desk)

deriving instance Show (SAddrFields addrFields)

type instance Sing = SAddrFields

instance (SingI city, SingI street) => SingI (PostFields city street) where
  sing = SPostFields sing sing

instance (SingI email) => SingI (EmailFields email) where
  sing = SEmailFields sing

instance (SingI floor, SingI desk) => SingI (OfficeFields floor desk) where
  sing = SOfficeFields sing sing

自动化这个位是一个悬而未决的问题：https://github.com/goldfirere/singletons/issues/150

接下来，让我们定义Addr，它只是一个依赖对：

type Addr = Sigma AddrType (TyCon AddrFields)

这是一个 Addr 值的示例：

x :: Addr
x = SPost :&: PostFields undefined undefined

PostFields的Symbol字段不能有任何居民，所以我只好用undefined填写，但目前这并不重要。请注意，我们已经有一个单例作为我们的第一个组件，SPost.

这就是单例的单例发挥作用的地方。我们可以单例化 x 如下：

xSing :: Sing @Addr (SPost :&: PostFields "Foo" "Bar")
xSing = sing

最后一点，让我们定义someCoolPredicate和AddrList：

singletons
  [d|
    someCoolPredicate :: [Addr] -> Bool
    someCoolPredicate (_ : _) = True
    someCoolPredicate [] = False
  |]

data AddrList :: [Addr] -> Type where
  MkAddrList :: (SomeCoolPredicate addrs ~ True) => Sing addrs -> AddrList addrs

deriving instance Show (AddrList addrs)

有了这个机制，您的 Idris 示例 MkAddrList [(Post ** PostFields "Foo" "Bar")] 编写如下：

ghci> MkAddrList @'[SPost :&: PostFields "Foo" "Bar"] sing
MkAddrList (SCons (SWrapSing {sUnwrapSing = SPost} :&: SPostFields (SSym @"Foo") (SSym @"Bar")) SNil)

完整代码在这里：https://gist.github.com/int-index/743ad7b9fcc54c9602b4eecdbdca34b5

将存在主义提升到类型级别

Lifting existentials to type level

haskell

dependent-type

singleton-type

idris