6

我正在lens与xml-lens. 我想让以下函数更具多态性，以便它不仅适用Folds于Traversals：

-- | Traverse a plated structure recursively, trying to match a fold at each level. Don't recurse
-- if the fold matches.
deep :: forall s a. Plated s => Traversal' s a -> Traversal' s a
deep f = let go :: Traversal' s a; go = cloneTraversal $ failing f (plate . go) in go

此函数的工作方式类似于hxt. 是否可以按照我想要的方式使其更具多态性？

4

1 回答 1

6

鉴于当前公开的 API，这一点相当棘手。

我冒昧地扩展了 的类型，deepOf以支持索引折叠和索引遍历，因为这样做比不这样做更容易，并且无论如何都可以使实现成为我们想要从中导出的完整实现lens。

让我们导入lens我们通常不向用户展示的部分。

{-# LANGUAGE RankNTypes #-}

import Control.Applicative
import Control.Lens
import Control.Lens.Internal.Bazaar
import Control.Lens.Internal.Context
import Control.Lens.Traversal
import Control.Monad.State
import Data.Profunctor.Rep
import Data.Profunctor.Unsafe

我们将需要一些我们不公开的内部组合器，Control.Lens.Traversal用于将Traversal/操作Fold为 aBazaarT并将答案折叠回来。

pins :: (Bizarre p w, Corepresentable p) => w a b t -> [Corep p a]
pins = getConst #. bazaar (cotabulate $ \ra -> Const [ra])
{-# INLINE pins #-}

unsafeOuts :: (Bizarre p w, Corepresentable p) => w a b t -> [b] -> t
unsafeOuts = evalState `rmap` bazaar (cotabulate (\_ -> state (unconsWithDefault fakeVal)))
  where fakeVal = error "unsafePartsOf': not enough elements were supplied"
{-# INLINE unsafeOuts #-}

unconsWithDefault :: a -> [a] -> (a,[a])
unconsWithDefault d []     = (d,[])
unconsWithDefault _ (x:xs) = (x,xs)
{-# INLINE unconsWithDefault #-}

现在我们有了它，我们构建了一个正确的deep.

-- |
-- @
-- 'deep' :: 'Plated' s => 'Fold' s a                 -> 'Fold' s a
-- 'deep' :: 'Plated' s => 'Traversal' s s a b        -> 'Traversal' s s a b
-- 'deep' :: 'Plated' s => 'IndexedFold' i s a        -> 'IndexedFold' i s a
-- 'deep' :: 'Plated' s => 'IndexedTraversal' s s a b -> 'Traversal' i s s a b
-- @
deep :: (Plated s, Conjoined p, Applicative f) => Traversing p f s s a b -> Over p f s s a b
deep = deepOf plate

-- |
-- @
-- 'deepOf' :: 'Fold s s'       -> 'Fold' s a                 -> 'Fold' s a
-- 'deepOf' :: 'Traversal' s s' -> 'Traversal' s s a b        -> 'Traversal' s s a b
-- 'deepOf' :: 'Fold s s'       -> 'IndexedFold' i s a        -> 'IndexedFold' i s a
-- 'deepOf' :: 'Traversal' s s' -> 'IndexedTraversal' s s a b -> 'Traversal' i s s a b
-- @
deepOf :: (Plated s, Conjoined p, Applicative f) => LensLike' f s s -> Traversing p f s s a b -> Over p f s s a b
deepOf r l pafb s = case pins b of
  [] -> r (deep l pafb) s
  xs -> unsafeOuts b <$> traverse (corep pafb) xs
  where b = l sell s

的胆量deepOf与现有的胆量非常相似failing，您正确地尝试将其用作主力。

failing :: (Conjoined p, Applicative f) => Traversing p f s t a b -> Traversing p f s t a b -> Over p f s t a b
failing l r pafb s = case pins b of
  [] -> runBazaarT (r sell s) pafb
  xs -> unsafeOuts b <$> traverse (corep pafb) xs
  where b = l sell s

唯一不同的是 [] 情况，我们所做的不是跌倒，而是运行整个嵌套的Traversal.

我只是对它进行了类型检查，并没有实际执行它，但它看起来对我来说是正确的。

随意在http://github.com/ekmett/lens/issues上提出问题以添加这些组合器（或对它们进行一些重命名），它们可能属于核心lensAPI，以免像这样的代码落在用户身上，虽然在库本身内实现是微不足道的。

这是我们尝试编写一次的代码，因此最终用户不必这样做。

于 2014-05-09T22:59:33.750 回答