Removed HtmlParse
This commit is contained in:
parent
d5c0418559
commit
debbdc4aed
@ -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
|
|
||||||
@ -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.
|
||||||
|
|||||||
@ -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"]]]
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user