I'm trying to create some code that can take any recursive grammar data type and any expression of that data type and produce a list of all sub-expressions of the same type, built up, kind of like a scan
on the recursion of the type.
I've written two manual examples below for an accompanying toy calculator grammar type EExp
. The first example uses prisms and lenses from the Lens library and will only work on the one eg1
example expression, whereas the second function just uses handrolled code but will work on any EExp
expression.
Ideally I could use template haskell or something else to automatically build a recursive function that could focus on each of the sub expressions of an expression of any kind in that type (like a prism/lens), and therefore also easily print out a list of all the pieces of any expression given to it.
I'm a little bit stuck, though, with what to try or research next. Any help is really appreciated!
import qualified Control.Lens as Lens
import qualified Control.Lens.TH as LTH
-- Syntax for toy language
data EExp a
= ELit a
| EAdd (EExp a) (EExp a)
| EMul (EExp a) (EExp a)
| ESub (EExp a) (EExp a)
deriving Show
-- build out a set of focus functions using lens / TH
LTH.makePrisms ''EExp
-- An example "text" in the Syntax
eg1 :: EExp Int
eg1 = EAdd
(ELit 1)
(EAdd (ELit 2) (ELit 0))
-- using lenses, we build out all the
-- EExp possibilities from the example "text":
lensedOptions :: Show a => EExp a -> [EExp a]
lensedOptions exp =
let
maybeGet l = Lens.preview l exp
listMaybes =
[ Just exp
, maybeGet (_EAdd.(Lens._1))
, maybeGet (_EAdd.(Lens._2))
, maybeGet (_EAdd.(Lens._2)._EAdd.(Lens._1))
, maybeGet (_EAdd.(Lens._2)._EAdd.(Lens._2))
]
in
maybe [] id $ sequenceA listMaybes
printEm :: IO ()
printEm = sequence_ $ map print $ lensedOptions eg1
-- using handwritten code, we build out all the
-- EExp possibilities from the example "text":
buildOptions :: Show a => EExp a -> [EExp a]
buildOptions exp =
let
buildBinOpts e1 e2 = [exp] ++ buildOptions e1 ++ buildOptions e2
in
case exp of
ELit i -> [exp]
EAdd e1 e2 ->
buildBinOpts e1 e2
EMul e1 e2 ->
buildBinOpts e1 e2
ESub e1 e2 ->
buildBinOpts e1 e2
printEm2 :: IO ()
printEm2 = sequence_ $ map print $ buildOptions eg1
You are seeking the Control.Lens.Plated module.
First add a
Data
derivation:Then:
The
uniplate
lens is doing the bulk of the magic here; using the information provided by theData
typeclass, it is able to walk one step into anyData
-friendly data structure to find self-similar children. It is also doing some high-altitude caching gymnastics to make the traversals efficient, but we can safely ignore that.universeOf uniplate
repeatedly callsuniplate
to find all transitive descendants.For more information on
Data.Data
, check out the Scrap Your Boilerplate paper by Lämmel and SPJ.