Haskell parsec：解析嵌套代码块

我想分析以下文本：

keyword some more values
        funcKeyw funcName1
        funcKeyw funcName2

        funcKeyw funcName3

        keyword some more values
                 funcKeyw funcName2

        keyword some more values
                 funcKeyw funcName4

缩进是由制表符完成的。每个块由

关键字

和同一行中的一些附加值开始。缩进的所有内容都属于同一块在所有函数调用（以

funcKeyw

关键字开头）之后，可以有子

关键字

块（用“空”行分隔；“空”表示其中没有任何内容或空白字符）

类型IndentLevel=Int
数据块=块{blockFuncCalls:：[String]
，blockBlocks:：[Block]
}
block:：GenParser Char st块
块=块0
哪里
parseBlock lvl=do
计数lvl选项卡
字符串“关键字”
--[…]分析该行中的其他内容。
新线
--解析“函数调用”。
fs>换行符>>返回（）
emptyLines:：GenParser Char st（）
emptyLines=many emptyLine>>返回（）

问题是

blockFunc

解析器在子块启动时不会停止解析，而是返回错误

意外的“关键字”

---

我怎样才能避免呢？我想我可以使用

try

或

choice

为每行选择正确的解析器，但我想要求函数调用在子块之前。

我注意到的一件事是

sebby

组合符有一些意想不到的行为，即如果开始解析分隔符，如果失败，整个

sebby

将失败，而不是返回到目前为止解析的内容。您可以使用以下变体，它们在

sepBy1Try

内部有一个额外的

try

：

sepBy1Try :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1Try p sep = do
  x <- p
  xs <- many (try $ sep *> p)
  return (x:xs)

sepByTry p sep = sepBy1Try p sep <|> return []

block :: GenParser Char st Block
block = parseBlock 0
    where
        parseBlock lvl = do
            count lvl tab
            string "keyword"

            otherStuff <- many (noneOf "\r\n") 
            newline

            -- Parse 'function calls'.
            fs <- sepBy1Try (blockFunc (lvl + 1)) emptyLines

            -- Parse optional child blocks.
            emptyLines
            bs <- sepByTry (try $ parseBlock (lvl + 1)) emptyLines

            return Block { blockFuncCalls=fs
                         , blockBlocks=bs
                         , blockValues=words otherStuff
                         }

我还修改了您的数据类型以捕获更多信息（仅用于演示目的）。另外，请注意递归

parseBlock

前面的另一个

try

——这是因为当它看到例如一个选项卡，但预期有两个选项卡时，该

try

允许它回溯到“下一级”

最后，更改以下内容：

emptyLines :: GenParser Char st ()
emptyLines = many (try emptyLine) >> return ()

和这里的塞比一样的理由

---

使用简单漂亮的打印机进行测试，以提高清晰度：

data Block = Block { blockValues :: [String]
                   , blockFuncCalls :: [String]
                   , blockBlocks    :: [Block]
                   } deriving (Show, Eq) 

pprBlock :: Block -> String 
pprBlock = unlines . go id where 
  go ii (Block vals funcs subblocks) = 
    let ii' = ii . ('\t':) in 
    (ii $ unwords $ "keyword":vals) : 
    map (\f -> ii' $ "function " ++ f) funcs ++ 
    concatMap (go ii') subblocks

test0_run = either (error.show) (putStrLn.pprBlock) $ parse block "" $ test0

test0 = unlines $ 
  [ "keyword some more values"
  , "\tfuncKeyw funcName1"
  , "\tfuncKeyw funcName2"
  , "\t"
  , "\tfuncKeyw funcName3"
  , "\t"
  , "\tkeyword some more values"
  , "\t\tfuncKeyw funcName2"
  , ""
  , "\tkeyword some more values"
  , "\t\tfuncKeyw funcName4"
  ]

及

---

回答得很好，非常感谢！我将

sepBy1Try

的实现替换为

liftM2（：）p（许多（try$sep*>p））

以使

do

消失。

data Block = Block { blockValues :: [String]
                   , blockFuncCalls :: [String]
                   , blockBlocks    :: [Block]
                   } deriving (Show, Eq) 

pprBlock :: Block -> String 
pprBlock = unlines . go id where 
  go ii (Block vals funcs subblocks) = 
    let ii' = ii . ('\t':) in 
    (ii $ unwords $ "keyword":vals) : 
    map (\f -> ii' $ "function " ++ f) funcs ++ 
    concatMap (go ii') subblocks

test0_run = either (error.show) (putStrLn.pprBlock) $ parse block "" $ test0

test0 = unlines $ 
  [ "keyword some more values"
  , "\tfuncKeyw funcName1"
  , "\tfuncKeyw funcName2"
  , "\t"
  , "\tfuncKeyw funcName3"
  , "\t"
  , "\tkeyword some more values"
  , "\t\tfuncKeyw funcName2"
  , ""
  , "\tkeyword some more values"
  , "\t\tfuncKeyw funcName4"
  ]

>test0_run
keyword some more values
        function funcName1
        function funcName2
        function funcName3
        keyword some more values
                function funcName2
        keyword some more values
                function funcName4

>putStrLn test0
keyword some more values
        funcKeyw funcName1
        funcKeyw funcName2

        funcKeyw funcName3

        keyword some more values
                funcKeyw funcName2

        keyword some more values
                funcKeyw funcName4

>