Control.Lens: Traversal isomorfismo per toListOf e più

Question

ho visto parlare Simon Peyton Jones' su Control.Lens, e ha dimostrato che Lens e LensR come definiti qui sono isomorfi:

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 
} 

sto cercando di fare lo stesso con 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) 
} 

Ma io sono bloccato con travRToTrav. Questo è il meglio che posso venire con:

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 

Qui, magia :: a -> b, ma non riesco a fare una funzione generale (a -> b). Invece, posso imbrogliare, facendo una funzione parziale: so cosa deve restituire la funzione per qualsiasi valore di tipo a che è in attraversabile. Quindi potrei creare una lista di associazioni da as e bs, e quindi una funzione parziale da questa.

Funziona? Se è così, per favore dimmi che c'è un modo migliore!

Oppure ho scelto la forma sbagliata per TraversableR e in realtà non esiste alcun isomorfismo?

Grazie per qualsiasi consiglio.

---

EDIT:

Quindi grazie a András Kovács ora penso che TraversalR dovrebbe assomigliare a questa:

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

Poi travRToTrav è molto simile a lensRToLens:

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 

Ma poi, come definire setListR in travToTravR? Fondamentalmente, come funzionano gli attraversamenti indicizzati?

Answer 1

Dopo una discussione con András Kovács, ho trovato una bella risposta semplice: abbiamo bisogno della monade di Stato, che è un funtore applicativo. Ecco l'intero isomorfismo:

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