NemNem

{-# OPTIONS_GHC -fno-warn-deprecations #-} module TagSoup.Test(test) where import Text.HTML.TagSoup import Text.HTML.TagSoup.Entity import Text.HTML.TagSoup.Match import Control.Monad import Data.List import Test.QuickCheck -- * The Test Monad type Test a = IO a pass :: Test () pass = return () runTest :: Test () -> IO () runTest x = x >> putStrLn "All tests passed" (===) :: (Show a, Eq a) => a -> a -> IO () a === b = if a == b then pass else fail $ "Does not equal: " ++ show a ++ " =/= " ++ show b check :: Testable prop => prop -> IO () check prop = do res <- quickCheckWithResult stdArgs{maxSuccess=1000} prop case res of Success{} -> pass _ -> fail "Property failed" newtype HTML = HTML String deriving Show instance Arbitrary HTML where arbitrary = fmap (HTML . concat) $ listOf $ elements frags where frags = map (:[]) " \n!-</>#&;xy01[]?'\"" ++ ["CDATA","amp","gt","lt"] shrink (HTML x) = map HTML $ zipWith (++) (inits x) (tail $ tails x) -- * The Main section test :: IO () test = runTest $ do warnTests parseTests optionsTests renderTests 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" ,"<html "++cycle "na!me=value " ,"<html name="++cycle "value" ,"<html name=\""++cycle "value" ,"<html name="++cycle "val!ue" ,"<html "++cycle "name" ,"</"++cycle "html" ,"" === "" rp "<a test=\"a'b\">" === "<a test=\"a'b\">" escapeHTML "this is a &\" <test> '" === "this is a &" <test> '" check $ \(HTML x) -> let y = rp x in rp y == (y :: String) entityTests :: Test () entityTests = do lookupNumericEntity "65" === Just "A" lookupNumericEntity "x41" === Just "A" lookupNumericEntity "x4E" === Just "N" lookupNumericEntity "x4e" === Just "N" lookupNumericEntity "Haskell" === Nothing lookupNumericEntity "" === Nothing lookupNumericEntity "89439085908539082" === Nothing lookupNamedEntity "amp" === Just "&" lookupNamedEntity "haskell" === Nothing escapeXML "hello world" === "hello world" escapeXML "hello & world" === "hello & world" combiTests :: Test () combiTests = do (TagText "test" ~== TagText "" ) === True (TagText "test" ~== TagText "test") === True (TagText "test" ~== TagText "soup") === False (TagText "test" ~== "test") === True (TagOpen "test" [] ~== "<test>") === True (TagOpen "test" [] ~== "<soup>") === False (TagOpen "test" [] ~/= "<soup>") === True (TagComment "foo" ~== "") === True (TagComment "bar" ~== "") === True warnTests :: Test () warnTests = do let p = parseTagsOptions parseOptions{optTagPosition=True,optTagWarning=True} wt x = [(msg,c) | TagWarning msg:TagPosition _ c:_ <- tails $ p x] wt "neil &foo bar" === [("Unknown entity: foo",10)]