Question

我想写一个分析异类列表的函数。为了论证，让我们有以下

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中每种类型和值实例化的约束知识。这种基于类的机制可以工作，但是在你不得不一遍又一遍地（和我这样做）的情况下，这种机制很笨拙而且冗长。

所以，我想用基于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

但这至少在几个维度上显得平淡。

什么是＆＃34;权利＆＃34;使用Singletons技术在异构列表上编写这样的函数的方法？有没有更好的方法来解决这个问题？在解决这类问题时我应该期待什么？

（作为参考，这是一个名为Serv的实验性Servant克隆。相关文件是Serv.Internal.Header.Serialization和Serv.Internal.Header作为背景。我想编写一个异构的函数已标记标头值的列表，然后headerEncode将它们放入实际(ByteString, ByteString)对的列表中。）

Answer 1

我认为这是一种合理的方法，只是......有时候你需要帮助输入类型系统。

首先，你编写All谓词的方式非常重要（如果它在适当的时候减少），我不知道你正在使用哪个All。

此外，您在名称上使用symbolVal但没有证明它是KnownSymbol - 您必须在某处添加此证明。对我来说唯一明显的地方是类型类：

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' :: (k0 -> k1 -> Constraint) -> [(k0,k1)] -> Constraint一样直接写All'。但是编写类型类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

Answer 2

我会尝试在这里提出一个“惯用的”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让我们抽象类型构造函数和类型系列，并为我们提供部分应用程序。它为我们提供了几乎一流的类型级函数，语法有些难看。请注意，我们必然会失去构造函数的注入性。 @@是应用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绑定，可让我在c中使用Proxy c作为简写。（如果我真的想要使用所有肮脏的技巧，我会添加{-# LANGUAGE PartialTypeSignatures #-}并写Proxy :: _ c）。

如果Haskell完全支持类型级函数，那么{p> UncurrySym1 (TyCon2 Analyze)会做同样的事情uncurry Analyze。这里的一个明显优势是我们可以在没有额外顶级类型系列或类的情况下即时写出analyzeRec的类型，并且更广泛地使用AllC。

作为奖励，我们从SingI移除Analyze约束，并尝试实施analyzeRec。

class Analyze (name :: Symbol) ty where
  analyze :: Proxy name -> ty -> Int

现在我们需要一个额外的约束来表示我们name中的所有Rec - 都是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表达的抽象级别内。当然，主要的限制是缺乏lambdas。理想情况下，我们不必使用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术语嵌入（又是由TH生成的另一个短序集合）。

我有一个prototype，虽然它只适用于更丑陋的de Bruijn变量，因为GHC错误。它还具有Fix和类型级别的显式惰性。

异构列表中的单身人士

2 个答案: