Control.Lens: Traversal изоморфизм к toListOf и над

Question

Я наблюдал разговор Саймон Пейтон Джонс о Control.Lens, и он показал, что объектив и LensR, как определено здесь изоморфны:

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 
} 

Я пытаюсь сделать то же самое с обходным:

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

Но я застрял с travRToTrav. Это лучшее, что я могу придумать:

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 

Здесь, магия :: А -> В, но я не могу сделать общую функцию (а -> б). Вместо этого я могу обманывать, выполняя частичную функцию: я знаю, что функция должна возвращать для любого значения типа a, которое находится в пересечении. Поэтому я мог бы составить список ассоциаций из as и bs, а затем частичную функцию из этого.

Это работает? Если да, скажите, что есть лучший способ!

Или я выбрал неправильную форму для TraversableR, и на самом деле нет изоморфизма?

Спасибо за любой совет.

---

EDIT:

Так благодаря Андраш Ковач теперь я думаю, что TraversalR должен выглядеть следующим образом:

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

Тогда travRToTrav очень похож на 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 

Но тогда, как определить setListR в travToTravR? В основном, как работают индексированные обходы?

Answer 1

После обсуждения с Андрасом Ковачем я нашел приятный простой ответ: нам нужна государственная монада, которая является прикладным функтором. Вот полный изоморфизм:

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