html-conduit 0.0.0 → 0.0.1
raw patch · 3 files changed
+39/−8 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Text/HTML/DOM.hs +23/−2
- html-conduit.cabal +1/−1
- test/main.hs +15/−5
Text/HTML/DOM.hs view
@@ -11,12 +11,15 @@ import qualified Text.HTML.TagStream as TS import qualified Data.XML.Types as XT import Data.Conduit+import Data.Text (Text)+import qualified Data.Text as T import qualified Data.Conduit.List as CL-import Control.Arrow ((***))+import Control.Arrow ((***), second) import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Set as Set import qualified Text.XML as X+import Text.XML.Stream.Parse (decodeHtmlEntities) import qualified Filesystem.Path.CurrentOS as F import Data.Conduit.Filesystem (sourceFile) import qualified Data.ByteString.Lazy as L@@ -30,7 +33,7 @@ where go stack = do mx <- await- case fmap (fmap' $ decodeUtf8With lenientDecode) mx of+ case fmap (entities . fmap' (decodeUtf8With lenientDecode)) mx of Nothing -> closeStack stack Just (TS.TagOpen local attrs isClosed) -> do let name = toName local@@ -67,6 +70,24 @@ fmap' f (TS.Comment x) = TS.Comment (f x) fmap' f (TS.Special x y) = TS.Special (f x) (f y) fmap' f (TS.Incomplete x) = TS.Incomplete (f x)++ entities :: TS.Token' Text -> TS.Token' Text+ entities (TS.TagOpen x pairs b) = TS.TagOpen x (map (second entities') pairs) b+ entities (TS.Text x) = TS.Text $ entities' x+ entities ts = ts++ entities' :: Text -> Text+ entities' t =+ case T.break (== '&') t of+ (_, "") -> t+ (before, t') ->+ case T.break (== ';') $ T.drop 1 t' of+ (_, "") -> t+ (entity, rest') ->+ let rest = T.drop 1 rest'+ in case decodeHtmlEntities entity of+ XT.ContentText entity' -> T.concat [before, entity', entities' rest]+ XT.ContentEntity _ -> T.concat [before, "&", entity, entities' rest'] isVoid = flip Set.member $ Set.fromList [ "area"
html-conduit.cabal view
@@ -1,5 +1,5 @@ Name: html-conduit-Version: 0.0.0+Version: 0.0.1 Synopsis: Parse HTML documents using xml-conduit datatypes. Description: This package uses tagstream-conduit for its parser. It automatically balances mismatched tags, so that there shouldn't be any parse failures. It does not handle a full HTML document rendering, such as adding missing html and head tags. Homepage: https://github.com/snoyberg/xml
test/main.hs view
@@ -15,11 +15,21 @@ it "adds missing close tags" $ X.parseLBS_ X.def "<foo><bar>baz</bar></foo>" @=? H.parseLBS "<foo><bar>baz</foo>"- {- Need to fix in tagstream-conduit- it "entities" $- X.parseLBS_ X.def "<foo><bar>baz </bar></foo>" @=?- H.parseLBS "<foo><bar>baz </foo>"- -} it "void tags" $ X.parseLBS_ X.def "<foo><bar><img/>foo</bar></foo>" @=? H.parseLBS "<foo><bar><img>foo</foo>"+ it "xml entities" $+ X.parseLBS_ X.def "<foo><bar>baz></bar></foo>" @=?+ H.parseLBS "<foo><bar>baz></foo>"+ it "html entities" $+ X.parseLBS_ X.def "<foo><bar>baz </bar></foo>" @=?+ H.parseLBS "<foo><bar>baz </foo>"+ it "decimal entities" $+ X.parseLBS_ X.def "<foo><bar>baz </bar></foo>" @=?+ H.parseLBS "<foo><bar>baz </foo>"+ it "hex entities" $+ X.parseLBS_ X.def "<foo><bar>bazŠ</bar></foo>" @=?+ H.parseLBS "<foo><bar>bazŠ</foo>"+ it "invalid entities" $+ X.parseLBS_ X.def "<foo><bar>baz&foobar;</bar></foo>" @=?+ H.parseLBS "<foo><bar>baz&foobar;</foo>"