Control.Lens: Traversal Isomorphismus toListOf und über

Question

Ich sah Simon Peyton Jones' Vortrag über Control.Lens, und er zeigte, dass Lens und LensR wie hier definiert sind isomorph:

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t 

data LensR s t a b = LensR { 
    viewR :: s -> a, 
    setR :: b -> s -> t 
} 

Ich versuche, mach das gleiche mit Traversal:

type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t 

data TraversalR s t a b = TraversalR { 
    toListOfR :: s -> [a], 
    overR :: (a -> b) -> s -> t 
} 

newtype CL a b = CL { getCL :: [a] } -- ConstantList 

instance Functor (CL a) where 
    fmap _ (CL xs) = CL xs 

instance Applicative (CL a) where 
    pure _ = CL [] 
    (CL xs) <*> (CL ys) = CL (xs ++ ys) 


travToTravR :: Traversal s t a b -> TraversalR s t a b 
travToTravR tr = TraversalR { 
    toListOfR = getCL . tr (CL . pure), 
    overR = \f -> runIdentity . tr (Identity . f) 
} 

Aber ich bin fest mit travRToTrav. Das ist das Beste, was ich mit oben kommen kann:

travRToTrav :: TraversalR s t a b -> Traversal s t a b 
travRToTrav trR a2fb s = (\bs-> overR trR magic s) <$> f_bs 
    where as = toListOfR trR s 
     f_bs = sequenceA . map a2fb $ as 
     magic = undefined 

Hier Magie :: a -> b, aber ich kann keine allgemeine Funktion (a -> b) machen. Stattdessen kann ich schummeln, indem ich eine Teilfunktion mache: Ich weiß, was die Funktion für jeden Wert des Typs a, der in traversable ist, zurückgeben soll. So könnte ich aus as und bs eine Assoziationsliste machen, und dann eine Teilfunktion daraus.

Funktioniert das? Wenn ja, sag mir bitte, es gibt einen besseren Weg!

Oder habe ich das falsche Formular für TraversableR gewählt, und es gibt tatsächlich keine Isomorphie?

Vielen Dank für jeden Hinweis.

---

EDIT:

So dank András Kovács jetzt denke ich, dass TraversalR sollte wie folgt aussehen:

data TraversalR s t a b = TraversalR { 
    toListOfR :: s -> [a], 
    setListR :: [b] -> s -> t 
} 

Dann travRToTrav zu lensRToLens sehr ähnlich ist:

travRToTrav :: TraversalR s t a b -> Traversal s t a b 
travRToTrav trR a2fb s = (`setL` s) <$> f_bs 
    where as = toListOfR trR s 
     f_bs = sequenceA . map a2fb $ as 
     setL = setListR trR 

Aber wie definiert man dann setListR in travToTravR? Wie funktionieren die indizierten Traversalen?

Answer 1

Nach einer Diskussion mit András Kovács habe ich eine schöne, einfache Antwort gefunden: Wir brauchen die Staatsmonade, die ein anwendungsbezogener Funktor ist. Hier ist der ganze Isomorphismus:

type Traversal s t a b = forall f. Applicative f => (a -> f b) -> (s -> f t) 

data TraversalR s t a b = TraversalR { 
    toListOfR :: s -> [a], 
    setListR :: [b] -> s -> t 
} 

newtype CL a b = CL { getCL :: [a] } -- ConstantList 

instance Functor (CL a) where 
    fmap _ (CL xs) = CL xs 

instance Applicative (CL a) where 
    pure _ = CL [] 
    (CL xs) <*> (CL ys) = CL (xs ++ ys) 

collectBs :: State [b] b 
collectBs = state $ \xs -> case xs of []  -> error "Too few bs" 
             (y:ys) -> (y,ys) 

travToTravR :: Traversal s t a b -> TraversalR s t a b 
travToTravR tr = TraversalR { 
    toListOfR = getCL . tr (CL . pure), 
    setListR = \bs s -> evalState (tr (const collectBs) s) bs 
} 

travRToTrav :: TraversalR s t a b -> Traversal s t a b 
travRToTrav trR a2fb s = (`setL` s) <$> f_bs 
    where as = toListOfR trR s 
     f_bs = sequenceA . map a2fb $ as 
     setL = setListR trR