Writing a more complex Traversal (Lenses)

Question

I'm diving continually deeper into Kmett's lenses; today I'm attempting to write some custom traversals, up until now I've managed to get along by composing existing traversals to create new ones, but I'm doing something a little more complicated and got stuck.

I'm writing a text editor and I'm just adding multiple cursors, originally each buffer had one cursor and had a lens to focus it, now I'm generalizing to a list of cursors and want a traversal over the list. The trick is that in the previous case my lens did some validation inside the setter to ensure that a cursor was clamped to fit within the valid range of the buffer's text. It looked like this:

clampCursor :: Text -> Cursor -> Cursor

cursor :: Lens' Buffer Cursor
cursor = lens getter setter
  where getter buf = buf^.curs
        setter buf new = let txt = buf^.text
                          in buf & curs .~ clampCursor txt new

Note how it uses the text info from the context of the buffer to create a lens over the cursor; (Also I'd love to hear about any cleaner ways to do this instead of making custom lenses if anyone has suggestions, I've found myself doing it a lot).

So now that I've got multiple cursors I need to transform this into a Traversal', but of course I can't define a traversal using the lens getter setter method; Looking around for how to define traversals I read this tutorial; Which states the following:

Question: How do I create traversals?

Answer: There are three main ways to create primitive traversals:

• traverse is a Traversal' that you get for any type that implements Traversable
• Every Lens' will also type-check as a Traversal'
• You can use Template Haskell to generate Traversal's using makePrisms since every Prism' is also a Traversal' (not covered in this tutorial)

None of those methods really help out here; I've also seen the style where you create a traversal using applicative style, but it's always been a bit confusing to me and I don't really know how I would use it in this case to get what I want.

I suppose I could write a Lens' Buffer [Cursor] which maps over the cursors in the setter to perform the validation and THEN traverse that list, but I figure there's got to be a way to bake it into the traversal AFTER the traverse (when each single element is focused) somehow. Maybe there's a better way to do this entirely;

Still looking to learn as much as I can about traversals, so any explanations are appreciated! Thanks!

EDIT: @dfeuer pointed out that when you do this sort of validation you end up with invalid lenses, I really like the clean interface it provides to do them inside the lens; and so far as I know, since the validation is idempotent it shouldn't cause any real issue, but I'm open to suggestions on how to do this better.

Answer 1

My recommendation is to use the Functor / Applicative representation of lenses directly for doing this sort of thing.

To write a non-type-changing (simple) Lens or a Traversal, you need to write a function that takes as arguments a function k :: a -> f a and your structure s and then produces a f s.

k is kind of a generalized modification function, which represents the change that an user of the lens wants to make to the data focused by the lens. But because k is not simply of type a -> a, but instead of type a -> f a, it also allows to carry a "result" out of the update, for example, the value of the field before it was updated (if you use the state monad for f, then you can set the state to the field's old value in the update function and read it out when you run the state monad afterwards).

Our approach in the following code is to change this modification function, to perform some clamping before returning the new value:

-- Takes a cursor update function and returns a modified update function 
-- that clamps the return value of the original function
clampCursorUpdate :: Functor f => Text -> (Cursor -> f Cursor) -> (Cursor -> f Cursor)
clampCursorUpdate k = \cur -> fmap (clampCursor txt) (k cur)

We can then turn a non-validating lens into a validating lens (note that as said in the comments, this validating lens is not a law-abiding lens):

-- assuming that _cursor is a lens that accesses
-- the _cursor field without doing any validation
_cursor :: Lens' Buffer Cursor

cursor :: Functor f => (Cursor -> f Cursor) -> Buffer -> f Buffer
cursor k buffer = _cursor (clampCursorUpdate txt k) buffer
 where txt = buffer^.text

This approach is easy to generalize to traversals. First, we write the non-validating traversal by composing a Lens' Buffer [Cursor] with traverse, which will turn that into a Traversal' Buffer Cursor:

-- assuming that _cursors is a lens that returns the list of cursors
_cursors :: Lens' Buffer [Cursor]

-- non-validating cursors traversal
_cursorsTraversal :: Traversal' Buffer Cursor
_cursorsTraversal = _cursors . traverse

Now we can use the same approach as we did earlier: since the traversal already does the "mapping" for us, the code is the same, except that we now have an Applicative f constraint on our f, because we want a Traversal':

cursors :: Applicative f => (Cursor -> f Cursor) -> Buffer -> f Buffer
cursors k buffer = _cursorsTraversal (clampCursorUpdate txt k) buffer
 whee txt = buffer^.text

Answer 2

As curs :: Lens' Buffer Cursor becomes curs :: Lens' Buffer [Cursor], your task of constructing a law-disregarding cursor :: Traversal' Buffer Cursor can be split into constructing a law-disregarding Lens' Buffer [Cursor] that does bounds checks, and turning any Lens' s [a] into a Traversal' s a.

The first could have been solved by you: You do what you've already been doing, but check bounds on each element of the [Cursor].

The second is a law-abiding request and thus you could have expected an answer without that torrent of comments under your post:

turnIntoTraversal :: Lens' s [a] -> Traversal' s a
turnIntoTraversal l = l . traverse

Also for my fun here's an attempt at a direct implementation.

cursor :: Traversal' Buffer Cursor
cursor atofa s = (curs . traverse) (fmap (clampCursor $ s ^. text) . atofa) s