在Haskell中模拟与路径有关的类型

Question

这是我要执行的操作的简化示例。假设您有HList对，

let hlist = HCons (1, "1") (HCons ("0", 2) (HCons ("0", 1.5) HNil))

现在，我想编写一个函数replaceAll，该函数将给定类型的所有“键”替换为相同类型的第一个“值”。例如，对于上面的HList，我想将所有String键替换为"1"，这是在String中找到的类型HList的第一个值

 replaceAll @String hlist =
    HCons (1, "1") (HCons ("1", 2) (HCons ("1", 1.5) HNil))

这似乎需要依赖于路径的类型，以便“提取”第一对对的类型，并能够在第二步中使用它来指导密钥的替换，但是我不知道如何在其中进行编码哈斯克尔。

Answer 1

这是一个证明搜索问题（“在此列表中发现String的出现”），因此您可以预期该解决方案将涉及类型类Prolog。我将回答您问题的一个简单版本（即“查找String的 first 首次出现”），并让您找出如何针对实际用例进行调整。

由于我们正在进行证明搜索，因此我们首先写下要搜索的证明对象。

data Contains a as where
    Here :: Contains a (a ': as)
    There :: Contains a as -> Contains a (b ': as)

类型Contains a as的值是一种建设性的证明，可以在类型级别列表a中找到as。从结构上讲，Contains就像一个自然数（将There (There Here)与S (S Z)比较）标识了a在列表as中的位置。要证明a中有as，请提供其索引。

例如，您可以replace中HList中给定位置的元素，并使用相同类型的新元素。

replace :: a -> Contains a as -> HList as -> HList as
replace x Here (HCons y ys) = HCons x ys
replace x (There i) (HCons y ys) = HCons y (replace x i ys)

---

我们要使用类型类Prolog在给定列表中搜索a。有两种情况-在列表的顶部找到a或在列表的末尾。 （如果a不在as中，则使用contains会失败，并出现“无实例”错误。）理想情况下，我们将编写如下内容：

class CONTAINS a as where
    contains :: Contains a as

instance CONTAINS a (a ': as) where
    contains = Here

instance CONTAINS a as => CONTAINS a (b ': as) where
    contains = There contains  -- recursively call `contains` on the sublist

，但这使重叠实例规则失败。在实例搜索过程中不会检查实例上下文和类型相等性-详细说明者不会回溯-因此，这两个实例都不比另一个具体。

幸运的是，这个问题a well-known solution。它涉及使用封闭类型族来区分a和b。您可以使用附加参数定义辅助类CONTAINS'，在这种情况下，Bool告诉您是否可以在a的开头找到as。

class CONTAINS' (eq :: Bool) a (as :: [*]) where
    contains' :: Contains a as

然后，您为eq是True或False的情况定义实例。详细制定者可以区分这些实例，因为True和False明显不同。请注意，该步骤案例将递归调用CONTAINS。

instance CONTAINS' True a (a ': as) where
    contains' = Here

instance CONTAINS a as => CONTAINS' False a (b ': as) where
    contains' = There contains

最后，您根据CONTAINS定义了CONTAINS'实例，并使用==的结果（一个测试其参数是否相等的封闭类型族）来选择一个实例。

instance CONTAINS' (a == b) a (b ': as) => CONTAINS a (b ': as) where
    contains = contains' @(a == b)

（这是布尔类型族很少接受的用法之一。）

现在，您可以像使用其他任何类一样使用CONTAINS。当您尝试实例化a和as时，GHC将尝试在a内搜索as，并且contains方法将返回其索引。

example :: Contains Int '[Bool, Int, Char]
example = contains

-- "no instance for CONTAINS"
failingExample :: Contains String '[Bool, Int, Char]
failingExample = contains

这是一个非常简单的示例，代码已经很混乱。您绝对可以以相同的方式处理问题中的示例，但是所有人都告诉我，我不认为静态检查值得这种情况下的复杂性。您是否考虑过基于Typeable的实现？

Answer 2

A bug在当前的GHC中打破了这一点。修复程序合并后，就可以正常工作。同时，另一个答案可以帮助您解决问题。

首先，定义

data Elem :: k -> [k] -> Type where
  Here :: Elem x (x : xs)
  There :: Elem x xs -> Elem x (y : xs)

一个Elem x xs告诉您在x中可以找到xs的位置。另外，这是一个存在性包装器：

data EntryOfVal v kvs = forall k. EntryOfVal (Elem (k, v) kvs)
-- to be clear, this is the type constructor (,) :: Type -> Type -> Type
type family EntryOfValKey (eov :: EntryOfVal v kvs) :: Type where
  EntryOfValKey ('EntryOfVal (_ :: Elem (k, v) kvs)) = k
type family GetEntryOfVal (eov :: EntryOfVal v kvs) :: Elem (EntryOfValKey eov, v) kvs where
  GetEntryOfVal ('EntryOfVal e) = e

如果您在类型级别上有一个Elem，则可以实现

class MElem (e :: Elem (x :: k) xs) where
  mElem :: Elem x xs
instance MElem Here where
  mElem = Here
instance MElem e => MElem (There e) where
  mElem = There (mElem @_ @_ @_ @e)

类似地，您可以实现EntryOfVal

type MEntryOfVal eov = MElem (GetEntryOfVal eov) -- can be a proper constraint synonym
mEntryOfVal :: forall v kvs (eov :: EntryOfVal v kvs).
               MEntryOfVal eov =>
               EntryOfVal v kvs
mEntryOfVal = EntryOfVal (mElem @_ @_ @_ @(GetEntryOfVal eov))

如果类型是类型列表的元素，则可以从该类型列表的HList中提取该类型的值：

indexH :: Elem t ts -> HList ts -> t
indexH Here (HCons x _) = x
indexH (There i) (HCons _ xs) = indexH i xs

（我觉得有必要指出indexH对HList的重要性。其中一个，HList ts与它的索引器forall t. Elem t ts -> t是同构的。而且，{{ 1}}有一个双indexH来表示合适的injS :: Elem t ts -> t -> Sum ts。）

同时，在类型级别上，此函数可以为您提供第一个可能的Sum（给定值类型和列表）：

EntryOfVal

将实现类与type family FirstEntryOfVal (v :: Type) (kvs :: [Type]) :: EntryOfVal v kvs where FirstEntryOfVal v ((k, v) : _) = 'EntryOfVal Here FirstEntryOfVal v (_ : kvs) = 'EntryOfVal (There (GetEntryOfVal (FirstEntryOfVal v kvs))) 分开的原因是，这些类是可重用的。您可以轻松地编写返回FirstEntryOfVal或Elem并实现它们的新类型族。将它们合并到一个整体类中很麻烦，现在您必须每次都重写EntryOfVal的“逻辑”（不是很多），而不是重新使用它。但是，我的方法确实带来了较高的前期成本。但是，所需的代码完全是机械的，因此可以想象TH库可以为您编写代码。我不知道 可以处理的库，但是MElem计划这样做。

现在，有了singletons证明，此函数可以为您提供一个值：

EntryOfVal

现在GHC可以为您做一些思考：

indexHVal :: forall v kvs. EntryOfVal v kvs -> HList kvs -> v
indexHVal (EntryOfVal e) = snd . indexH e

一旦有了值，就需要找到键。出于效率（我认为O（n）vs. O（n ^ 2））以及出于理智的考虑，我们不会制作indexHFirstVal :: forall v kvs. MEntryOfVal (FirstEntryOfVal v kvs) => HList kvs -> v indexHFirstVal = indexHVal (mEntryOfVal @_ @_ @(FirstEntryOfVal v kvs)) 的镜像，而是使用稍有不同的类型。现在，我将不做任何解释就给出样板

EntryOfVal

逻辑：

-- for maximal reuse:
-- data All :: (k -> Type) -> [k] -> Type
-- where an All f xs contains an f x for every x in xs
-- plus a suitable data type to recover EntriesOfKey from All
-- not done here mostly because All f xs's materialization
-- depends on f's, so we'd need more machinery to generically
-- do that
-- in an environment where the infrastructure already exists
-- (e.g. in singletons, where our materializers decompose as a
-- composition of SingI materialization and SingKind demotion)
-- using All would be feasible
data EntriesOfKey :: Type -> [Type] -> Type where
  Nowhere :: EntriesOfKey k '[]
  HereAndThere :: EntriesOfKey k kvs -> EntriesOfKey k ((k, v) : kvs)
  JustThere :: EntriesOfKey k kvs -> EntriesOfKey k (kv : kvs)
class MEntriesOfKey (esk :: EntriesOfKey k kvs) where
  mEntriesOfKey :: EntriesOfKey k kvs
instance MEntriesOfKey Nowhere where
  mEntriesOfKey = Nowhere
instance MEntriesOfKey e => MEntriesOfKey (HereAndThere e) where
  mEntriesOfKey = HereAndThere (mEntriesOfKey @_ @_ @e)
instance MEntriesOfKey e => MEntriesOfKey (JustThere e) where
  mEntriesOfKey = JustThere (mEntriesOfKey @_ @_ @e)

实际值操作

type family AllEntriesOfKey (k :: Type) (kvs :: [Type]) :: EntriesOfKey k kvs where
  AllEntriesOfKey _ '[] = Nowhere
  AllEntriesOfKey k ((k, _) : kvs) = HereAndThere (AllEntriesOfKey k kvs)
  AllEntriesOfKey k (_ : kvs) = JustThere (AllEntriesOfKey k kvs)

让GHC思考更多

updateHKeys :: EntriesOfKey k kvs -> (k -> k) -> HList kvs -> HList kvs
updateHKeys Nowhere f HNil = HNil
updateHKeys (HereAndThere is) f (HCons (k, v) kvs) = HCons (f k, v) (updateHKeys is f kvs)
updateHKeys (JustThere is) f (HCons kv kvs) = HCons kv (updateHKeys is f kvs)

现在在一起：

updateHAllKeys :: forall k kvs. MEntriesOfKey (AllEntriesOfKey k kvs) =>
                  (k -> k) -> HList kvs -> HList kvs
updateHAllKeys = updateHKeys (mEntriesOfKey @_ @_ @(AllEntriesOfKey k kvs))