Haskell 如何使用lens包从AST中提取任意子树

为了分析和转换，我正在探索使用，但我不确定它是否适合此任务。我想是的，但它的表面积太大，密度太大，我说不出来

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

• 遍历它，查找

  FooterAnnotation

  节点
• 找到这样的节点后，将以下所有节点累积到一个列表中，直到

  DocBlock

  或任何其他

  注释

  节点结束
• 理想情况下，在本文的最后，我不仅将这些节点提取到一个列表中，而且还将它们从原始AST中删除，这样我就可以将剩下的内容传递到下一个阶段

目前我有一个能做部分工作的。下面是它的要点：

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

node:：node->Env
节点n=案例n
命令注释->停止
DOCBROCK d->do
（_，acc）停止
映射符号->停止
选项说明{}->停止
插入符号{}->停止
单元u->节点u
_->做
（capture，acc）Lens style uniplate让我们能够将处理整个数据结构的问题分解为多个部分，一次只能处理数据结构中的一个位置。我们将对AST中的每个节点应用单个节点上的操作

在节点上操作
在单个节点上的操作将提取任何页脚，我们将把这些页脚提取到一个节点，然后
返回
已删除页脚的修改节点。根据您的问题，我假设您只想从
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

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

一些无聊的语法分析
extractFooters
拉出从页脚开始到下一个注释或列表末尾的块。它通常是根据从列表中提取块来编写的。这是一个解析问题；奇怪的是，我们需要将其应用于已解析的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)

如果我们将
extractNodeFooters
应用于
example
它将不会起任何作用，因为
extractNodeFooters
只会更改
DocBlock
节点，
example
是一个根
单元

直系后裔
为具有
数据
实例的类型派生的通用遍历将操作应用于节点的每个直接后代。它不会递归地修改更深层的子体。如果我们将
uniplate extractNodeFooters
应用于
示例
，它应该从最外层的
DocBlock
中删除页脚，这是根
单元
的直接后代。它不会更改任何其他
DocBlock
s。它就是这样做的

打印。uniplate extractNodeFooters$示例
仅删除
DocBlock
中的
footer注释
，该注释是
单元的后代

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$示例
删除每个页脚并分别记录每个页脚

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"]
]

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

[
    [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$示例
删除每个页脚并完整记录。生成的AST与后序遍历相同；所有页脚都已从
DocBlock
s中删除

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

两个记录的页脚中的一个包含另一个页脚，该页脚未单独提取和记录

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"]
]

我不确定镜头在这里能帮你多少忙。您可以用稍微不同的方式编写此文件-
node
将返回更新的AST，并删除“收集的”节点，收集的节点通过例如writer effect存储。可能最简单的方法是不使用monad-
State
似乎使问题的逻辑相当复杂-似乎您只是使用State来从函数返回多个值。我（认为我）还需要
State
来打开和关闭捕获。感谢您提供了非常全面的答案。这里有很多东西需要消化，但看起来这样就可以了。