diff --git a/Text/HTML/DOM.hs b/Text/HTML/DOM.hs
--- a/Text/HTML/DOM.hs
+++ b/Text/HTML/DOM.hs
@@ -28,8 +28,12 @@
import qualified Data.ByteString.Lazy as L
import Control.Monad.Trans.Resource (runExceptionT_)
import Data.Functor.Identity (runIdentity)
+import Data.Maybe (mapMaybe)
-- | Converts a stream of bytes to a stream of properly balanced @Event@s.
+--
+-- Note that there may be multiple (or not) root elements. @sinkDoc@ addresses
+-- that case.
eventConduit :: Monad m => Conduit S.ByteString m XT.Event
eventConduit =
TS.tokenStream =$= go []
@@ -112,7 +116,21 @@
]
sinkDoc :: MonadThrow m => Sink S.ByteString m X.Document
-sinkDoc = mapOutput ((,) Nothing) eventConduit =$ X.fromEvents
+sinkDoc =
+ fmap stripDummy $ mapOutput ((,) Nothing) eventConduit =$ addDummyWrapper =$ X.fromEvents
+ where
+ addDummyWrapper = do
+ yield (Nothing, XT.EventBeginElement "html" [])
+ awaitForever yield
+ yield (Nothing, XT.EventEndElement "html")
+
+ stripDummy doc@(X.Document pro (X.Element _ _ nodes) epi) =
+ case mapMaybe toElement nodes of
+ [root] -> X.Document pro root epi
+ _ -> doc
+
+ toElement (X.NodeElement e) = Just e
+ toElement _ = Nothing
readFile :: F.FilePath -> IO X.Document
readFile fp = runResourceT $ sourceFile fp $$ sinkDoc
diff --git a/html-conduit.cabal b/html-conduit.cabal
--- a/html-conduit.cabal
+++ b/html-conduit.cabal
@@ -1,5 +1,5 @@
Name: html-conduit
-Version: 0.1.0.2
+Version: 0.1.0.3
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
diff --git a/test/main.hs b/test/main.hs
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
import Test.HUnit hiding (Test)
-import Test.Hspec.Monadic
-import Test.Hspec.HUnit ()
+import Test.Hspec
import Data.ByteString.Lazy.Char8 ()
import qualified Text.HTML.DOM as H
import qualified Text.XML as X
@@ -34,6 +33,9 @@
it "invalid entities" $
X.parseLBS_ X.def "baz&foobar;" @=?
H.parseLBS "baz&foobar;"
+ it "multiple root elements" $
+ X.parseLBS_ X.def "baz&foobar;" @=?
+ H.parseLBS "baz&foobar;"
describe "HTML parsing" $ do
it "XHTML" $
let html = "fooHello World
"