html-tokenizer 0.5.1 → 0.5.2
raw patch · 3 files changed
+51/−59 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- html-tokenizer.cabal +1/−1
- library/HTMLTokenizer/Parsing.hs +48/−56
- tests/Main.hs +2/−2
html-tokenizer.cabal view
@@ -1,7 +1,7 @@ name: html-tokenizer version:- 0.5.1+ 0.5.2 synopsis: An "attoparsec"-based HTML tokenizer description:
library/HTMLTokenizer/Parsing.hs view
@@ -20,45 +20,54 @@ token :: Parser Token token = labeled "HTML Token" $- DoctypeToken <$> doctype <|>- openingTag OpeningTagToken <|>- ClosingTagToken <$> closingTag <|>- TextToken <$> textBetweenTags <|>- CommentToken <$> comment <|>- fail "Invalid token"--{-|->>> parseOnly doctype "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML+RDFa 1.0//EN\" \"http://www.w3.org/MarkUp/DTD/xhtml-rdfa-1.dtd\">"-Right "html PUBLIC \"-//W3C//DTD XHTML+RDFa 1.0//EN\" \"http://www.w3.org/MarkUp/DTD/xhtml-rdfa-1.dtd\""--}-doctype :: Parser Text-doctype =- labeled "Doctype" $ do- string "<!"- skipSpace- asciiCI "doctype"- space- skipSpace- contents <- takeWhile1 (/= '>')- char '>'- return contents--openingTag :: (Name -> Vector Attribute -> Bool -> openingTag) -> Parser openingTag-openingTag openingTag =- labeled "Opening tag" $ do- char '<'- skipSpace- tagName <- name- attributes <- C.many (space *> skipSpace *> attribute)- skipSpace- closed <- (char '/' $> True) <|> pure False- char '>'- return (openingTag tagName attributes closed)--closingTag :: Parser Name-closingTag =- labeled "Closing tag" $- string "</" *> skipSpace *> name <* skipSpace <* char '>'+ join+ (mplus+ (do+ char '<'+ mplus+ (do+ char '!'+ mplus+ (string "--" $> commentTagBody)+ (asciiCI "doctype" $> doctypeTagBody))+ (mplus+ (char '/' $> closingTagBody)+ (pure openingTagBody)))+ (pure (TextToken <$> textBetweenTags)))+ where+ commentTagBody =+ labeled "Comment" (CommentToken . A.run <$> loop mempty)+ where+ loop !builder =+ do+ textWithoutDashes <- A.text <$> takeWhile (/= '-')+ mplus+ (string "-->" $> builder <> textWithoutDashes)+ (mplus+ (char '-' *> loop (builder <> textWithoutDashes <> A.char '-'))+ (return (builder <> textWithoutDashes)))+ where+ textWithoutDashes =+ A.text <$> takeWhile1 (/= '-')+ doctypeTagBody =+ labeled "Doctype" $ do+ space+ skipSpace+ contents <- takeWhile1 (/= '>')+ char '>'+ return (DoctypeToken contents)+ closingTagBody =+ labeled "Closing tag" $+ skipSpace *> (ClosingTagToken <$> name) <* skipSpace <* char '>'+ openingTagBody =+ labeled "Opening tag" $ do+ skipSpace+ tagName <- name+ attributes <- C.many (space *> skipSpace *> attribute)+ skipSpace+ closed <- (char '/' $> True) <|> pure False+ char '>'+ return (OpeningTagToken tagName attributes closed) textBetweenTags :: Parser Text textBetweenTags =@@ -93,23 +102,6 @@ if D.null unconsumedSpace then return builder else return (builder <> A.char ' ')--comment :: Parser Text-comment =- labeled "Comment" $- string "<!--" *> (A.run <$> loop mempty)- where- loop !builder =- do- textWithoutDashes <- A.text <$> takeWhile (/= '-')- mplus- (string "-->" $> builder <> textWithoutDashes)- (mplus- (char '-' *> loop (builder <> textWithoutDashes <> A.char '-'))- (return (builder <> textWithoutDashes)))- where- textWithoutDashes =- A.text <$> takeWhile1 (/= '-') attribute :: Parser Attribute attribute =
tests/Main.hs view
@@ -61,8 +61,8 @@ "</x>" , testTokenParsing "Closing tag"- (Right (A.DoctypeToken "html"))- "<!DOCTYPE html>"+ (Right (A.DoctypeToken "html PUBLIC \"-//W3C//DTD XHTML+RDFa 1.0//EN\" \"http://www.w3.org/MarkUp/DTD/xhtml-rdfa-1.dtd\""))+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML+RDFa 1.0//EN\" \"http://www.w3.org/MarkUp/DTD/xhtml-rdfa-1.dtd\">" , testTokensParsing "Text between tags, stripped" (Right