haskell - 如何使用 Lens 包从 AST 中提取任意子树

Question

我正在探索 the lens package 的使用用于分析和转换this AST ，但我不确定它是否适合这项任务。我认为有可能，但它的表面积太大且致密，我无法判断。

我想做的代表性操作如下。给定一个 AST，我想从树中提取“页脚”部分:

• 遍历它寻找 FooterAnnotation 节点。
• 一旦找到这样的节点，请将以下所有节点累积到一个列表中，直到 DocBlock 或任何其他 Annotation 节点的末尾。
• 理想情况下，在最后，我不仅将这些节点提取到列表中，而且还将它们从原始 AST 中删除，这样我就可以将剩下的任何内容传递到下一阶段。

目前我有 this code它完成了部分工作。这是它的核心内容:

node :: Node -> Env
node n = case n of
  CommandAnnotation _  -> stop
  DocBlock d           -> do
    (_, acc)           <- get
    ns                 <- nodes d
    put (False, acc)   -- Make sure we reset state on exiting docblock.
    return $ acc ++ ns
  FooterAnnotation     -> start
  MappingAnnotation _  -> stop
  MappingsAnnotation   -> stop
  OptionAnnotation {}  -> stop
  PluginAnnotation {}  -> stop
  Unit u               -> nodes u
  _                    -> do
    (capture, acc)     <- get
    return $ if capture
             then acc ++ [n]
             else acc

它所做的是遍历 AST，并使用 State monad 来指示我是否正在捕获“页脚”节点。我使用这些 start 和 stop 函数打开和关闭捕获，这些函数仅更新状态。捕获时，我将每个节点累积到列表中。

所以，这是可行的，但我没有以任何方式修改原始 AST，这就是我认为镜头包可以派上用场的地方，因为它提供了 a bunch of operators ，其中一些是明确设计用于与 State monad 配合使用的。然而，由于我的能力有限，我发现文档有点难以访问，并且不知道从哪里开始。

此外，我还没有找到任何使用镜头库从结构中删除元素的示例。一次遍历，例如should “留下与开始时的后续遍历相同数量的候选元素”，所以我想知道是否需要用一个新的 AST Empty 节点替换“修剪”节点，该节点仅填充他们所在的位置有差距。这是正确的吗？

Answer 1

Lens 风格的 uniplate 使我们能够将处理整个数据结构的问题分解为每次仅处理数据结构中的一个位置的问题。我们会将单个节点上的操作应用于 AST 中的每个节点。

在节点上操作

单个节点上的操作将提取所有页脚，我们将 tell到 Writer ，并返回修改后的节点并删除页脚。从您的问题来看，我假设您只想从 DocBlock 中删除页脚；您可以以同样的方式从其他节点删除它们。其他节点将原封不动地返回。

import qualified Data.DList as DList
import Control.Monad.Trans.Writer

extractNodeFooters :: Node -> Writer (DList.DList [Node]) Node
extractNodeFooters (DocBlock nodes) = do
    let (footers, remainder) = extractFooters nodes
    tell (DList.fromList footers)
    return (DocBlock remainder)
extractNodeFooters node = return node

差异列表DList避免累积提取的页脚的二次性能。

一些无聊的解析

extractFooters 提取从页脚开始到下一个注释或列表末尾结束的 block 。一般而言，它是根据从列表中提取 block 来编写的。这是一个解析问题；奇怪的是我们需要将它应用到已经解析的 AST 上。

import Control.Applicative

isAnnotation :: Node -> Bool
isAnnotation x = case x of
    PluginAnnotation _ _   -> True
    FunctionAnnotation _   -> True
    IndentAnnotation       -> True
    DedentAnnotation       -> True
    CommandAnnotation _    -> True
    FooterAnnotation       -> True
    MappingsAnnotation     -> True
    MappingAnnotation _    -> True
    OptionAnnotation _ _ _ -> True
    HeadingAnnotation _    -> True
    SubheadingAnnotation _ -> True
    otherwise              -> False


extractBlocks :: Alternative f => (a -> Maybe (a -> Bool)) -> [a] -> (f [a], [a])
extractBlocks start = go
    where
        go     [] = (empty, [])
        go (x:xs) = maybe no_extract extract (start x)
            where
                no_extract = (extracted, x:unextracted)
                    where
                        ~(extracted, unextracted) = go xs
                extract stop = (pure (x:block) <|> extracted, unextracted)
                    where
                        ~(block, remainder) = break stop xs
                        ~(extracted, unextracted) = go remainder

extractFooters :: Alternative f => [Node] -> (f [Node], [Node])
extractFooters = extractBlocks (\x -> if (x==FooterAnnotation) then Just isAnnotation else Nothing)

在每个节点上操作

我们将在以下 AST 的每个节点上进行操作

example = Unit [
    Code "Unit Code",
    DocBlock [
        Code "DocBlock Code",
        DocBlock [
            Code "DocBlock DocBlock Code",
            FooterAnnotation,
            Code "DocBlock DocBlock FooterAnnotation Code"
        ],
        FooterAnnotation,
        Code "DocBlock FooterAnnotation Code",
        DocBlock [
            Code "DocBlock FooterAnnotation DocBlock Code",
            FooterAnnotation,
            Code "DocBlock FooterAnnotation DocBlock FooterAnnotation Code"
        ]
    ],
    FooterAnnotation,
    Code "Unit FooterAnnotation Code"]

如果我们将 extractNodeFooters 应用于 example ，它将不会执行任何操作，因为 extractNodeFooters 仅更改 DocBlock 节点和 example 是根 Unit。

直系后代

通用uniplate为具有 Data 实例的类型派生的遍历将操作应用于节点的每个直接后代。它不会递归地修改更深的后代。如果我们将 uniplate extractNodeFooters 应用于 example，它应该从最外面的 DocBlock 中删除页脚，它是根 的直接后代单位。它不会更改任何其他 DocBlock。这正是它的作用。

打印。 uniplate extractNodeFooters $ example 仅删除 DocBlock 中作为 Unit

后代的 FooterAnnotation

Unit [
    Code "Unit Code",
    DocBlock [
        Code "DocBlock Code",
        DocBlock [
            Code "DocBlock DocBlock Code",
            FooterAnnotation,
            Code "DocBlock DocBlock Footer Annotation Code"
        ]
    ],
    FooterAnnotation,
    Code "Unit FooterAnnotation Code"
]

它记录它删除的一个注释

[

    [
        FooterAnnotation,
        Code "DocBlock FooterAnnotation Code",
        DocBlock [
            Code "DocBlock FooterAnnotation DocBlock Code",
            FooterAnnotation,
            Code "DocBlock FooterAnnotation DocBlock FooterAnnotation Code"
        ]
    ]
]

更深

要删除各处的注释，我们必须在每个后代节点上递归应用 uniplate。我们有两个通用选择。我们可以在将操作应用于所有后代之前将其应用于一个节点，也可以在之后进行。这些称为前序或后序遍历。在转换数据时，我们通常需要后序遍历，因为每当我们处理它们时，所有后代都已经被转换。

import Control.Monad

postorder :: Monad m => ((a -> m c) -> (a -> m b)) -> (b -> m c) -> (a -> m c)
postorder t f = go
    where 
        go = t go >=> f

preorder :: Monad m => ((a -> m c) -> (b -> m c)) -> (a -> m b) -> (a -> m c)
preorder t f = go
    where 
        go = f >=> t go

后序

postorder 遍历将从内部节点提取所有页脚，然后再从外部节点提取页脚。这意味着不仅会提取每个页脚，而且还会从页脚中提取另一个页脚内的每个页脚。 打印。 postorder uniplate extractNodeFooters $ example 删除每个页脚并单独记录每个页脚。

Unit [
    Code "Unit Code",
    DocBlock [
        Code "DocBlock Code",
        DocBlock [
            Code "DocBlock DocBlock Code"
        ]
    ],
    FooterAnnotation,
    Code "Unit FooterAnnotation Code"
]

三个记录的页脚都不包含页脚。

[
    [FooterAnnotation,Code "DocBlock DocBlock FooterAnnotation Code"],
    [FooterAnnotation,Code "DocBlock FooterAnnotation DocBlock FooterAnnotation Code"],
    [
        FooterAnnotation,
        Code "DocBlock FooterAnnotation Code",
        DocBlock [
            Code "DocBlock FooterAnnotation DocBlock Code"
        ]
    ]
]

预购

preorder 遍历将从外部节点提取所有页脚，然后再从内部节点提取页脚。这意味着每个页脚都将被完整提取。 打印。 preorder uniplate extractNodeFooters $ example 删除每个页脚并将其完整记录。生成的 AST 与后序遍历相同；所有页脚均已从 DocBlock 中删除。

Unit [
    Code "Unit Code",
    DocBlock [
        Code "DocBlock Code",
        DocBlock [
            Code "DocBlock DocBlock Code"
        ]
    ],
    FooterAnnotation,
    Code "Unit FooterAnnotation Code"
]

两个记录的页脚之一包含另一个未单独提取和记录的页脚。

[
    [
        FooterAnnotation,
        Code "DocBlock FooterAnnotation Code",
        DocBlock [
            Code "DocBlock FooterAnnotation DocBlock Code",
            FooterAnnotation,
            Code "DocBlock FooterAnnotation DocBlock FooterAnnotation Code"
        ]
    ],
    [FooterAnnotation, Code "DocBlock DocBlock FooterAnnotation Code"]
]