Realization of polymorphic "deep" function for bypasses and folds

Question

I use lens along with xml-lens . I would like to make the following function more polymorphic, so it also works for Folds and not only 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' sa -> Traversal' sa deep f = let go :: Traversal' sa; go = cloneTraversal $ failing f (plate . go) in go 

This function works like a deep function from hxt . Is it possible to make it more polymorphic at will?

Answer 1

This is quite complicated considering the current publicly open API.

I took the liberty of expanding the deepOf type to support indexed folds and indexed traversals along the way, as it was easier than not doing this, and makes the implementation complete, which we want to export from lens , anyway.

Let me import lens parts that we usually don’t show to users.

 {-# 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 

We will need some internal combinators that we do not set from Control.Lens.Traversal , which are used to control Traversal / Fold like BazaarT and reset the answer.

 pins :: (Bizarre pw, Corepresentable p) => wabt -> [Corep pa] pins = getConst #. bazaar (cotabulate $ \ra -> Const [ra]) {-# INLINE pins #-} unsafeOuts :: (Bizarre pw, Corepresentable p) => wabt -> [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 #-} 

Now that we have this, we will build the correct version of deep .

 -- | -- @ -- 'deep' :: 'Plated' s => 'Fold' sa -> 'Fold' sa -- 'deep' :: 'Plated' s => 'Traversal' ssab -> 'Traversal' ssab -- 'deep' :: 'Plated' s => 'IndexedFold' isa -> 'IndexedFold' isa -- 'deep' :: 'Plated' s => 'IndexedTraversal' ssab -> 'Traversal' issab -- @ deep :: (Plated s, Conjoined p, Applicative f) => Traversing pfssab -> Over pfssab deep = deepOf plate -- | -- @ -- 'deepOf' :: 'Fold ss' -> 'Fold' sa -> 'Fold' sa -- 'deepOf' :: 'Traversal' ss' -> 'Traversal' ssab -> 'Traversal' ssab -- 'deepOf' :: 'Fold ss' -> 'IndexedFold' isa -> 'IndexedFold' isa -- 'deepOf' :: 'Traversal' ss' -> 'IndexedTraversal' ssab -> 'Traversal' issab -- @ deepOf :: (Plated s, Conjoined p, Applicative f) => LensLike' fss -> Traversing pfssab -> Over pfssab deepOf rl pafb s = case pins b of [] -> r (deep l pafb) s xs -> unsafeOuts b <$> traverse (corep pafb) xs where b = l sell s 

The feelings of deepOf very similar to the existing failing guts that you rightfully tried to use as a workhorse.

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

The only difference is the case [], where instead of falling, we do all the nested Traversal .

I just checked this and haven't completed it, but it looks right.

Feel free to ask the question http://github.com/ekmett/lens/issues to add these combinators (or rename them), they probably belong to the lens API core so that code like this does not reach users, time as in the library itself is trivial to implement.

This is the code that we are trying to write once, so end users don’t need it.