Control.Lens: Traversal isomorphism to toListOf and over

Question

I watched Simon Peyton Jones' talk about Control.Lens, and he showed that Lens and LensR as defined here are isomorphic:

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
}

I'm trying to do the same with 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)
}

But I'm stuck with travRToTrav. This is the best I can come up with:

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

Here, magic :: a -> b, but I can't make a general function (a -> b). Instead, I can cheat, by making a partial function: I know what the function should return for any value of type a that is in traversable. So I could make an association list from as and bs, and then a partial function from this.

Does this work? If so, please tell me there's a better way!

Or have I picked the wrong form for TraversableR, and there is actually no isomorphism?

Thanks for any advice.

---

EDIT:

So thanks to András Kovács I now think that TraversalR should look like this:

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

Then travRToTrav is very similar to 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

But then, how to define setListR in travToTravR? Basically, how do indexed traversals work?

Answer 1

After a discussion with András Kovács, I have found a nice simple answer: we need the State monad, which is an applicative functor. Here is the whole isomorphism:

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