问题描述
我当前正在用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 /='<')
如果我对内容使用字母和数字字符,则一切正常。但是,如果使用的是“较少”符号(
感谢和问候 菲利普
解决方法
从技术上讲,类似<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
写一个解析器。这可能很棘手。即使不是理想的性能,这也是一个简单的实现:
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)
请注意我们如何首先确保没有看到<
是有效(开始或结束)标记的一部分。然后,我们允许自己解析单个非标签<
作为内容,或者解析一些完全不包含<
的内容,然后再循环解析更多内容。这是一项很难完成的功能,因此测试是关键。 (我花了两到三遍才得到可以处理所有测试用例的东西。)
现在,我们可以重写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>
我们可以通过摆弄try
中的element
来稍微改善第四个测试用例中的错误报告:
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,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>"
]