packages feed

html-parse 0.2.0.1 → 0.2.0.2

raw patch · 3 files changed

+76/−22 lines, 3 filesdep ~attoparsecdep ~basedep ~containers

Dependency ranges changed: attoparsec, base, containers, deepseq, text

Files

Text/HTML/Parser.hs view
@@ -2,6 +2,8 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -O2 #-}+ -- | This is a performance-oriented HTML tokenizer aim at web-crawling -- applications. It follows the HTML5 parsing specification quite closely, -- so it behaves reasonable well on ill-formed documents from the open Web.@@ -109,13 +111,29 @@ endTagOpen :: Parser Token endTagOpen = tagNameClose +-- | Equivalent to @inClass "\x09\x0a\x0c "@+isWhitespace :: Char -> Bool+isWhitespace '\x09' = True+isWhitespace '\x0a' = True+isWhitespace '\x0c' = True+isWhitespace ' '    = True+isWhitespace _      = False++orC :: (Char -> Bool) -> (Char -> Bool) -> Char -> Bool+orC f g c = f c || g c+{-# INLINE orC #-}++isC :: Char -> Char -> Bool+isC = (==)+{-# INLINE isC #-}+ -- | /§8.2.4.8/: Tag name state: the open case -- -- deviation: no lower-casing, don't handle NULL characters tagNameOpen :: Parser Token tagNameOpen = do     tag <- tagName'-    id $  (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag [])+    id $  (satisfy isWhitespace >> beforeAttrName tag [])       <|> (char '/' >> selfClosingStartTag tag [])       <|> (char '>' >> return (TagOpen tag [])) @@ -132,7 +150,7 @@ tagName' = do     c <- peekChar'     guard $ isAsciiUpper c || isAsciiLower c-    takeWhile $ notInClass "\x09\x0a\x0c /<>"+    takeWhile $ not . (isWhitespace `orC` isC '/' `orC` isC '<' `orC` isC '>')  -- | /§8.2.4.40/: Self-closing start tag state selfClosingStartTag :: TagName -> [Attr] -> Parser Token@@ -146,7 +164,7 @@ -- deviation: no lower-casing beforeAttrName :: TagName -> [Attr] -> Parser Token beforeAttrName tag attrs = do-    skipWhile $ inClass "\x09\x0a\x0c "+    skipWhile isWhitespace     id $  (char '/' >> selfClosingStartTag tag attrs)       <|> (char '>' >> return (TagOpen tag attrs))       -- <|> (char '\x00' >> attrName tag attrs) -- TODO: NULL@@ -155,19 +173,20 @@ -- | /§8.2.4.33/: Attribute name state attrName :: TagName -> [Attr] -> Parser Token attrName tag attrs = do-    name <- takeWhile $ notInClass "\x09\x0a\x0c /=>"+    name <- takeWhile $ not . (isWhitespace `orC` isC '/' `orC` isC '=' `orC` isC '>')     id $  (endOfInput >> afterAttrName tag attrs name)       <|> (char '=' >> beforeAttrValue tag attrs name)       <|> try (do mc <- peekChar                   case mc of-                    Just c | inClass "\x09\x0a\x0c />" c ->  afterAttrName tag attrs name+                    Just c | notNameChar c ->  afterAttrName tag attrs name                     _ -> empty)       -- <|> -- TODO: NULL+  where notNameChar = isWhitespace `orC` isC '/' `orC` isC '>'  -- | /§8.2.4.34/: After attribute name state afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token afterAttrName tag attrs name = do-    skipWhile $ inClass "\x09\x0a\x0c "+    skipWhile isWhitespace     id $  (char '/' >> selfClosingStartTag tag attrs)       <|> (char '=' >> beforeAttrValue tag attrs name)       <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))@@ -177,7 +196,7 @@ -- | /§8.2.4.35/: Before attribute value state beforeAttrValue :: TagName -> [Attr] -> AttrName -> Parser Token beforeAttrValue tag attrs name = do-    skipWhile $ inClass "\x09\x0a\x0c "+    skipWhile isWhitespace     id $  (char '"' >> attrValueDQuoted tag attrs name)       <|> (char '\'' >> attrValueSQuoted tag attrs name)       <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))@@ -200,15 +219,15 @@ -- | /§8.2.4.38/: Attribute value (unquoted) state attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token attrValueUnquoted tag attrs name = do-    value <- takeTill (inClass "\x09\x0a\x0c >")-    id $  (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs) -- unsure: don't emit?+    value <- takeTill $ isWhitespace `orC` isC '>'+    id $  (satisfy isWhitespace >> beforeAttrName tag attrs) -- unsure: don't emit?       <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))       <|> (endOfInput >> return endOfFileToken)  -- | /§8.2.4.39/: After attribute value (quoted) state afterAttrValueQuoted :: TagName -> [Attr] -> AttrName -> AttrValue -> Parser Token afterAttrValueQuoted tag attrs name value =-          (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs')+          (satisfy isWhitespace >> beforeAttrName tag attrs')       <|> (char '/' >> selfClosingStartTag tag attrs')       <|> (char '>' >> return (TagOpen tag attrs'))       <|> (endOfInput >> return endOfFileToken)@@ -229,7 +248,7 @@     <|> try docType     <|> bogusComment mempty   where-    comment_ = string "--" >> commentStart+    comment_ = char '-' >> char '-' >> commentStart     docType = do         -- switching this to asciiCI slowed things down by a factor of two         s <- take 7@@ -254,7 +273,7 @@ -- | /§8.2.4.45/: Comment state comment :: Builder -> Parser Token comment content0 = do-    content <- B.fromText <$> takeWhile (notInClass "-\x00<")+    content <- B.fromText <$> takeWhile (not . (isC '-' `orC` isC '\x00' `orC` isC '<'))     id $  (char '<' >> commentLessThan (content0 <> content <> "<"))       <|> (char '-' >> commentEndDash (content0 <> content))       <|> (char '\x00' >> comment (content0 <> content <> B.singleton '\xfffd'))
html-parse.cabal view
@@ -1,20 +1,47 @@ name:                html-parse-version:             0.2.0.1+version:             0.2.0.2 synopsis:            A high-performance HTML tokenizer description:     This package provides a fast and reasonably robust HTML5 tokenizer built     upon the @attoparsec@ library. The parsing strategy is based upon the HTML5     parsing specification with few deviations.     .-    The package targets similar use-cases to the venerable @tagsoup@ library,-    but is significantly more efficient, achieving parsing speeds of over 50-    megabytes per second on modern hardware with and typical web documents.-    .     For instance,     .     >>> parseTokens "<div><h1 class=widget>Hello World</h1><br/>"-    [TagOpen "div" [],TagOpen "h1" [Attr "class" "widget"],-     ContentText "Hello World",TagClose "h1",TagSelfClose "br" []]+    [TagOpen "div" [],+     TagOpen "h1" [Attr "class" "widget"],+     ContentText "Hello World",+     TagClose "h1",+     TagSelfClose "br" []]+    .+    The package targets similar use-cases to the venerable @tagsoup@ library,+    but is significantly more efficient, achieving parsing speeds of over 80+    megabytes per second on modern hardware and typical web documents.+    Here are some typical performance numbers taken from parsing a Wikipedia+    article of moderate length:+    .+    @+    benchmarking Forced/tagsoup fast Text+    time                 186.1 ms   (175.3 ms .. 194.6 ms)+                         0.999 R²   (0.995 R² .. 1.000 R²)+    mean                 191.7 ms   (188.9 ms .. 198.3 ms)+    std dev              5.053 ms   (1.092 ms .. 6.809 ms)+    variance introduced by outliers: 14% (moderately inflated)+    .+    benchmarking Forced/tagsoup normal Text+    time                 189.7 ms   (182.8 ms .. 197.7 ms)+                         0.999 R²   (0.998 R² .. 1.000 R²)+    mean                 196.5 ms   (193.1 ms .. 202.1 ms)+    std dev              5.481 ms   (2.141 ms .. 7.383 ms)+    variance introduced by outliers: 14% (moderately inflated)+    .+    benchmarking Forced/html-parser+    time                 15.81 ms   (15.75 ms .. 15.89 ms)+                         1.000 R²   (1.000 R² .. 1.000 R²)+    mean                 15.72 ms   (15.66 ms .. 15.77 ms)+    std dev              140.9 μs   (113.6 μs .. 174.5 μs)+    @  homepage:            http://github.com/bgamari/html-parse license:             BSD3@@ -36,11 +63,11 @@   exposed-modules:     Text.HTML.Parser, Text.HTML.Tree   ghc-options:         -Wall   other-extensions:    OverloadedStrings, DeriveGeneric-  build-depends:       base >=4.7 && <4.11,-                       deepseq >=1.4 && <1.5,+  build-depends:       base >=4.7 && <4.13,+                       deepseq >=1.3 && <1.5,                        attoparsec >=0.13 && <0.14,                        text >=1.2 && <1.3,-                       containers >=0.5 && <0.6+                       containers >=0.5 && <0.7   default-language:    Haskell2010  benchmark bench
tests/Text/HTML/ParserSpec.hs view
@@ -100,3 +100,11 @@     describe "parseTokens" $ do       it "works on `<h1>Heading</h1>`" $ do         parseTokens "<h1>Heading</h1>" `shouldBe` [TagOpen "h1" [], ContentText "Heading", TagClose "h1"]+      it "terminates on truncated tags" $ do+        parseTokens "19 -167.44 <A HREF=\"http://walrus.wr.usgs" `shouldBe` [ContentText "19 -167.44 ", ContentText ""]+      it "parses comment correctly" $ do+        parseTokens "<!-- 3. Change Banner -->" `shouldBe` [Comment " 3. Change Banner "]+      it "parses commented tag correctly" $ do+        parseTokens "<!-- img src=\"/www_images/NCEP_GFS.gif\">" `shouldBe` [Comment " img src=\"/www_images/NCEP_GFS.gif\">"]+      it "parses funky comment" $ do+        parseTokens "<!-- img src=\"/www_images/NCEP_GFS.gif\"><!- -------------------------------------------------------- >" `shouldBe` [Comment " img src=\"/www_images/NCEP_GFS.gif\"><!- -------------------------------------------------------- >"]