Index a Traversal with a Lens

Question

I have a lens pointing to a json document, e.g.

doc ^? ((key "body").values)

Now I would like to index the values in body with the key "key", because the json looks like

{"body": [{"key": 23, "data": [{"foo": 1}, {"foo": 2}]}]}

So I'm looking for something which would allow me to index by another lens:

doc ^? key "body" . values
      . indexWith (key "key")
      . key "data" . values
      . key "foo" . withIndex

which should return

[(23, 1), (23, 2)]

MVCE:

#!/usr/bin/env stack
-- stack --resolver lts-11.7 script
-- --package lens
-- --package text
-- --package lens-aeson
{-# LANGUAGE OverloadedStrings #-}
import Control.Lens
import Data.Aeson.Lens
import Data.Text

doc :: Text
doc = "{\"body\": [{\"key\": 23, \"data\": [{\"foo\": 1}, {\"foo\": 2}]}]}"

-- Something akin to Lens -> Traversal -> IndexedTraversal
indexWith :: _
indexWith = undefined

-- should produce [(23, 1), (23, 2)]
indexedBody :: [(Int, Int)]
indexedBody = doc ^? key "body" . values
                   . indexWith (key "key")
                   . key "data" . values
                   . key "foo" . withIndex

main = print indexedBody

Answer 1

New, sickeningly complete answer

I've finally returned to a real computer with GHC, and did some more thorough testing. I found two things: 1) My basic idea works. 2) There is a lot of subtlety in using it the way you want.

Here are some expanded definitions to start the experiment:

{-# Language OverloadedStrings, FlexibleContexts #-}

import Control.Lens
import Data.Aeson
import Data.Aeson.Lens
import Data.Text
import Data.Monoid (First)
import Data.Maybe (isJust, fromJust)

doc :: Text
doc = "{\"body\": [ {\"key\": 23, \"data\": [{\"foo\": 1}, {\"foo\": 2}]}, {\"key\": 29, \"data\": [{\"foo\": 11}, {\"bar\": 12}]} ]}"

doc2 :: Text
doc2 = "{\"body\": [ {\"data\": [{\"foo\": 21}, {\"foo\": 22}]}, {\"key\": 23, \"data\": [{\"foo\": 1}, {\"foo\": 2}]}, {\"key\": 29, \"data\": [{\"foo\": 11}, {\"bar\": 12}]} ]}"

subIndex :: Indexable i p => Getting i s i -> p s fb -> s -> fb
subIndex f = reindexed (view f) selfIndex

subIndex2 :: Indexable (Maybe a) p => Getting (First a) s a -> p s fb -> s -> fb
subIndex2 f = reindexed (preview f) selfIndex

subIndex3 :: (Applicative f, Indexable i p) => Getting (First i) s i -> p s (f s) -> s -> f s
subIndex3 f = reindexed fromJust (subIndex2 f . indices isJust)

I've defined 3 different variants of a function to do what you want. The first one, subIndex, is most precisely what you asked for in the question title. It needs a lens, not a traversal. This prevents it from being usable exactly the way you'd want.

> doc ^@.. key "body" . values . subIndex (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer

<interactive>:61:42: error:
    • No instance for (Monoid Integer) arising from a use of ‘key’
    • In the first argument of ‘(.)’, namely ‘key "key"’
      In the first argument of ‘subIndex’, namely
        ‘(key "key" . _Integer)’
      In the first argument of ‘(<.)’, namely
        ‘subIndex (key "key" . _Integer)’

The problem here is that the key might not actually be there. The type system carries enough information to detect this problem, and refuse to compile. You can work around it with a minor modification:

> doc ^@.. key "body" . values . subIndex (singular $ key "key" . _Integer) <. key "data" . values . key "foo" . _Integer
[(23,1),(23,2),(29,11)]

But singular is a promise to the compiler. If you were wrong, things go wrong:

> doc2 ^@.. key "body" . values . subIndex (singular $ key "key" . _Integer) <. key "data" . values . key "foo" . _Integer
[(*** Exception: singular: empty traversal
CallStack (from HasCallStack):
  error, called at src/Control/Lens/Traversal.hs:667:46 in lens-4.16-f58XaBDme4ClErcSwBN5e:Control.Lens.Traversal
  singular, called at <interactive>:63:43 in interactive:Ghci4

So, my next thought was using preview instead of view, which resulted in subIndex2.

> doc ^@.. key "body" . values . subIndex2 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer
[(Just 23,1),(Just 23,2),(Just 29,11)]

It's a bit ugly to have those Just constructors in there, but it has its advantages:

> doc2 ^@.. key "body" . values . subIndex2 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer
[(Nothing,21),(Nothing,22),(Just 23,1),(Just 23,2),(Just 29,11)]

With this, the traversal still hits all its regular targets, even if the index is missing. This is potentially an interesting point in the solution space. There are certainly use cases for which it would be the best choice. Despite that, I figured it wasn't exactly what you wanted. I figured you probably really wanted Traversal-ish behavior - if there is no target for the index traversal, just skip all children. Unfortunately, lens is a bit austere doing this sort of manipulation of indices. I eventually ended up with subIndex3, which uses an index-level variant of the map fromJust . filter isJust pattern. It's perfectly safe as is, but it's somewhat fragile in the face of refactoring.

It works, though:

> doc ^@.. key "body" . values . subIndex3 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer
[(23,1),(23,2),(29,11)]

And, it works as you'd probably expect when the index traversal doesn't find any targets:

> doc2 ^@.. key "body" . values . subIndex3 (key "key" . _Integer) <. key "data" . values . key "foo" . _Integer
[(23,1),(23,2),(29,11)]

The dictionary that lacks a "key" field is just ignored, even though the remainder of the traversal would have targets in it.

So there you go - three related options, each of which has positives and negatives. The third one is pretty rough in terms of implementation, and I suspect it's not going to have the best performance either. But I estimate it is most likely to be what you actually desire.

Old, incomplete answer

This isn't a complete answer, as I don't have a computer with ghc around - I've been testing by chatting with lambdabot on freenode.

09:34 <me> > let setIndex f = reindexed (view f) selfIndex in Just (1, [3..6]) ^@.. _Just . setIndex _1 <. _2 . traverse
09:34 <lambdabot>  [(1,3),(1,4),(1,5),(1,6)]

I think that is the basic idea you were looking for, but I haven't applied it to exactly your data. I applied it to a value that was structurally similar to prove the pattern, at least. The basic idea is to use a combination of selfIndex and reindexed to create an indexed optic with the correct index value. Then you have to be careful with (<.) and similar operators to maintain the correct index across compositions of various indexed optics.

Finally, I switched to using (^@..) to extract a list of (index, target) pairs instead of using withIndex. The latter will work, but then you need to be even more careful with how you associate the various compositions together.

Example using withIndex, note that it required overriding the default association of the composition operators in order to work:

12:21 <me> > let setIndex f = reindexed (view f) selfIndex in Just (1, [3..6]) ^.. (_Just . setIndex _1 <. _2 . traverse) . withIndex
12:21 <lambdabot>  [(1,3),(1,4),(1,5),(1,6)]

Answer 2

Would a mere Fold—not a full Traversal—be enough?

Control.Lens.Reified provides a ReifiedFold newtype with useful instances. In particular, the Applicative instance performs a cartesian product of folds.

We could use that cartesian product to obtain the "key" on one side, and the "data" on the other. Like this:

indexedBody :: Fold Value (Int,Int)
indexedBody =
    let k :: Fold Value Int
        k = key "key"._Integral
        d :: Fold Value Int
        d = key "data".values.key "foo"._Integral
        Fold kd = (,) <$> Fold k <*> Fold d
     in key "body" . values . kd

There's no combinatorial explosion because the "key" part targets at most one value.