@@ -2,6 +2,8 @@
2{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE LambdaCase #-}
5+{-# OPTIONS_GHC -O2 #-}
5-- | This is a performance-oriented HTML tokenizer aim at web-crawling
7-- | This is a performance-oriented HTML tokenizer aim at web-crawling
6-- applications. It follows the HTML5 parsing specification quite closely,
8-- applications. It follows the HTML5 parsing specification quite closely,
7-- so it behaves reasonable well on ill-formed documents from the open Web.
9-- so it behaves reasonable well on ill-formed documents from the open Web.
@@ -176,9 +178,10 @@ attrName tag attrs = do
176 <|> (char '=' >> beforeAttrValue tag attrs name)
178 <|> (char '=' >> beforeAttrValue tag attrs name)
177 <|> try (do mc <- peekChar
179 <|> try (do mc <- peekChar
178 case mc of
180 case mc of
179− Just c | inClass "\x09\x0a\x0c />" c -> afterAttrName tag attrs name
181+ Just c | notNameChar c -> afterAttrName tag attrs name
180 _ -> empty)
182 _ -> empty)
181 -- <|> -- TODO: NULL
183 -- <|> -- TODO: NULL
184+ where notNameChar = isWhitespace `orC` isC '/' `orC` isC '>'
183-- | /§8.2.4.34/: After attribute name state
186-- | /§8.2.4.34/: After attribute name state
184afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token
187afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token
@@ -216,7 +219,7 @@ attrValueSQuoted tag attrs name = do
216-- | /§8.2.4.38/: Attribute value (unquoted) state
219-- | /§8.2.4.38/: Attribute value (unquoted) state
217attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token
220attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token
218attrValueUnquoted tag attrs name = do
221attrValueUnquoted tag attrs name = do
219− value <- takeTill (inClass "\x09\x0a\x0c >")
222+ value <- takeTill $ isWhitespace `orC` isC '>'
220 id $ (satisfy isWhitespace >> beforeAttrName tag attrs) -- unsure: don't emit?
223 id $ (satisfy isWhitespace >> beforeAttrName tag attrs) -- unsure: don't emit?
221 <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))
224 <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))
222 <|> (endOfInput >> return endOfFileToken)
225 <|> (endOfInput >> return endOfFileToken)