Control.Lens: przemierzania izomorfizm do toListOf i ponad

Question

Patrzyłem talk Simon Peyton Jones' O Control.Lens, a on pokazał, że obiektyw i LensR zdefiniowane tutaj są izomorficzne:

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 
} 

próbuję zrobić to samo z 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) 
} 

Ale utknąłem z travRToTrav. To jest najlepsze, co mogę wymyślić:

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 

tu magiczne :: a -> B, ale nie mogę zrobić ogólną funkcję (a -> b). Zamiast tego mogę oszukiwać, wykonując funkcję częściową: wiem, co funkcja powinna zwrócić dla dowolnej wartości typu a, która jest w ruchu. Mogę więc utworzyć listę asocjacyjną z as i bs, a następnie częściowo z tego wynikać.

Czy to działa? Jeśli tak, proszę powiedz mi, że jest lepszy sposób!

A może wybrałem niewłaściwą formę dla TraversableR, a właściwie nie ma izomorfizmu?

Dzięki za radę.

---

EDIT:

Więc dzięki András Kovács ja teraz myślę, że TraversalR powinna wyglądać następująco:

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

Następnie travRToTrav jest bardzo podobna do 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 

Ale jak zdefiniować setListR w travToTravR? Zasadniczo, w jaki sposób działają indeksowane traversals?

Answer 1

Po dyskusji z Andrásem Kovácsiem znalazłem prostą prostą odpowiedź: potrzebujemy monady państwowej, która jest funktorem aplikacyjnym. Oto cały izomorfizm:

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