1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
{-# 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 {{{
[ ( "<span readonly title=foo class=\"foo bar\" style='display:none;'>"
, [TagOpen "span" [("readonly", ""), ("title", "foo"), ("class", "foo bar"), ("style", "display:none;")] False]
)
, ( "<span a = b = c = d>"
, [TagOpen "span" [("a", "b"), ("=", ""), ("c", "d")] False]
)
, ( "<span a = b = c>"
, [TagOpen "span" [("a", "b"), ("=", ""), ("c", "")] False]
)
, ( "<span /foo=bar>"
, [TagOpen "span" [("/foo", "bar")] False]
)
-- }}}
-- quoted string and escaping {{{
, ( "<span \"<p>xx \\\"'\\\\</p>\"=\"<p>xx \\\"'\\\\</p>\">"
, [TagOpen "span" [("<p>xx \"'\\</p>", "<p>xx \"'\\</p>")] False]
)
, ( "<span '<p>xx \\\"\\'\\\\</p>'='<p>xx \\\"\\'\\\\</p>'>"
, [TagOpen "span" [("<p>xx \"'\\</p>", "<p>xx \"'\\</p>")] False]
)
-- }}}
-- attribute and tag end {{{
, ( "<br/>"
, [TagOpen "br" [] True]
)
, ( "<img src=http://foo.bar.com/foo.jpg />"
, [TagOpen "img" [("src", "http://foo.bar.com/foo.jpg")] True]
)
, ( "<span foo>"
, [TagOpen "span" [("foo", "")] False]
)
, ( "<span foo/>"
, [TagOpen "span" [("foo", "")] True]
)
, ( "<span foo=/>"
, [TagOpen "span" [("foo", "/")] False]
)
-- }}}
-- normal tag {{{
, ( "<p>text</p>"
, [TagOpen "p" [] False, Text "text", TagClose "p"]
)
, ( "<>"
, [TagOpen "" [] False]
)
, ( "<a\ttitle\n=\r\"foo bar\" alt=\n/\r\t>"
, [TagOpen "a" [("title", "foo bar"), ("alt", "/")] False]
)
-- }}}
-- comment tag {{{
, ( "<!--foo-->"
, [Comment "foo"] )
, ( "<!--f--oo->-->"
, [Comment "f--oo->"] )
, ( "<!--foo-->bar-->"
, [Comment "foo", Text "bar-->"]
)
-- }}}
-- special tag {{{
, ( "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\">"
, [Special "DOCTYPE" "html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\""]
)
, ( "<!DOCTYPE html>"
, [Special "DOCTYPE" "html"]
)
-- }}}
-- close tag {{{
, ( "</\r\t\nbr>"
, [TagClose "\r\t\nbr"]
)
, ( "</br/>"
, [TagClose "br/"]
)
, ( "</>"
, [TagClose ""]
)
-- }}}
-- incomplete test {{{
-- }}}
-- script tag TODO{{{
, ( "<script></script>"
, [TagOpen "script" [] False, TagClose "script"]
)
, ( "<script>var x=\"</script>"
, [TagOpen "script" [] False, Text "var x=\"", TagClose "script"]
)
--, ( "<script>var x=\"</script>\";</script>"
-- , [TagOpen "script" [] False, Text "var x=\"</script>\";", TagClose "script"]
-- )
, ( "<script>// '\r\n</script>"
, [TagOpen "script" [] False, Text "// '\r\n", TagClose "script"]
)
-- }}}
]
testChar :: Gen Char
testChar = growingElements "<>/=\"' \t\r\nabcde\\"
testString :: Gen String
testString = listOf testChar
testBS :: Gen ByteString
testBS = S.pack <$> testString
instance Arbitrary ByteString where
arbitrary = testBS
assertEither :: Either String a -> Assertion
assertEither = either (assertFailure . ("Left:"++)) (const $ return ())
assertDecode :: ByteString -> IO [Token]
assertDecode s = do
let result = decode s
assertEither result
let (Right tokens) = result
return tokens
combineText :: [Token] -> [Token]
combineText [] = []
combineText (Text t1 : Text t2 : xs) = combineText $ Text (S.append t1 t2) : xs
combineText (x:xs) = x : combineText xs
|
