Control.Lens：遍历同构到toListOf以上

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
}

我正在尝试对遍历做同样的事情：

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 类型的任何值，函数应该 return 什么。所以我可以从 as 和 bs 创建一个关联列表，然后从这个创建一个部分函数。

这个有用吗？如果是这样，请告诉我有更好的方法！

还是我选错了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

Control.Lens：遍历同构到toListOf以上

Control.Lens: Traversal isomorphism to toListOf and over

haskell

haskell-lens