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

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.是否有可能以我想要的方式使其更具多态性？

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

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