yesod-test: use html-conduit

This commit is contained in:
Michael Snoyman 2012-05-09 10:37:19 +03:00
parent d0a7447f56
commit f8c731534c
2 changed files with 5 additions and 58 deletions

View File

@ -6,60 +6,9 @@ module Yesod.Test.HtmlParse
( parseHtml ( parseHtml
) where ) where
import Text.HTML.TagStream
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Text.XML import Text.XML (Document)
import Data.Conduit import qualified Text.HTML.DOM as HD
import qualified Data.Conduit.List as CL
import Data.Functor.Identity (runIdentity)
import Control.Monad.Trans.Resource (runExceptionT)
import Data.XML.Types (Event (..), Content (ContentText))
import Control.Arrow ((***))
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Set as Set
parseHtml :: L.ByteString -> Either String Document parseHtml :: L.ByteString -> Either String Document
parseHtml lbs = parseHtml = Right . HD.parseLBS
either (Left . show) Right
$ runIdentity
$ runExceptionT
$ CL.sourceList (L.toChunks lbs)
$$ tokenStream =$ (CL.concatMap toEvent =$ fromEvents)
toEvent :: Token -> [Event]
toEvent (TagOpen bsname bsattrs isClose') =
EventBeginElement name attrs : if isClose then [EventEndElement name] else []
where
name = toName bsname
attrs = map (toName *** (return . ContentText . decodeUtf8With lenientDecode)) bsattrs
isClose = isClose' || isVoid bsname
toEvent (TagClose bsname) = [EventEndElement $ toName bsname]
toEvent (Text bs) = [EventContent $ ContentText $ decodeUtf8With lenientDecode bs]
toEvent (Comment bs) = [EventComment $ decodeUtf8With lenientDecode bs]
toEvent Special{} = []
toEvent Incomplete{} = []
toName :: S.ByteString -> Name
toName bs = Name (decodeUtf8With lenientDecode bs) Nothing Nothing
isVoid :: S.ByteString -> Bool
isVoid = flip Set.member $ Set.fromList
[ "area"
, "base"
, "br"
, "col"
, "command"
, "embed"
, "hr"
, "img"
, "input"
, "keygen"
, "link"
, "meta"
, "param"
, "source"
, "track"
, "wbr"
]

View File

@ -33,13 +33,11 @@ library
, bytestring >= 0.9 , bytestring >= 0.9
, case-insensitive >= 0.2 , case-insensitive >= 0.2
, text , text
, tagstream-conduit >= 0.3 && < 0.4
, conduit >= 0.4 && < 0.5
, resourcet >= 0.3 && < 0.4
, xml-conduit >= 0.7 && < 0.8 , xml-conduit >= 0.7 && < 0.8
, xml-types >= 0.3 && < 0.4 , xml-types >= 0.3 && < 0.4
, containers , containers
, xml2html >= 0.1.2 && < 0.2 , xml2html >= 0.1.2.3 && < 0.2
, html-conduit >= 0.0.1 && < 0.1
if flag(blaze_html_0_5) if flag(blaze_html_0_5)
build-depends: build-depends: