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

问题描述

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

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

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

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 一样。

解决方法

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

特别是，这里我们试图用 foldr :: (a -> b -> b) -> b -> [a] -> b 来实现，我们无法实例化 b = Traversal' _ _，因为 Traversal' 包含一个 forall。

一种解决方法是将 Traversal' 包装在新类型 ReifiedTraversal 中。在将 Traversal 传递给 at 1 之前包装（使用 foldr 构造函数）；在 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