diff --git a/Text/HTML/DOM.hs b/Text/HTML/DOM.hs
--- a/Text/HTML/DOM.hs
+++ b/Text/HTML/DOM.hs
@@ -109,7 +109,7 @@
]
sinkDoc :: MonadThrow m => Sink S.ByteString m X.Document
-sinkDoc = eventConduit =$ X.fromEvents
+sinkDoc = mapOutput ((,) Nothing) eventConduit =$ X.fromEvents
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.0.1
+Version: 0.1.0
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
@@ -20,11 +20,11 @@
, containers
, text
, resourcet >= 0.3 && < 0.4
- , conduit >= 0.4 && < 0.5
- , filesystem-conduit >= 0.4 && < 0.5
+ , conduit >= 0.5 && < 0.6
+ , filesystem-conduit >= 0.5 && < 0.6
, system-filepath >= 0.4 && < 0.5
- , xml-conduit >= 0.7 && < 0.8
- , tagstream-conduit >= 0.3 && < 0.4
+ , xml-conduit >= 1.0 && < 1.1
+ , tagstream-conduit >= 0.4 && < 0.5
, xml-types >= 0.3 && < 0.4
test-suite test
@@ -37,6 +37,7 @@
, xml-conduit
, html-conduit
, bytestring
+ , containers
source-repository head
type: git
diff --git a/test/main.hs b/test/main.hs
--- a/test/main.hs
+++ b/test/main.hs
@@ -5,9 +5,10 @@
import Data.ByteString.Lazy.Char8 ()
import qualified Text.HTML.DOM as H
import qualified Text.XML as X
+import qualified Data.Map as Map
main :: IO ()
-main = hspecX $ do
+main = hspec $ do
describe "parses" $ do
it "well-formed document" $
X.parseLBS_ X.def "baz" @=?
@@ -33,3 +34,33 @@
it "invalid entities" $
X.parseLBS_ X.def "baz&foobar;" @=?
H.parseLBS "baz&foobar;"
+ describe "HTML parsing" $ do
+ it "XHTML" $
+ let html = "fooHello World
"
+ doc = X.Document (X.Prologue [] Nothing []) root []
+ root = X.Element "html" Map.empty
+ [ X.NodeElement $ X.Element "head" Map.empty
+ [ X.NodeElement $ X.Element "title" Map.empty
+ [X.NodeContent "foo"]
+ ]
+ , X.NodeElement $ X.Element "body" Map.empty
+ [ X.NodeElement $ X.Element "p" Map.empty
+ [X.NodeContent "Hello World"]
+ ]
+ ]
+ in H.parseLBS html @?= doc
+ it "HTML" $
+ let html = "foo
Hello World
"
+ doc = X.Document (X.Prologue [] Nothing []) root []
+ root = X.Element "html" Map.empty
+ [ X.NodeElement $ X.Element "head" Map.empty
+ [ X.NodeElement $ X.Element "title" Map.empty
+ [X.NodeContent "foo"]
+ ]
+ , X.NodeElement $ X.Element "body" Map.empty
+ [ X.NodeElement $ X.Element "br" Map.empty []
+ , X.NodeElement $ X.Element "p" Map.empty
+ [X.NodeContent "Hello World"]
+ ]
+ ]
+ in H.parseLBS html @?= doc