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?

`TraversalR` doesn't seem good. With `Traversal`, you can do stateful traversal and e. g. replace each `a` with the index of their position. With `(a -> b) -> s -> t`, that's not possible. — András Kovács, Dec 22 '15 at 20:45
Oh OK - I hadn't realised. What should TraversalR look like then, do you think? — RhubarbAndC, Dec 22 '15 at 20:51
`overR :: [b] -> s -> t` would make `TraversalR` quite similar to [`biplate`](https://hackage.haskell.org/package/uniplate-1.6.12/docs/Data-Generics-Uniplate-Operations.html#t:Biplate), so that might worth a try. — András Kovács, Dec 22 '15 at 20:57
I may be wrong, but don't think that has solved my problem with defining magic above - how do I get the new values into the foci? — RhubarbAndC, Dec 22 '15 at 21:09
[`unsafePartsOf`](https://hackage.haskell.org/package/lens-4.13/docs/Control-Lens-Traversal.html#g:4) in `lens` can do that. The implementation could be hard to understand, but if you know that `newtype Bazaar a b t = Bazaar (forall f. Applicative f => (a -> f b) -> f t)` and its `Applicative` instance can be used to solve this, you're on the right track. — András Kovács, Dec 22 '15 at 23:20
@AndrásKovács I'm stumped. I'm guessing that I need to make a clever choice of Applicative to feed to the traversal, but Bazaar doesn't seem to be it: the best I can do is `runBazaar $ tr (\a -> Bazaar ($ a)) s :: forall f. Applicative f => (a -> f b) -> f t`. But then I'm back where I started, surely? — RhubarbAndC, Dec 23 '15 at 10:53
Let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/98810/discussion-between-rhubarbandc-and-andras-kovacs). — RhubarbAndC, Dec 23 '15 at 12:43

score 2 · Accepted Answer · answered Dec 23 '15 at 15:22

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

Control.Lens: Traversal isomorphism to toListOf and over

1 Answers1