Recursive Lensing Type
I am trying to create code that can accept any recursive grammar datatype and any expression of that datatype, and create a list of all subexpressions of the same type, like a scan
over type recursion.
I wrote the two below examples for the accompanying toy calculator grammar type EExp
. The first example uses prisms and lenses from the Lens library and will work with only one expression eg1
, while the second function just uses the processed code, but will work with any expression EExp
.
Ideally, I could use the haskell pattern or something to automatically build a recursive function that could focus on each of the expressions of any type of expression in that type (e.g. prism / lens) and therefore print out a list of all parts easily too any expression given to him.
I'm a bit stuck though, with what to try and research further with. 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
source to share
You are looking for the Control.Lens.Plated module .
First add the output Data
:
{-# language DeriveDataTypeable #-}
import Data.Data
import Data.Data.Lens
import Control.Lens -- for universeOf function
data EExp a
= ELit a
| EAdd (EExp a) (EExp a)
deriving (Show, Data)
Then:
> buildOptions eg1
[EAdd (ELit 1) (EAdd (ELit 2) (ELit 0)),ELit 1,EAdd (ELit 2) (ELit 0),ELit 2,ELit 0]
> universeOf uniplate eg1
[EAdd (ELit 1) (EAdd (ELit 2) (ELit 0)),ELit 1,EAdd (ELit 2) (ELit 0),ELit 2,ELit 0]
The object uniplate
performs the bulk of the magic; using the information provided by the Data
typeclass , it can go one step into any kind- Data
friendly data structure to find itself-different children. It also does some high-level caching gymnastics to make the traversals effective, but we can safely ignore that.
universeOf uniplate
calls again uniplate
to find all transitive children.
For more information on Data.Data
, view Cancel Paper Boilerplate from Lämmel and SPJ.
source to share