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