Removed HtmlParse

This commit is contained in:
Michael Snoyman 2012-07-09 13:40:24 +03:00
parent d5c0418559
commit debbdc4aed
4 changed files with 6 additions and 20 deletions

View File

@ -1,14 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
-- | Parse an HTML document into xml-conduit's Document.
--
-- Assumes UTF-8 encoding.
module Yesod.Test.HtmlParse
( parseHtml
) where
import qualified Data.ByteString.Lazy as L
import Text.XML (Document)
import qualified Text.HTML.DOM as HD
parseHtml :: L.ByteString -> Either String Document
parseHtml = Right . HD.parseLBS

View File

@ -41,11 +41,11 @@ where
import Yesod.Test.CssQuery import Yesod.Test.CssQuery
import qualified Data.Text as T import qualified Data.Text as T
import Yesod.Test.HtmlParse (parseHtml)
import Control.Applicative ((<$>), (<*>)) import Control.Applicative ((<$>), (<*>))
import Text.XML import Text.XML
import Text.XML.Cursor import Text.XML.Cursor
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Text.HTML.DOM as HD
#if MIN_VERSION_blaze_html(0, 5, 0) #if MIN_VERSION_blaze_html(0, 5, 0)
import Text.Blaze.Html (toHtml) import Text.Blaze.Html (toHtml)
import Text.Blaze.Html.Renderer.String (renderHtml) import Text.Blaze.Html.Renderer.String (renderHtml)
@ -64,7 +64,7 @@ type Html = L.ByteString
-- * Right: List of matching Html fragments. -- * Right: List of matching Html fragments.
findBySelector :: Html -> Query -> Either String [String] findBySelector :: Html -> Query -> Either String [String]
findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x) findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x)
<$> (fromDocument <$> parseHtml html) <$> (Right $ fromDocument $ HD.parseLBS html)
<*> parseQuery query <*> parseQuery query
-- Run a compiled query on Html, returning a list of matching Html fragments. -- Run a compiled query on Html, returning a list of matching Html fragments.

View File

@ -5,18 +5,18 @@ import Test.Hspec.HUnit ()
import Yesod.Test.CssQuery import Yesod.Test.CssQuery
import Yesod.Test.TransversingCSS import Yesod.Test.TransversingCSS
import Yesod.Test.HtmlParse
import Text.XML import Text.XML
import Data.ByteString.Lazy.Char8 () import Data.ByteString.Lazy.Char8 ()
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Text.HTML.DOM as HD
parseQuery_ = either error id . parseQuery parseQuery_ = either error id . parseQuery
findBySelector_ x = either error id . findBySelector x findBySelector_ x = either error id . findBySelector x
parseHtml_ = either error id . parseHtml parseHtml_ = HD.parseLBS
main :: IO () main :: IO ()
main = hspecX $ do main = hspec $ do
describe "CSS selector parsing" $ do describe "CSS selector parsing" $ do
it "elements" $ parseQuery_ "strong" @?= [[DeepChildren [ByTagName "strong"]]] it "elements" $ parseQuery_ "strong" @?= [[DeepChildren [ByTagName "strong"]]]
it "child elements" $ parseQuery_ "strong > i" @?= [[DeepChildren [ByTagName "strong"], DirectChildren [ByTagName "i"]]] it "child elements" $ parseQuery_ "strong > i" @?= [[DeepChildren [ByTagName "strong"], DirectChildren [ByTagName "i"]]]

View File

@ -38,7 +38,6 @@ library
exposed-modules: Yesod.Test exposed-modules: Yesod.Test
Yesod.Test.CssQuery Yesod.Test.CssQuery
Yesod.Test.TransversingCSS Yesod.Test.TransversingCSS
Yesod.Test.HtmlParse
ghc-options: -Wall ghc-options: -Wall
test-suite test test-suite test
@ -52,6 +51,7 @@ test-suite test
, xml-conduit , xml-conduit
, bytestring , bytestring
, containers , containers
, html-conduit
source-repository head source-repository head
type: git type: git