Haskell 递归型透镜

我试图创建一些代码，这些代码可以接受任何递归语法数据类型和该数据类型的任何表达式，并生成一个相同类型的所有子表达式的列表，建立起来，有点像对该类型的递归进行

扫描

下面我为附带的玩具计算器语法类型
EExp
编写了两个手动示例。第一个示例使用透镜库中的棱镜和透镜，仅适用于一个
eg1
示例表达式，而第二个函数仅使用手动代码，但适用于任何
EExp
表达式

理想情况下，我可以使用template haskell或其他工具自动构建一个递归函数，该函数可以关注该类型中任何类型表达式（如棱柱/透镜）的每个子表达式，因此也可以轻松打印出给定表达式的所有片段的列表

不过，我有点困惑，不知下一步该做些什么。非常感谢您的帮助

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

您正在寻找模块

首先添加
数据
派生：

{-# 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) 

然后：

uniplate
镜头在这里发挥着巨大的魔力；通过使用提供的信息，它可以一步一步地进入任何
数据
友好的数据结构，找到自相似的孩子。它还可以使遍历有效，但我们可以放心地忽略这一点

uniplate的universieof
反复调用
uniplate
以查找所有可传递的子体

有关
Data.Data
的更多信息，请查看Lämmel和SPJ提供的信息。
Awesome！根据我的GHC，扩展名实际上被称为
DeriveDataTypeable
。我会纠正你写的。而且，我无法让你写的代码正常工作。你回答之前有没有试着编译它？我想我接受你的答案有点过早，因为我应该先自己尝试一下。现在才开始。我想知道你的意思是不是说宇宙？我需要进一步研究这个问题。是的，你的意思是
universiof
。我将再次调整代码。
> 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]