diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,7 @@
+## 1.2.1
+
+* Add strict and lazy text parsing [#66](https://github.com/snoyberg/xml/pull/66)
+
## 1.2.0
* Drop system-filepath
diff --git a/Text/HTML/DOM.hs b/Text/HTML/DOM.hs
--- a/Text/HTML/DOM.hs
+++ b/Text/HTML/DOM.hs
@@ -5,6 +5,10 @@
, readFile
, parseLBS
, parseBSChunks
+ , eventConduitText
+ , sinkDocText
+ , parseLT
+ , parseSTChunks
) where
import Control.Monad.Trans.Resource
@@ -15,10 +19,10 @@
import qualified Data.XML.Types as XT
import Data.Conduit
import Data.Conduit.Text (decodeUtf8Lenient)
-import Data.Text (Text)
import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
import qualified Data.Conduit.List as CL
-import Control.Arrow ((***), second)
+import Control.Arrow ((***))
import qualified Data.Set as Set
import qualified Text.XML as X
import Text.XML.Stream.Parse (decodeHtmlEntities)
@@ -33,8 +37,14 @@
-- Note that there may be multiple (or not) root elements. @sinkDoc@ addresses
-- that case.
eventConduit :: Monad m => Conduit S.ByteString m XT.Event
-eventConduit =
- decodeUtf8Lenient =$= TS.tokenStream =$= go []
+eventConduit = decodeUtf8Lenient =$= eventConduit'
+
+eventConduitText :: Monad m => Conduit T.Text m XT.Event
+eventConduitText = eventConduit'
+
+eventConduit' :: Monad m => Conduit T.Text m XT.Event
+eventConduit' =
+ TS.tokenStream =$= go []
where
go stack = do
mx <- await
@@ -92,8 +102,14 @@
]
sinkDoc :: MonadThrow m => Sink S.ByteString m X.Document
-sinkDoc =
- fmap stripDummy $ mapOutput ((,) Nothing) eventConduit =$ addDummyWrapper =$ X.fromEvents
+sinkDoc = sinkDoc' eventConduit
+
+sinkDocText :: MonadThrow m => Sink T.Text m X.Document
+sinkDocText = sinkDoc' eventConduitText
+
+sinkDoc' :: (Monad m, MonadThrow m) => Conduit a m XT.Event -> Sink a m X.Document
+sinkDoc' f =
+ fmap stripDummy $ mapOutput ((,) Nothing) f =$ addDummyWrapper =$ X.fromEvents
where
addDummyWrapper = do
yield (Nothing, XT.EventBeginElement "html" [])
@@ -115,5 +131,11 @@
parseLBS = parseBSChunks . L.toChunks
parseBSChunks :: [S.ByteString] -> X.Document
-parseBSChunks bss = runIdentity $ runExceptionT_ $ CL.sourceList bss $$ sinkDoc
+parseBSChunks tss = runIdentity $ runExceptionT_ $ CL.sourceList tss $$ sinkDoc
+
+parseLT :: TL.Text -> X.Document
+parseLT = parseSTChunks . TL.toChunks
+
+parseSTChunks :: [T.Text] -> X.Document
+parseSTChunks tss = runIdentity $ runExceptionT_ $ CL.sourceList tss $$ sinkDocText
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: 1.2.0
+Version: 1.2.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
diff --git a/test/main.hs b/test/main.hs
--- a/test/main.hs
+++ b/test/main.hs
@@ -42,6 +42,12 @@
it "split code-points" $
X.parseLBS_ X.def " " @=?
H.parseBSChunks ["\xc2", "\xa0"]
+ it "latin1 codes" $
+ X.parseText_ X.def "\232" @=?
+ H.parseSTChunks ["\232"]
+ it "latin1 codes strict vs lazy" $
+ H.parseLT "\232" @=?
+ H.parseSTChunks ["\232"]
describe "HTML parsing" $ do
it "XHTML" $
let html = "fooHello World
"