{-# 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)