I've been trying to build a replacement for Lens.para that provides lensed contexts to the para function as it does its work. However, I seem to have made an error in the recursion somewhere.
According to my understanding of it, Lens.para is a paramorphism function over values in a recursive algebraic data type. That is, it uses plated and takes a function that explodes an options list to be used for traversing across the "self-similar syntax space" of a piece of data, all the while making its traversal data-context available to the function as it does its work. Its type is Lens.Plated a => (a -> [r] -> r) -> a -> r, where [r] is the list of data-context values, and a is the type of each value which plated knows how to "look into" successive levels of.
The extremely simple toy example data type I'm using to proof-of-concept this is as follows:
data EExp a
= ELit a
| EAdd (EExp a) (EExp a)
deriving (Show, Eq)
So, here is my code, including both the existing working version of showOptions and my new version of it, showOptions' which uses my custom Lens.para which is called paraApp. The difference is that this one passes a Pretext along with the data as it does its work so that later I can adjust my code to make use of this Pretext to adjust the original data structure if need be.
{-# LANGUAGE RankNTypes, TemplateHaskell, ExplicitForAll, DeriveDataTypeable, StandaloneDeriving #-}
module StepThree where
import qualified Control.Lens as Lens
import qualified Data.Data as DD
import qualified Data.Data.Lens as DDL
import qualified Data.Maybe as DM
import qualified Data.List as DL
import Text.Read (readMaybe)
import StepThreeGrammar (EExp(..), pretty, run)
import Control.Comonad.Store.Class (pos, peek, ComonadStore)
import Control.Lens.Internal.Context (Pretext(..), sell)
import qualified Language.Haskell.Interpreter as I
import Language.Haskell.Interpreter (Interpreter, GhcError(..), InterpreterError(..))
instance DD.Data a => Lens.Plated (EExp a)
deriving instance DD.Data a => DD.Data (EExp a)
eg3' :: EExp Int
eg3' = EAdd (EAdd (EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)) (ELit 5)) (ELit 0)
showOptions :: (Lens.Plated a, Show a) => (a -> String) -> a -> [String]
showOptions showFn = Lens.para $ \a xs ->
let
sa = showFn a
(_,is) = DL.mapAccumL mapAccumFn (0, sa) xs
in
sa : concat is
where
mapAccumFn (n, acc) x =
let
i = pfxIndex (head x) acc
in
( (n+i+length (head x)
, drop (i+length (head x)) acc)
, map (replicate (n+i) ' ' ++) x)
showOptions' :: (Lens.Plated a, Show a) => (a -> String) -> a -> [String]
showOptions' showFn = paraApp $ \(a, ctx) xs ->
let
sa = showFn a
(_, is) = DL.mapAccumL mapAccumFn (0, sa) xs
in
sa : concat is
where
mapAccumFn (n, acc) x =
let
i = pfxIndex (head x) acc
in
( (n+i+length (head x)
, drop (i+length (head x)) acc)
, map (replicate (n+i) ' ' ++) x)
paraApp :: Lens.Plated a => ((a, Pretext (->) a a a) -> [r] -> r) -> a -> r
paraApp f x = go id (x, makePretextFocussingOnSelfFor x)
where
go p a =
let p' = Lens.plate . p
holes = Lens.holesOf p' x
in f a (go p' <$> (map (\c -> (pos c, c)) holes))
makePretextFocussingOnSelfFor x = Pretext ($ x)
pfxIndex :: Eq a => [a] -> [a] -> Int
pfxIndex x y = maybe 0 id (DL.findIndex (x `DL.isPrefixOf`) (DL.tails y))
If I go into GHCi and execute the following code, it provides the intended output:
*Main EditorTest StepThree Control.Lens> mapM_ putStrLn $ StepThree.showOptions show eg3'
EAdd (EAdd (EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)) (ELit 5)) (ELit 0)
EAdd (EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)) (ELit 5)
EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)
EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 1
ELit 5
ELit 0
Which is fine for the case when I don't want to do anything with a context (say updating a particular piece of the original value)
So when I attempt the replacement function, the following happens (it should be identical to the above):
*Main EditorTest StepThree Control.Lens> mapM_ putStrLn $ StepThree.showOptions' show eg3'
EAdd (EAdd (EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)) (ELit 5)) (ELit 0)
EAdd (EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)) (ELit 5)
EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)
EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
ELit 1
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
ELit 5
EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
ELit 1
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
ELit 0
EAdd (EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)) (ELit 1)
EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
ELit 1
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
ELit 5
EAdd (EAdd (ELit 11) (ELit 9)) (ELit 3)
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
ELit 1
EAdd (ELit 11) (ELit 9)
ELit 11
ELit 9
ELit 3
ELit 11
ELit 9
Obviously I have my recursion wrong somewhere, but I can't work it out. As always, any help would be greatly appreciated.
If you're not familiar with the original definition of Lens.para, it can be found at https://hackage.haskell.org/package/lens-4.15.2/docs/src/Control.Lens.Plated.html#para
This has taken me on a very interesting journey which I'm still on. I'm pretty sure the answer lies in creating a new function that merges the functionality of Lens.paraOf plate with that of Lens.contexts. At least I know the problem now and much more about Context and recursion schemes. I'd suggest anyone who is interested in writing this function should look into the source of those.
So, to answer the question, the error in the recursion lies in the fact that I'm using fmap (<$>) to map every single upper lens over every single child in the lower part of structure. That means that each subtree, rather than only getting the recursion into its particular part of the tree, is getting the full recursion into every part of the tree.
A correct implementation would take this into consideration.