haskell - Control.Lens : Traversal isomorphism to toListOf and over

Question

我观看了 Simon Peyton Jones 关于 Control.Lens 的演讲，他表明这里定义的 Lens 和 LensR 是同构的:

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

data LensR s t a b = LensR { 
    viewR :: s -> a,
    setR  :: b -> s -> t
}

我正在尝试对 Traversal 做同样的事情:

type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t

data TraversalR s t a b = TraversalR {
    toListOfR :: s -> [a],
    overR :: (a -> b) -> s -> t
}

newtype CL a b = CL { getCL :: [a] }  -- ConstantList

instance Functor (CL a) where
  fmap _ (CL xs) = CL xs

instance Applicative (CL a) where
  pure _ = CL []
  (CL xs) <*> (CL ys) = CL (xs ++ ys)


travToTravR :: Traversal s t a b -> TraversalR s t a b
travToTravR tr = TraversalR {
    toListOfR = getCL . tr (CL . pure),
    overR = \f -> runIdentity . tr (Identity . f)
}

但我坚持使用 travRToTrav。这是我能想到的最好的:

travRToTrav :: TraversalR s t a b -> Traversal s t a b
travRToTrav trR a2fb s = (\bs-> overR trR magic s) <$> f_bs
  where as = toListOfR trR s
        f_bs = sequenceA . map a2fb $ as
        magic = undefined

在这里，magic::a -> b，但我无法创建通用函数(a -> b)。相反，我可以通过创建一个部分函数来作弊:我知道对于任何可遍历的 a 类型的值，该函数应该返回什么。所以我可以从 as 和 bs 生成一个关联列表，然后从 this 生成一个部分函数。

这行得通吗？如果是这样，请告诉我有更好的方法!

或者我为 TraversableR 选择了错误的形式，实际上没有同构？

感谢您的任何建议。

编辑:

多亏了 András Kovács，我现在认为 TraversalR 应该是这样的:

data TraversalR s t a b = TraversalR {
  toListOfR :: s -> [a],
  setListR  :: [b] -> s -> t
}

那么 travRToTrav 与 lensRToLens 非常相似:

travRToTrav :: TraversalR s t a b -> Traversal s t a b
travRToTrav trR a2fb s = (`setL` s) <$> f_bs
   where as = toListOfR trR s
         f_bs = sequenceA . map a2fb $ as
         setL = setListR trR

那么，如何在 travToTravR 中定义 setListR 呢？基本上，索引遍历是如何工作的？

Answer 1

在与 András Kovács 讨论之后，我找到了一个很好的简单答案:我们需要 State monad，它是一个应用仿函数。这是整个同构:

type Traversal s t a b = forall f. Applicative f => (a -> f b) -> (s -> f t)

data TraversalR s t a b = TraversalR {
  toListOfR :: s -> [a],
  setListR  :: [b] -> s -> t
}

newtype CL a b = CL { getCL :: [a] }  -- ConstantList

instance Functor (CL a) where 
  fmap _ (CL xs) = CL xs

instance Applicative (CL a) where
  pure _ = CL []
  (CL xs) <*> (CL ys) = CL (xs ++ ys)

collectBs :: State [b] b
collectBs = state $ \xs -> case xs of []     -> error "Too few bs"
                                      (y:ys) -> (y,ys)

travToTravR :: Traversal s t a b -> TraversalR s t a b
travToTravR tr = TraversalR {
  toListOfR = getCL . tr (CL . pure),
  setListR = \bs s -> evalState (tr (const collectBs) s) bs
}

travRToTrav :: TraversalR s t a b -> Traversal s t a b
travRToTrav trR a2fb s = (`setL` s) <$> f_bs
   where as = toListOfR trR s
         f_bs = sequenceA . map a2fb $ as
         setL = setListR trR