module Example.Regress (regress) where import Text.HTML.TagSoup import Text.HTML.TagSoup.Entity import qualified Text.HTML.TagSoup.Match as Match import Control.Exception -- * The Test Monad data Test a = Pass instance Monad Test where a >> b = a `seq` b return = error "No return for Monad Test" (>>=) = error "No bind (>>=) for Monad Test" instance Show (Test a) where show x = x `seq` "All tests passed" pass :: Test () pass = Pass (===) :: (Show a, Eq a) => a -> a -> Test () a === b = if a == b then pass else fail $ "Does not equal: " ++ show a ++ " =/= " ++ show b -- * The Main section regress :: IO () regress = print $ do parseTests combiTests entityTests lazyTags == lazyTags `seq` pass matchCombinators {- | This routine tests the laziness of the TagSoup parser. For each critical part of the parser we provide a test input with a token of infinite size. Then the output must be infinite too. If the laziness is broken, then the output will stop early. We collect the thousandth character of the output of each test case. If computation of the list stops somewhere, you have found a laziness stopper. -} lazyTags :: [Char] lazyTags = map ((!!1000) . show . parseTags) $ (cycle "Rhabarber") : (repeat '&') : ("<"++cycle "html") : ("" === [TagOpen "!DOCTYPE" [("TEST","")]] parseTags "" === [TagOpen "test" [("","foo bar")]] parseTags "" === [TagOpen "test" [("","foo bar")]] parseTags "<:test \'foo bar\'>" === [TagOpen ":test" [("","foo bar")]] parseTags "hello & world" === [TagText "hello & world"] parseTags "hello @ world" === [TagText "hello @ world"] parseTags "hello @ world" === [TagText "hello @ world"] parseTags "hello &haskell; world" === [TagText "hello &haskell; world"] parseTags "hello \n\t world" === [TagText "hello \n\t world"] parseTags "" === [TagOpen "!DOCTYPE" [("HTML",""),("PUBLIC",""),("","-//W3C//DTD HTML 4.01//EN"),("","http://www.w3.org/TR/html4/strict.dtd")]] parseTags "