yesod-test: use html-conduit
This commit is contained in:
parent
d0a7447f56
commit
f8c731534c
@ -6,60 +6,9 @@ module Yesod.Test.HtmlParse
|
||||
( parseHtml
|
||||
) where
|
||||
|
||||
import Text.HTML.TagStream
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Text.XML
|
||||
import Data.Conduit
|
||||
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
|
||||
import Text.XML (Document)
|
||||
import qualified Text.HTML.DOM as HD
|
||||
|
||||
parseHtml :: L.ByteString -> Either String Document
|
||||
parseHtml lbs =
|
||||
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"
|
||||
]
|
||||
parseHtml = Right . HD.parseLBS
|
||||
|
||||
@ -33,13 +33,11 @@ library
|
||||
, bytestring >= 0.9
|
||||
, case-insensitive >= 0.2
|
||||
, text
|
||||
, tagstream-conduit >= 0.3 && < 0.4
|
||||
, conduit >= 0.4 && < 0.5
|
||||
, resourcet >= 0.3 && < 0.4
|
||||
, xml-conduit >= 0.7 && < 0.8
|
||||
, xml-types >= 0.3 && < 0.4
|
||||
, 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)
|
||||
build-depends:
|
||||
|
||||
Loading…
Reference in New Issue
Block a user