Question

我正在使用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中的deep功能类似。是否有可能以我想要的方式使其更具多态性？

Answer 1

鉴于当前公开的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作为BazaarT然后把答案弄清楚了。

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上添加一些问题来添加这些组合器（或者对它们进行一些双击重命名），它们可能属于核心lens API，以免此类代码落在用户身上，虽然在图书馆内部实施它是微不足道的。

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

为遍历和折叠实现多态“深度”函数

1 个答案: