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

Question

我正在尝试构造一个遍历来更新整个 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)’

我想这是一些二级诡计，但我仍然有点难以理解。 有什么办法可以做到这一点吗？

我的目标是

的最终签名

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

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

t3

。

Answer 1

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

Answer 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)

Answer 3

与光学核心相同：

ats :: Foldable f => At s => f (Index s) -> Traversal' s (Maybe (IxValue s))
ats = List.foldr (adjoin . at) (castOptic (noIx ignored))