module Text.HTML.TagSoup.HT.Test ( -- * Tests on laziness laziness, lazyTags, lazyWarnings, -- * QuickCheck properties propSections, propPartitions, ) where import qualified Text.HTML.TagSoup.HT.Tag as Tag import qualified Text.HTML.TagSoup.HT.Parser as Parser import qualified Text.HTML.TagSoup as TagSoupNM {- *Text.HTML.TagSoup.HT> mapM print $ runSoup $ " [Tag.T Char] runSoup = Parser.runSoup lazyTags :: [Char] lazyTags = map ((!!1000) . show . runSoup) $ (cycle "Rhabarber") : (repeat '&') : ("<"++cycle "html") : (" [a] -> [a] (?:) (True, x) xs = x:xs (?:) (False, _) xs = xs sections_rec :: (a -> Bool) -> [a] -> [[a]] sections_rec f = let recurse [] = [] recurse (x:xs) = (f x, x:xs) ?: recurse xs in recurse propSections :: Int -> [Int] -> Bool propSections y xs = let p = (<=y) in TagSoupNM.sections p xs == sections_rec p xs partitions_rec :: (a -> Bool) -> [a] -> [[a]] partitions_rec f = g . dropWhile (not . f) where g [] = [] g (x:xs) = (x:a) : g b where (a,b) = break f xs propPartitions :: Int -> [Int] -> Bool propPartitions y xs = let p = (<=y) in TagSoupNM.partitions p xs == partitions_rec p xs