{-# LANGUAGE FlexibleContexts #-}
module Main (main) where
import Text.HTML.Scalpel
import Control.Applicative
import System.Exit
import Test.HUnit
import qualified Text.HTML.TagSoup as TagSoup
import qualified Text.Regex.TDFA
main = exit . failures =<< runTestTT (TestList [
scrapeTests
, selectTests
])
exit :: Int -> IO ()
exit 0 = exitSuccess
exit n = exitWith $ ExitFailure n
selectTests = "selectTests" ~: TestList [
selectTest
("a" @: [])
"foo"
["foo"]
, selectTest
("a" @: [])
"foobar"
["foo", "bar"]
, selectTest
("a" @: [])
"foo"
["foo"]
, selectTest
("a" @: [])
"foo"
["foo", "foo"]
, selectTest
("b" @: [])
"foo"
[]
, selectTest
("a" @: [])
"foo"
[]
, selectTest
("a" @: ["key" @= "value"])
"foobar"
["bar"]
, selectTest
("a" // "b" @: [] // "c")
"foo"
["foo"]
, selectTest
("a" // "b")
"foobarbaz"
["foo", "bar"]
, selectTest
("a" @: [hasClass "a"])
"foo"
["foo"]
, selectTest
("a" @: [hasClass "c"])
"foo"
[]
, selectTest
("a" @: ["key" @=~ re "va(foo|bar|lu)e"])
"foo"
["foo"]
, selectTest
("a" @: [Any @= "value"])
"foobar"
["foo", "bar"]
, selectTest
("a" @: [Any @= "value"])
"foobar"
["bar"]
, selectTest
(Any @: [Any @= "value"])
"foobar"
["foo", "bar"]
, selectTest
(Any @: [Any @= "value"])
"foobar"
["bar"]
]
selectTest :: Selectable String s => s -> String -> [String] -> Test
selectTest selector tags expectedText = label ~: expected @=? actual
where
label = "select (" ++ show tags ++ ")"
expected = map TagSoup.parseTags expectedText
actual = select selector (TagSoup.parseTags tags)
re :: String -> Text.Regex.TDFA.Regex
re = Text.Regex.TDFA.makeRegex
scrapeTests = "scrapeTests" ~: TestList [
scrapeTest
"foo"
(Just "foo")
(text "a")
, scrapeTest
"foobar"
(Just "foo")
(text "a")
, scrapeTest
"foobar"
(Just ["foo", "bar"])
(texts "a")
, scrapeTest
"foobar"
(Just [True, False])
(map (== "foo") <$> (texts $ "a"))
, scrapeTest
""
(Just "foo")
(attr "key" $ "a")
, scrapeTest
""
(Just "baz")
(attr "key2" $ "a" @: ["key1" @= "bar"])
, scrapeTest
"foobar"
(Just ["foo"])
(chroot "a" $ texts "b")
, scrapeTest
"foobar"
(Just ["foo", "bar"])
(chroots "a" $ text "b")
, scrapeTest
"foobar"
(Just "foo")
((text $ "a" // "b") <|> (text $ "a" // "c"))
, scrapeTest
"foobar"
(Just "bar")
((text $ "a" // "d") <|> (text $ "a" // "c"))
]
scrapeTest :: (Eq a, Show a) => String -> Maybe a -> Scraper String a -> Test
scrapeTest html expected scraper = label ~: expected @=? actual
where
label = "scrape (" ++ show html ++ ")"
actual = scrape scraper (TagSoup.parseTags html)