异构列表中的单例
Singletons in Heterogenous Lists
我想编写一个分析异构列表的函数。为了争论，让我们有以下
data Rec rs where
Nil :: Rec '[]
Cons :: ty -> Rec rs -> Rec ( '(name, ty) ': rs )
class Analyze name ty where
analyze :: Proxy name -> ty -> Int
最终目标是编写如下内容
class AnalyzeRec rs where
analyzeRec :: Rec rs -> [(String, Int)]
instance AnalyzeRec '[] where
analyzeRec Nil = []
instance (Analyze name ty, AnalyzeRec rs) =>
AnalyzeRec ( '(name, ty) ': rs )
where
analyzeRec (Cons hd tl) =
let proxy = Proxy :: Proxy name
in (symbolVal proxy, analyze proxy hd) : analyzeRec tl
analyzeRec 的显着位使用了在 Rec 中每个类型和值实例化的约束知识。此 class-based 机制有效，但在您必须一遍又一遍地执行此操作（我也是）的情况下显得笨拙和冗长。
因此，我想将其替换为基于 singletons 的机制。我想写一个像
这样的函数
-- no type class!
analyzeRec :: All Analyze rs => Rec rs -> [(String, Int)]
analyzeRec rec =
case rec of
Nil -> []
Cons hd tl -> withSing $ \s ->
(symbolVal s, analyze s hd) : analyzeRec tl
但这显然至少在几个维度上持平。
使用 Singletons 技术在异构列表上编写这样一个函数的 "right" 方法是什么？有没有更好的方法来解决这个问题？解决这类问题我应该期待什么？
（作为参考，这是一个名为 Serv 的实验性 Servant 克隆。相关文件是 Serv.Internal.Header.Serialization and Serv.Internal.Header 作为背景。我想编写一个函数，它接受一个标记为 [=38 的异构列表=] 值，然后 headerEncode 将它们放入实际的 (ByteString, ByteString) 对列表中。）
我认为这是一种合理的方法，只是..有时您需要稍微帮助一下类型系统。
首先，您编写 All 谓词的方式很重要（如果它在适当的时候减少），我不知道您使用的是哪个 All。
此外，您在名称上使用了 symbolVal，但没有证据表明它是 KnownSymbol - 您必须在某处添加此证据。对我来说，唯一明显的地方是类型 class:
class KnownSymbol name => Analyze name ty where
analyze :: Proxy name -> ty -> Int
这里是 All 谓词：
type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint where
All c '[] = ()
All c (x ': xs) = (c x, All c xs)
注意这一行
analyzeRec :: All Analyze rs => Rec rs -> [(String, Int)]
不进行类型检查（不是很好）。 rs 的每个元素都是一个元组。我们可以像 All' 一样直接写 All' :: (k0 -> k1 -> Constraint) -> [(k0,k1)] -> Constraint 。但是写一个类型 class Uncurry:
更有趣
type family Fst (x :: (k0, k1)) :: k0 where
Fst '(x,y) = x
type family Snd (x :: (k0, k1)) :: k1 where
Snd '(x,y) = y
class (c (Fst x) (Snd x)) => Uncurry (c :: k0 -> k1 -> Constraint) (x :: (k0, k1)) where
instance (c x y) => Uncurry c '(x, y)
如果这个Uncurry看起来非常复杂，那又是因为Uncurry c '(x,y)在正确的时间减少到c x y很重要，所以它是这样写的强制（或者更确切地说允许）类型检查器在看到它时减少此约束。现在函数是
analyzeRec :: All (Uncurry Analyze) rs => Rec rs -> [(String, Int)]
analyzeRec r =
case r of
Nil -> []
(Cons hd tl) -> let s = recName r in (symbolVal s, analyze s hd) : analyzeRec tl
-- Helper
recName :: Rec ('(name,ty)':rs) -> Proxy name
recName _ = Proxy
这没有使用 singletons 中的任何内容，也不需要它。
完整的工作代码
{-# LANGUAGE PolyKinds, ConstraintKinds, UndecidableInstances, TypeOperators #-}
{-# LANGUAGE DataKinds, GADTs, MultiParamTypeClasses, TypeFamilies, FlexibleInstances, FlexibleContexts #-}
import Data.Proxy
import GHC.TypeLits
import GHC.Prim (Constraint)
data Rec rs where
Nil :: Rec '[]
Cons :: ty -> Rec rs -> Rec ( '(name, ty) ': rs )
class KnownSymbol name => Analyze name ty where
analyze :: Proxy name -> ty -> Int
type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint where
All c '[] = ()
All c (x ': xs) = (c x, All c xs)
type family Fst (x :: (k0, k1)) :: k0 where
Fst '(x,y) = x
type family Snd (x :: (k0, k1)) :: k1 where
Snd '(x,y) = y
class (c (Fst x) (Snd x)) => Uncurry (c :: k0 -> k1 -> Constraint) (x :: (k0, k1)) where
instance (c x y) => Uncurry c '(x, y)
recName :: Rec ('(name,ty)':rs) -> Proxy name
recName _ = Proxy
analyzeRec :: All (Uncurry Analyze) rs => Rec rs -> [(String, Int)]
analyzeRec r =
case r of
Nil -> []
(Cons hd tl) -> let s = recName r in (symbolVal s, analyze s hd) : analyzeRec tl
我将尝试在这里展示一个 "idiomatic" singletons 解决方案（如果这样的事情存在的话）。预赛：
{-# LANGUAGE
RankNTypes, DataKinds, PolyKinds, ConstraintKinds, GADTs,
TypeOperators, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables #-}
import Data.Singletons.Prelude
import Data.Proxy
import GHC.Exts (Constraint)
-- SingI constraint here for simplicity's sake
class SingI name => Analyze (name :: Symbol) ty where
analyze :: Proxy name -> ty -> Int
data Rec rs where
Nil :: Rec '[]
Cons :: ty -> Rec rs -> Rec ( '(name, ty) ': rs )
recName :: Rec ('(name, t) ': rs) -> Proxy name
recName _ = Proxy
我们需要一个 All c rs 约束，但我们给它一个旋转并使 c 成为一个 TyFun 而不是一个普通的 a -> Constraint 构造函数：
type family AllC (c :: TyFun a Constraint -> *) (rs :: [a]) :: Constraint where
AllC c '[] = ()
AllC c (x ': xs) = (c @@ x, AllC c xs)
TyFun 让我们对类型构造函数进行抽象 和 类型族，并为我们提供部分应用。它为我们提供了几乎是 first-class 类型级的函数，但语法有点难看。请注意，我们必然会失去构造函数的内射性。 @@ 是应用 TyFun-s 的运算符。 TyFun a b -> * 表示 a 是输入，b 是输出，尾随 -> * 只是编码的产物。使用 GHC 8.0，我们将能够做到
type a ~> b = TyFun a b -> *
然后使用a ~> b。
我们现在可以在 Rec:
上实现一个通用的 "classy" 映射
cMapRec ::
forall c rs r.
AllC c rs => Proxy c -> (forall name t. (c @@ '(name, t)) => Proxy name -> t -> r) -> Rec rs -> [r]
cMapRec p f Nil = []
cMapRec p f r@(Cons x xs) = f (recName r) x : cMapRec p f xs
注意上面c有种TyFun (a, *) Constraint -> *.
然后执行analyzeRec:
analyzeRec ::
forall c rs. (c ~ UncurrySym1 (TyCon2 Analyze))
=> AllC c rs => Rec rs -> [(String, Int)]
analyzeRec = cMapRec (Proxy :: Proxy c) (\p t -> (fromSing $ singByProxy p, analyze p t))
首先，c ~ UncurrySym1 (TyCon2 Analyze) 只是一个类型级别的 let 绑定，让我可以将 Proxy c 中的 c 用作 shorthand。 （如果我真的想使用所有肮脏的技巧，我会添加 {-# LANGUAGE PartialTypeSignatures #-} 并写成 Proxy :: _ c）。
如果 Haskell 完全支持类型级函数，UncurrySym1 (TyCon2 Analyze) 会做与 uncurry Analyze 相同的事情。这里的明显优势是我们可以在没有额外的顶级类型族或 classes 的情况下即时写出 analyzeRec 的类型，并且还可以更普遍地使用 AllC 。
作为奖励，让我们从 Analyze 中删除 SingI 约束，并尝试实现 analyzeRec。
class Analyze (name :: Symbol) ty where
analyze :: Proxy name -> ty -> Int
现在我们必须要求一个额外的约束来表示 Rec 中的所有 name-s 都是 SingI。我们可以使用两个 cMapRec-s，并压缩结果：
analyzeRec ::
forall analyze names rs.
(analyze ~ UncurrySym1 (TyCon2 Analyze),
names ~ (TyCon1 SingI :.$$$ FstSym0),
AllC analyze rs,
AllC names rs)
=> Rec rs -> [(String, Int)]
analyzeRec rc = zip
(cMapRec (Proxy :: Proxy names) (\p _ -> fromSing $ singByProxy p) rc)
(cMapRec (Proxy :: Proxy analyze) (\p t -> analyze p t) rc)
这里TyCon1 SingI :.$$$ FstSym0可以翻译成SingI . fst.
这仍然大致在可以用 TyFun-s 轻松表达的抽象级别内。当然，主要的限制是缺少 lambda。理想情况下，我们不必使用 zip，而是使用 AllC (\(name, t) -> (SingI name, Analyze name t))，并使用单个 cMapRec。使用 singletons，如果我们不能再使用无点类型级编程来实现它，我们必须引入一个新的有点类型系列。
有趣的是，GHC 8.0 将足够强大，因此我们可以从头开始实现类型级别的 lambda，尽管它可能非常丑陋。例如，\p -> (SingI (fst p), uncurry Analyze p) 可能看起来像这样：
Eval (
Lam "p" $
PairL :@@
(LCon1 SingI :@@ (FstL :@@ Var "p")) :@@
(UncurryL :@@ LCon2 Analyze :@@ Var "p"))
其中所有 L 后缀表示普通 TyFun-s 的 lambda 项嵌入（又是 shorthands 的集合，由 TH... 生成）。
我有一个 prototype，尽管由于 GHC 错误，它只适用于更丑陋的 de Bruijn 变量。它还具有 Fix 和类型级别的显式惰性。
我想编写一个分析异构列表的函数。为了争论，让我们有以下
data Rec rs where
Nil :: Rec '[]
Cons :: ty -> Rec rs -> Rec ( '(name, ty) ': rs )
class Analyze name ty where
analyze :: Proxy name -> ty -> Int
最终目标是编写如下内容
class AnalyzeRec rs where
analyzeRec :: Rec rs -> [(String, Int)]
instance AnalyzeRec '[] where
analyzeRec Nil = []
instance (Analyze name ty, AnalyzeRec rs) =>
AnalyzeRec ( '(name, ty) ': rs )
where
analyzeRec (Cons hd tl) =
let proxy = Proxy :: Proxy name
in (symbolVal proxy, analyze proxy hd) : analyzeRec tl
analyzeRec 的显着位使用了在 Rec 中每个类型和值实例化的约束知识。此 class-based 机制有效，但在您必须一遍又一遍地执行此操作（我也是）的情况下显得笨拙和冗长。
因此，我想将其替换为基于 singletons 的机制。我想写一个像
-- no type class!
analyzeRec :: All Analyze rs => Rec rs -> [(String, Int)]
analyzeRec rec =
case rec of
Nil -> []
Cons hd tl -> withSing $ \s ->
(symbolVal s, analyze s hd) : analyzeRec tl
但这显然至少在几个维度上持平。
使用 Singletons 技术在异构列表上编写这样一个函数的 "right" 方法是什么？有没有更好的方法来解决这个问题？解决这类问题我应该期待什么？
（作为参考，这是一个名为 Serv 的实验性 Servant 克隆。相关文件是 Serv.Internal.Header.Serialization and Serv.Internal.Header 作为背景。我想编写一个函数，它接受一个标记为 [=38 的异构列表=] 值，然后 headerEncode 将它们放入实际的 (ByteString, ByteString) 对列表中。）
我认为这是一种合理的方法，只是..有时您需要稍微帮助一下类型系统。
首先，您编写 All 谓词的方式很重要（如果它在适当的时候减少），我不知道您使用的是哪个 All。
此外，您在名称上使用了 symbolVal，但没有证据表明它是 KnownSymbol - 您必须在某处添加此证据。对我来说，唯一明显的地方是类型 class:
class KnownSymbol name => Analyze name ty where
analyze :: Proxy name -> ty -> Int
这里是 All 谓词：
type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint where
All c '[] = ()
All c (x ': xs) = (c x, All c xs)
注意这一行
analyzeRec :: All Analyze rs => Rec rs -> [(String, Int)]
不进行类型检查（不是很好）。 rs 的每个元素都是一个元组。我们可以像 All' 一样直接写 All' :: (k0 -> k1 -> Constraint) -> [(k0,k1)] -> Constraint 。但是写一个类型 class Uncurry:
type family Fst (x :: (k0, k1)) :: k0 where
Fst '(x,y) = x
type family Snd (x :: (k0, k1)) :: k1 where
Snd '(x,y) = y
class (c (Fst x) (Snd x)) => Uncurry (c :: k0 -> k1 -> Constraint) (x :: (k0, k1)) where
instance (c x y) => Uncurry c '(x, y)
如果这个Uncurry看起来非常复杂，那又是因为Uncurry c '(x,y)在正确的时间减少到c x y很重要，所以它是这样写的强制（或者更确切地说允许）类型检查器在看到它时减少此约束。现在函数是
analyzeRec :: All (Uncurry Analyze) rs => Rec rs -> [(String, Int)]
analyzeRec r =
case r of
Nil -> []
(Cons hd tl) -> let s = recName r in (symbolVal s, analyze s hd) : analyzeRec tl
-- Helper
recName :: Rec ('(name,ty)':rs) -> Proxy name
recName _ = Proxy
这没有使用 singletons 中的任何内容，也不需要它。
完整的工作代码
{-# LANGUAGE PolyKinds, ConstraintKinds, UndecidableInstances, TypeOperators #-}
{-# LANGUAGE DataKinds, GADTs, MultiParamTypeClasses, TypeFamilies, FlexibleInstances, FlexibleContexts #-}
import Data.Proxy
import GHC.TypeLits
import GHC.Prim (Constraint)
data Rec rs where
Nil :: Rec '[]
Cons :: ty -> Rec rs -> Rec ( '(name, ty) ': rs )
class KnownSymbol name => Analyze name ty where
analyze :: Proxy name -> ty -> Int
type family All (c :: k -> Constraint) (xs :: [k]) :: Constraint where
All c '[] = ()
All c (x ': xs) = (c x, All c xs)
type family Fst (x :: (k0, k1)) :: k0 where
Fst '(x,y) = x
type family Snd (x :: (k0, k1)) :: k1 where
Snd '(x,y) = y
class (c (Fst x) (Snd x)) => Uncurry (c :: k0 -> k1 -> Constraint) (x :: (k0, k1)) where
instance (c x y) => Uncurry c '(x, y)
recName :: Rec ('(name,ty)':rs) -> Proxy name
recName _ = Proxy
analyzeRec :: All (Uncurry Analyze) rs => Rec rs -> [(String, Int)]
analyzeRec r =
case r of
Nil -> []
(Cons hd tl) -> let s = recName r in (symbolVal s, analyze s hd) : analyzeRec tl
我将尝试在这里展示一个 "idiomatic" singletons 解决方案（如果这样的事情存在的话）。预赛：
{-# LANGUAGE
RankNTypes, DataKinds, PolyKinds, ConstraintKinds, GADTs,
TypeOperators, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables #-}
import Data.Singletons.Prelude
import Data.Proxy
import GHC.Exts (Constraint)
-- SingI constraint here for simplicity's sake
class SingI name => Analyze (name :: Symbol) ty where
analyze :: Proxy name -> ty -> Int
data Rec rs where
Nil :: Rec '[]
Cons :: ty -> Rec rs -> Rec ( '(name, ty) ': rs )
recName :: Rec ('(name, t) ': rs) -> Proxy name
recName _ = Proxy
我们需要一个 All c rs 约束，但我们给它一个旋转并使 c 成为一个 TyFun 而不是一个普通的 a -> Constraint 构造函数：
type family AllC (c :: TyFun a Constraint -> *) (rs :: [a]) :: Constraint where
AllC c '[] = ()
AllC c (x ': xs) = (c @@ x, AllC c xs)
TyFun 让我们对类型构造函数进行抽象 和 类型族，并为我们提供部分应用。它为我们提供了几乎是 first-class 类型级的函数，但语法有点难看。请注意，我们必然会失去构造函数的内射性。 @@ 是应用 TyFun-s 的运算符。 TyFun a b -> * 表示 a 是输入，b 是输出，尾随 -> * 只是编码的产物。使用 GHC 8.0，我们将能够做到
type a ~> b = TyFun a b -> *
然后使用a ~> b。
我们现在可以在 Rec:
cMapRec ::
forall c rs r.
AllC c rs => Proxy c -> (forall name t. (c @@ '(name, t)) => Proxy name -> t -> r) -> Rec rs -> [r]
cMapRec p f Nil = []
cMapRec p f r@(Cons x xs) = f (recName r) x : cMapRec p f xs
注意上面c有种TyFun (a, *) Constraint -> *.
然后执行analyzeRec:
analyzeRec ::
forall c rs. (c ~ UncurrySym1 (TyCon2 Analyze))
=> AllC c rs => Rec rs -> [(String, Int)]
analyzeRec = cMapRec (Proxy :: Proxy c) (\p t -> (fromSing $ singByProxy p, analyze p t))
首先，c ~ UncurrySym1 (TyCon2 Analyze) 只是一个类型级别的 let 绑定，让我可以将 Proxy c 中的 c 用作 shorthand。 （如果我真的想使用所有肮脏的技巧，我会添加 {-# LANGUAGE PartialTypeSignatures #-} 并写成 Proxy :: _ c）。
UncurrySym1 (TyCon2 Analyze) 会做与 uncurry Analyze 相同的事情。这里的明显优势是我们可以在没有额外的顶级类型族或 classes 的情况下即时写出 analyzeRec 的类型，并且还可以更普遍地使用 AllC 。
作为奖励，让我们从 Analyze 中删除 SingI 约束，并尝试实现 analyzeRec。
class Analyze (name :: Symbol) ty where
analyze :: Proxy name -> ty -> Int
现在我们必须要求一个额外的约束来表示 Rec 中的所有 name-s 都是 SingI。我们可以使用两个 cMapRec-s，并压缩结果：
analyzeRec ::
forall analyze names rs.
(analyze ~ UncurrySym1 (TyCon2 Analyze),
names ~ (TyCon1 SingI :.$$$ FstSym0),
AllC analyze rs,
AllC names rs)
=> Rec rs -> [(String, Int)]
analyzeRec rc = zip
(cMapRec (Proxy :: Proxy names) (\p _ -> fromSing $ singByProxy p) rc)
(cMapRec (Proxy :: Proxy analyze) (\p t -> analyze p t) rc)
这里TyCon1 SingI :.$$$ FstSym0可以翻译成SingI . fst.
这仍然大致在可以用 TyFun-s 轻松表达的抽象级别内。当然，主要的限制是缺少 lambda。理想情况下，我们不必使用 zip，而是使用 AllC (\(name, t) -> (SingI name, Analyze name t))，并使用单个 cMapRec。使用 singletons，如果我们不能再使用无点类型级编程来实现它，我们必须引入一个新的有点类型系列。
有趣的是，GHC 8.0 将足够强大，因此我们可以从头开始实现类型级别的 lambda，尽管它可能非常丑陋。例如，\p -> (SingI (fst p), uncurry Analyze p) 可能看起来像这样：
Eval (
Lam "p" $
PairL :@@
(LCon1 SingI :@@ (FstL :@@ Var "p")) :@@
(UncurryL :@@ LCon2 Analyze :@@ Var "p"))
其中所有 L 后缀表示普通 TyFun-s 的 lambda 项嵌入（又是 shorthands 的集合，由 TH... 生成）。
我有一个 prototype，尽管由于 GHC 错误，它只适用于更丑陋的 de Bruijn 变量。它还具有 Fix 和类型级别的显式惰性。