Implementieren polymorphe 'tiefe' Funktion für Traversalen und Falten

Question

Ich verwende lens zusammen mit xml-lens. Ich mag die folgende Funktion mehr polymorphe machen, so dass es funktioniert auch für Folds und nicht nur 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 

Diese Funktion arbeitet wie die deep Funktion von hxt. Ist es möglich, es polymorpher zu machen, so wie ich es möchte?

Answer 1

Dieser ist ziemlich schwierig angesichts der aktuellen öffentlich zugänglichen API.

nahm ich mir die Freiheit, die Art von deepOf erweitert auch indizierte Falten und indizierte Querungen auf dem Weg zu unterstützen, da es leichter war, als dies nicht zu tun, und macht die Implementierung der voll sein wir von lens exportieren wollen würde , Sowieso.

Lassen Sie uns die Teile von lens importieren, die wir normalerweise nicht Benutzern zeigen.

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

Wir werden ein paar internen combinators brauchen, die wir aussetzen nicht von Control.Lens.Traversal die verwendet wird, ein Traversal/Fold als BazaarT zu manipulieren und wieder aus der Antwort kollabieren.

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

Nun, da wir das haben, bauen wir eine korrekte Version von 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 

Die Eingeweide von deepOf sind sehr ähnlich zu dem bestehenden Gedärme failing, die Sie zu Recht als Zugpferd zu nutzen versuchen.

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 

Das einzige, was anders ist der [] Fall, wo statt über fallender, was wir tun, läuft die ganze verschachtelten Traversal.

Ich habe das nur überprüft und nicht wirklich ausgeführt, aber es sieht gut aus für mich.

Fühlen Sie sich frei auf http://github.com/ekmett/lens/issues in einer Ausgabe setzen diese combinators (oder etwas bikeshedded Umbenennung von ihnen) hinzuzufügen, sie gehören wahrscheinlich im Kern lens API, damit Code wie in diesem Herbst auf Nutzer, während es trivial ist innerhalb umzusetzen die Bibliothek selbst.

Dies ist die Art von Code, den wir einmal schreiben wollen, damit die Endbenutzer nicht müssen.