{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where import Control.Applicative import Test.Hspec.Monadic import Test.Hspec.HUnit () import Test.Hspec.QuickCheck (prop) import Test.HUnit hiding (Test) import Test.QuickCheck import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import Text.HTML.TagStream main :: IO () main = hspecX $ do describe "Property" $ do prop "Text nodes can't be empty" propTextNotEmpty prop "Parse results can't empty" propResultNotEmpty describe "One pass parse" onePassTests describe "Streamline parse" streamlineTests propTextNotEmpty :: ByteString -> Bool propTextNotEmpty = either (const False) text_not_empty . decode where text_not_empty = all not_empty not_empty (Text s) = S.length s > 0 not_empty _ = True propResultNotEmpty :: ByteString -> Bool propResultNotEmpty s = either (const False) not_empty . decode $ s where not_empty tokens = (S.null s && null tokens) || (not (S.null s) && not (null tokens)) onePassTests :: Specs onePassTests = mapM_ one testcases where one (str, tokens) = it (S.unpack str) $ do result <- combineText <$> assertDecode str assertEqual "one-pass parse result incorrect" tokens result streamlineTests :: Specs streamlineTests = mapM_ one testcases where isIncomplete (Incomplete _) = True isIncomplete _ = False one (str, tokens) = it (S.unpack str) $ do -- streamline parse result don't contain the trailing Incomplete token. let tokens' = reverse . dropWhile isIncomplete . reverse $ tokens result <- combineText <$> C.runResourceT ( CL.sourceList (map S.singleton (S.unpack str)) C.$= tokenStream C.$$ CL.consume ) assertEqual "streamline parse result incorrect" tokens' result testcases :: [(ByteString, [Token])] testcases = -- attributes {{{ [ ( "