Haskell Megaparsec如何显示错误对应的解析器回溯信息？

Megaparsec默认的错误报告不会自动展示通过<?>添加的解析器标签回溯层级，但可以通过自定义错误格式化函数实现需求——利用ParseError结构中保存的errorStack字段（解析器标签栈），将其整合到错误输出里。

实现步骤 #

1. 理解错误结构：当用<?>给解析器添加标签时，Megaparsec会把这些标签存入ParseError的errorStack字段，默认的parseErrorPretty函数不会输出这个栈，需要手动提取并格式化。

2. 自定义错误格式化函数：编写函数提取错误栈并生成带回溯的错误信息：

import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Void (Void)

type Parser = Parsec Void String

-- 格式化带回溯栈的错误信息
formatWithStack :: ParseErrorBundle String Void -> String
formatWithStack bundle =
  let -- 获取错误位置信息
      posInfo = errorBundlePos bundle
      -- 获取最精确的错误记录
      coreErr = head $ bundleErrors bundle
      -- 生成回溯栈文本：从外层到内层缩进区分层级
      stackContent = case errorStack coreErr of
        [] -> ""
        stack -> unlines $ zipWith (\depth label -> replicate (depth*2) ' ' ++ "error while parsing " ++ label ++ ":") [0..] (reverse stack)
      -- 格式化原始错误提示并缩进
      rawMsg = parseErrorTextPretty coreErr
      indentedMsg = unlines $ map ("  " ++) (lines rawMsg)
  in posInfo ++ "\n" ++ stackContent ++ indentedMsg

3. 自定义测试函数：替换默认的parseTest，用自定义函数输出错误：

-- 自定义解析测试工具
testParser :: Parser a -> String -> IO ()
testParser p input =
  case parse p "" input of
    Left err -> putStrLn $ formatWithStack err
    Right res -> print res

示例测试 #

定义带嵌套标签的解析器：

-- 内层解析器
letterParser :: Parser Char
letterParser = letterChar <?> "single letter"

-- 中层解析器
fooParser :: Parser String
fooParser = do
  d <- digitChar <?> "count digit"
  c <- letterParser
  return $ replicate (read [d]) c
  <?> "foo pattern" -- 给整个foo解析器打标签

-- 外层解析器
parentParser :: Parser String
parentParser = fooParser <?> "parent block"

测试错误输入"33a"：

testParser parentParser "33a"

输出结果：

1:2:
  |
1 | 33a
  |  ^
error while parsing parent block:
  error while parsing foo pattern:
    error while parsing single letter:
      unexpected '3'
      expecting single letter

说明 #

• 错误栈从最外层解析器到最内层失败节点，通过缩进区分层级，清晰展示回溯路径。
• 该方案适用于Megaparsec 8.x及以上版本（errorStack字段在这些版本中稳定存在）。

内容的提问来源于stack exchange，提问作者IssaRice