如何使用Haskell按出现顺序检索文本文件内标记函数并完成编辑

现有代码的核心问题 #

• Haskell是纯函数式编程语言，没有可变变量和命令式for循环结构，你写的类Python嵌套循环+全局计数变量的逻辑无法直接在Haskell中运行
• 预统计标记数量的思路不可行：table和figure的编号依赖其前方最近的section编号，必须按文本顺序逐段遍历处理标记，不能分开统计后批量替换
• 类型不匹配：hGetContents返回的是String类型，而你调用的Data.Text的count函数仅能处理Text类型，二者混用会直接报错
• 缺失参数提取逻辑：当前代码仅做了关键词匹配，没有实现从标记中提取{title}、{id}参数的步骤

实现思路 #

采用带状态的遍历方案实现需求，维护三个可变状态：

• 当前section编号
• 当前section下的table编号
• 当前section下的figure编号
  遍历文本时每匹配到一个标记就更新对应状态，同时生成替换后的文本内容。

可运行参考实现 #

首先在项目cabal配置中添加text、parsec、mtl依赖，代码如下：

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.Environment (getArgs)
import Text.Parsec
import Text.Parsec.Text

-- 定义编号状态结构
data NumState = NumState
  { secNo :: Int
  , tabNo :: Int
  , figNo :: Int
  } deriving (Show)

-- 初始状态：所有编号从0开始计数
initState :: NumState
initState = NumState 0 0 0

-- 标记类型定义
data Markup = Section T.Text T.Text
            | Table T.Text T.Text
            | Figure T.Text T.Text
            | PlainText T.Text
            deriving (Show)

-- 标记解析器
parseMarkup :: Parser [Markup]
parseMarkup = many $ choice
  [ try parseSection
  , try parseTable
  , try parseFigure
  , parsePlain
  ]
  where
    braced :: Parser T.Text
    braced = between (char '{') (char '}') (T.pack <$> many (noneOf "}"))
    parseSection = do
      string "\\Section"
      title <- braced
      id <- braced
      return $ Section title id
    parseTable = do
      string "\\table"
      title <- braced
      id <- braced
      return $ Table title id
    parseFigure = do
      string "\\figure"
      title <- braced
      id <- braced
      return $ Figure title id
    parsePlain = PlainText . T.singleton <$> anyChar

-- 处理单个标记、更新状态、生成输出文本
processMarkup :: (NumState, T.Text) -> Markup -> (NumState, T.Text)
processMarkup (st, acc) markup = case markup of
  Section title _ ->
    let newSec = secNo st + 1
        -- 新section出现时重置table和figure计数
        newSt = st { secNo = newSec, tabNo = 0, figNo = 0 }
        out = T.append acc $ "Section " <> T.pack (show newSec) <> ": " <> title
    in (newSt, out)
  Table title _ ->
    let newTab = tabNo st + 1
        newSt = st { tabNo = newTab }
        sec = secNo st
        out = T.append acc $ "Table " <> T.pack (show sec) <> "." <> T.pack (show newTab) <> ": " <> title
    in (newSt, out)
  Figure title _ ->
    let newFig = figNo st + 1
        newSt = st { figNo = newFig }
        sec = secNo st
        out = T.append acc $ "Figure " <> T.pack (show sec) <> "." <> T.pack (show newFig) <> ": " <> title
    in (newSt, out)
  PlainText t -> (st, T.append acc t)

main :: IO ()
main = do
  args <- getArgs
  if null args
    then putStrLn "请传入要处理的文件路径作为运行参数"
    else do
      content <- TIO.readFile (head args)
      case parse parseMarkup "" content of
        Left err -> print err
        Right markups -> do
          let (_, result) = foldl processMarkup (initState, "") markups
          TIO.writeFile (head args ++ ".out") result
          putStrLn "处理完成，输出文件为原文件名加.out后缀"

扩展说明 #

ref标记的处理逻辑与上述逻辑一致，你只需新增对应的ref解析分支，再新增一个独立的ref编号状态字段即可。如果不需要保留原文本的非标记内容，可自行调整parsePlain的输出逻辑。

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