尝试对其键的子集进行镜头/遍历映射多重更新

Posted 2023-02-19

【中文标题】尝试对其键的子集进行镜头/遍历映射多重更新

【英文标题】：Attempting lens/traversal map multi-update on a subset of its keys

【发布时间】：2021-04-19 08:09:27

【问题描述】：

我正在尝试使用遍历来更新整个 IntMap 的多个键。

消除 XY：我不是简单地尝试更新它们，我需要遍历返回给调用者以进一步组合。或者至少是可以与镜头组合的东西。

我尝试了许多常用组合器的变体。我已经尝试下降到基于函子的定义，大量的实验改变了foralls 的范围，但没有更多的成功。再次从头开始构建，这就是我所在的位置：

import Control.Lens
import Control.Lens.Unsound

-- base case: traverse a single fixed element
t1 :: Traversal' (IntMap a) (Maybe a)
t1 = at 0

-- build-up case: traverse a pair of fixed elements
t2 :: Traversal' (IntMap a) (Maybe a)
t2 = at 0 `adjoin` at 1

-- generalizing case: do it with a fold
t3 :: Traversal' (IntMap a) (Maybe a)
t3 = foldr (\e t -> at e `adjoin` t) (at 1) [0]

t1 和 t2 工作正常；我将t3 设计为等同于t2，但它失败并出现以下错误：

• Couldn't match type ‘f1’ with ‘f’
  ‘f1’ is a rigid type variable bound by a type expected by the context:
    Traversal' (IntMap a) (Maybe a)
  ‘f’ is a rigid type variable bound by the type signature for:
    t3 :: forall a. Traversal' (IntMap a) (Maybe a)
  Expected type: (Maybe a -> f1 (Maybe a)) -> IntMap a -> f1 (IntMap a)
  Actual type: (Maybe a -> f (Maybe a)) -> IntMap a -> f (IntMap a)
• In the second argument of ‘adjoin’, namely ‘t’   
  In the expression: at x `adjoin` t
  In the first argument of ‘foldr’, namely ‘(\ x t -> at x `adjoin` t)’

我想这是一些 2 级的诡计，我仍然有点想不通。有什么办法可以做到这一点？

我的目标是最终签名

ats :: Foldable l => l Int -> Traversal' (IntMap a) (Maybe a)

……当然，假设是唯一的键。我梦想的实现几乎就像t3。

【问题讨论】：

也许ifiltered 能帮上忙？ hackage.haskell.org/package/lens-4.19.2/docs/…

@danidiaz：快速浏览一下，我认为不是。 （但显然可能是错误的） (a) 我不认为我可以通过折叠更新？ (b) 类似谓词的界面使它看起来像是通过逐个检查键来工作，这是我买不起的，我确实需要对数映射访问。

【参考方案1】：

Traversal' 是包含 forall 的类型的类型同义词，这使其成为类型系统中的第二类公民：我们不能用这种类型实例化类型变量。

特别是，这里我们尝试使用foldr :: (a -> b -> b) -> b -> [a] -> b 这样做，我们无法实例化b = Traversal' _ _，因为Traversal' 包含forall。

一种解决方法是将Traversal' 包装在一个新类型ReifiedTraversal 中。在将at 1 传递给foldr 之前包装（使用Traversal 构造函数）；在foldr 内，打开包装以使用adjoin，然后重新包装；最后解开。

t3 :: Traversal' (IntMap a) (Maybe a)
t3 = runTraversal (foldr (\e t -> Traversal (at e `adjoin` runTraversal t)) (Traversal (at 1)) [0])

---

遍历是一个函数Applicative f => (t -> f t) -> (s -> f s)。你有一个函数f :: Maybe a -> f (Maybe a)，你想把它应用到IntMap a中的一些条目上。

使用Applicative 有点难题（使用Monad 有一个更自然的解决方案），但与将遍历组合为一等值相比，它所需的专业知识更少：

import Control.Applicative
import Data.IntMap (IntMap)
import qualified Data.IntMap as M

-- [Int] -> Traversal' (IntMap a) (Maybe a)
traverseAtKeys :: Applicative f => [Int] -> (Maybe a -> f (Maybe a)) -> IntMap a -> f (IntMap a)
traverseAtKeys keys f m =
  let go i k = liftA2 (insertMaybe i) (f (M.lookup i m)) k
      insertMaybe i Nothing = M.delete i
      insertMaybe i (Just v) = M.insert i v
  in foldr go (pure m) keys

【讨论】：

太完美了！事后看来，我已经尝试了很多接近你直接实现Applicative 的东西，但我总是尝试委托给at，并没有想到直接跳到IntMap。非常感谢！

【参考方案2】：

解决此类问题的一种方法是使用新类型包装器。具体来说，请考虑以下几点：

newtype TravJoiner a b = TravJoiner  unTravJoiner :: Traversal' a b 
instance Semigroup (TravJoiner a b) where
  TravJoiner x <> TravJoiner y = TravJoiner $ adjoin x y

有了这个，你可以毫无困难地写你的t3：

t3 :: Traversal' (IntMap a) (Maybe a)
t3 = unTravJoiner $ foldr (\e t -> TravJoiner (at e) <> t) (TravJoiner $ at 1) [0]

你的ats 函数很好地从那里开始：

ats :: Foldable l => l Int -> Traversal' (IntMap a) (Maybe a)
ats = unTravJoiner . foldr (\e t -> TravJoiner (at e) <> t) (TravJoiner ignored)