Haskell Html 使用 Parsec 的解析器

Question

我目前正在 haskell 中编写 html 解析器。我正在使用 parsec 库。此时解析器只考虑带有开始和结束标记而没有属性的标准元素。代码如下所示：

data Html = Element String [Html] | Content String
    deriving Show

element :: Parser Html
element = do
    name <- char '<' *> many1 letter <* char '>'
    children <- many $ (try element) <|> content
    string "</" >> string name >> char '>'
    return $ Element name children

content :: Parser Html
content = fmap Content $ many1 $ satisfy (\x -> x /='<')

如果我在内容中使用字母和数字字符，一切正常。但如果我使用“less”符号 (<)，我只会得到不好的结果。这就是为什么我暂时排除“less”符号的原因。有谁知道我该如何解决这种行为？我尝试了不同的方法，但就是无法正常工作。

感谢和问候菲利普

Answer 1

从技术上讲，<div>12 < 8</div> 这样的内容是无效的 HTML。应该改为 <div>12 < 8</div>。（评论 <div>12 > 8</div> 中提到的示例实际上是有效的 HTML，尽管更常见的是将其转义为 <div>12 > 8</div>。）但是，我想你对写一个完美的不感兴趣正确的 HTML 解析器，并希望您的解析器接受 content 中不属于有效开始或结束标记的 < 个字符。

因此，您愿意接受以下每个示例：

<div>12 < 8</div>
<p>x<y</div>
<pre><<<>>></pre>

但可能会拒绝：

<p>x<y>z</p>

基于 <y> 是一个有效的开始标签，但它缺少匹配的 </y> 并且也拒绝：

<div>x</dvi>

基于 </dvi> 是一个与当前活动开始标签不匹配的结束标签。

我将从为开始和结束标记编写单独的解析器开始：

startTag :: Parser String
startTag = char '<' *> many1 letter <* char '>'

endTag :: Parser String
endTag = string "</" *> many1 letter <* char '>'

然后，为 String 文本内容编写解析器。这可能很棘手。这是一个简单的实现，尽管它并不理想 performance-wise:

contentString :: Parser String
contentString = do
  -- fail if start or end tag (so caller will handle them)
  notFollowedBy startTag
  notFollowedBy endTag
  -- otherwise, parse either '<' as content, or some non-empty '<'-free text
  txt <- string "<" <|> many1 (noneOf "<")
  -- and possibly more text
  rest <- contentString <|> pure ""
  return (txt ++ rest)

请注意我们如何首先确保我们没有查看属于有效（开始或结束）标签一部分的 <。然后，我们允许自己解析单个 non-tag < 作为内容，或者一些完全 <-free 的内容，然后循环解析更多内容。这是一个很难正确实现的功能，因此测试是关键。（我尝试了两三次才得到可以处理我所有测试用例的东西。）

现在，我们可以重写 element 以使用 startTag 和 endTag 解析器，如下所示：

element :: Parser Html
element = do
    name <- startTag
    children <- many $ try element <|> Content <$> contentString
    name' <- endTag
    when (name /= name') $ unexpected ("</" ++ name' ++ ">, expected </" ++ name ++ ">")
    return $ Element name children

现在我们得到：

λ> parseTest element "<div>12 < 8</div>"
Element "div" [Content "12 < 8"]
λ> parseTest element "<div>x<y</div>"
Element "div" [Content "x<y"]
λ> parseTest element "<pre><<<>>></pre>"
Element "pre" [Content "<<<>>>"]
λ> parseTest element "<p>x<y>z</p>"
parse error at (line 1, column 5):
unexpected "y"
expecting "</"
λ> parseTest element "<div>x</dvi>"
parse error at (line 1, column 13):
unexpected </dvi>, expected </div>

我们可以通过修改 element 中的 try 来稍微改进第四个测试用例中的错误报告：

element :: Parser Html
element = do
    -- add "try" here
    name <- try startTag
    -- remove "try" here
    children <- many $ element <|> Content <$> contentString
    name' <- endTag
    when (name /= name') $ unexpected ("</" ++ name' ++ ">, expected </" ++ name ++ ">")
    return $ Element name children

给出：

λ> parseTest element "<p>x<y>z</p>"
parse error at (line 1, column 13):
unexpected </p>, expected </y>

可能还需要做一些测试，但在上述测试用例上似乎工作正常，另外还有一些如下所示。完整代码：

import Text.Parsec
import Text.Parsec.String
import Control.Monad

data Html = Element String [Html] | Content String
    deriving Show

startTag :: Parser String
startTag = char '<' *> many1 letter <* char '>'

endTag :: Parser String
endTag = string "</" *> many1 letter <* char '>'

element :: Parser Html
element = do
  name <- try startTag
  children <- many $ element <|> Content <$> contentString
  name' <- endTag
  when (name /= name') $ unexpected ("</" ++ name' ++ ">, expected </" ++ name ++ ">")
  return $ Element name children

contentString :: Parser String
contentString = do
  -- fail if start or end tag (so caller will handle them)
  notFollowedBy startTag
  notFollowedBy endTag
  -- otherwise, parse either '<' as content, or some non-empty text
  txt <- string "<" <|> many1 (noneOf "<")
  -- and possibly more text
  rest <- contentString <|> pure ""
  return (txt ++ rest)

main = do
  mapM_ (parseTest element)
    [ "<div>12 < 8</div>"
    , "<div>x<y</div>"
    , "<pre><<<>>></pre>"
    , "<p>x<y>z</p>"
    , "<div>x</dvi>"
    , "<table><tr><td>1</td><td>2</td></tr></table>"
    , "<empty></empty>"
    ]

Haskell Html 使用 Parsec 的解析器

Haskell Html Parser using Parsec

haskell

parsec