Is there a way to compose reified lenses?

Question

I was trying to use the lens library to solve the following problem:

Given the list version of a tree, make a tree. Example:

Given:
  [1,2,3,4,5,6,7]

I should make a tree:
     1
   2   3
  4 5 6 7

My solution was to create nodes according to depth using the state monad and lenses.

My tree data type:

data Tree a = Nil | Node a (Tree a) (Tree a) deriving (Show)

A stringy version of what I was going for, for calculating the lenses:

calculateSetters 1 = ["_Node . _2", "_Node . _3"]
calculateSetters n = (++) <$> calculateSetters (n-1) <*> [ "_Node . _2", "_Node . _3" ]

-- where "_Node" is a prism and "_2" and "_3" are lenses

The non-stringy version would output all the lenses to the empty children at a given depth which I could just set using .~. The gist of the non-stringy version looked something like:

calculateSetters n = Setter <$> combinations where
  combinations = (.) <$> calculateSetters (n-1) <*> [ _Node . _2, _Node . _3 ]

Two problems I ran into

1. I apparently can't map reifier constructors ( fmap Setter [ _1, _1] is an error but [Setter _1, Setter _1] is not). I read it was probably because the lenses are polymorphic and end up binding to something conrete unless I reify them immediately.
2. I can't make a reified lens [Setter _1] and then somehow combine it with another reified lens [Setter _2] to get [Setter $ _1 . _2]. It seems like you can for one-offs in ghci: :t Setter $ runSetter (Setter _2) . runSetter (Setter _2) seems to typecheck but I can't work with lists.

I ended up just hardcoding a couple like so:

calculateSetters :: Int -> [ReifiedSetter (Tree Int) (Tree Int) (Tree Int) (Tree Int)]
calculateSetters 1 =
  [ Setter $ _Node . _2,
    Setter $ _Node . _3
  ]
calculateSetters 2 =
  [ Setter $ _Node . _2 . _Node . _2,
    Setter $ _Node . _2 . _Node . _3,
    Setter $ _Node . _3 . _Node . _2,
    Setter $ _Node . _3 . _Node . _3
  ]
calculateSetters 3 =
  [ Setter $ _Node . _2 . _Node . _2 . _Node . _2,
    Setter $ _Node . _2 . _Node . _2 . _Node . _3,
    Setter $ _Node . _2 . _Node . _3 . _Node . _2,
    Setter $ _Node . _2 . _Node . _3 . _Node . _3,
    Setter $ _Node . _3 . _Node . _2 . _Node . _2,
    Setter $ _Node . _3 . _Node . _2 . _Node . _3,
    Setter $ _Node . _3 . _Node . _3 . _Node . _2,
    Setter $ _Node . _3 . _Node . _3 . _Node . _3
  ]
calculateSetters 4 =
  [ Setter $ _Node . _2 . _Node . _2 . _Node . _2 . _Node . _2,
    Setter $ _Node . _2 . _Node . _2 . _Node . _2 . _Node . _3,
    Setter $ _Node . _2 . _Node . _2 . _Node . _3 . _Node . _2,
    Setter $ _Node . _2 . _Node . _2 . _Node . _3 . _Node . _3,
    Setter $ _Node . _2 . _Node . _3 . _Node . _2 . _Node . _2,
    Setter $ _Node . _2 . _Node . _3 . _Node . _2 . _Node . _3,
    Setter $ _Node . _2 . _Node . _3 . _Node . _3 . _Node . _2,
    Setter $ _Node . _2 . _Node . _3 . _Node . _3 . _Node . _3,
    Setter $ _Node . _3 . _Node . _2 . _Node . _2 . _Node . _2,
    Setter $ _Node . _3 . _Node . _2 . _Node . _2 . _Node . _3,
    Setter $ _Node . _3 . _Node . _2 . _Node . _3 . _Node . _2,
    Setter $ _Node . _3 . _Node . _2 . _Node . _3 . _Node . _3,
    Setter $ _Node . _3 . _Node . _3 . _Node . _2 . _Node . _2,
    Setter $ _Node . _3 . _Node . _3 . _Node . _2 . _Node . _3,
    Setter $ _Node . _3 . _Node . _3 . _Node . _3 . _Node . _2,
    Setter $ _Node . _3 . _Node . _3 . _Node . _3 . _Node . _3
  ]
calculateSetters _ = error "unsupported; too lazy"

which works but I was wondering if and how I can do this programatically?

Answer 1

You can certainly compose reified setters, though I'm not aware of a standard function that does this. But it can be done in the obvious way:

composeSetters :: ReifiedSetter' a b -> ReifiedSetter' b c -> ReifiedSetter' a c
composeSetters (Setter f) (Setter g) = Setter (f . g)

Then, everything else can be done using only reified setters and therefore no impredicative problems:

calculateSetters :: Int -> [ReifiedSetter' (Tree Int) (Tree Int)]
calculateSetters 1 =
  [ Setter (_Node . _2)
  , Setter (_Node . _3)
  ]
calculateSetters n
     = composeSetters <$> calculateSetters (n-1) <*> calculateSetters 1

Compilable version:

{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}

import Control.Lens

data Tree a = Nil
            | Node { _nodeValue :: a
                   , _lSubtree :: Tree a
                   , _rSubtree :: Tree a
                   }
  deriving (Show)

makeLenses ''Tree

composeSetters :: ReifiedSetter' a b -> ReifiedSetter' b c
                        -> ReifiedSetter' a c
composeSetters (Setter f) (Setter g) = Setter (f . g)

subtreeSetters :: [[ReifiedSetter' (Tree Int) (Tree Int)]]
subtreeSetters
   = [Setter id]
   : [ composeSetters <$> strs <*> [Setter lSubtree, Setter rSubtree]
     | strs <- subtreeSetters ]