7c4c1e4 · typeable/html-parse

git.iko.soy/typeable/html-parse

on master help sign in

Avoid inClass for common case of whitespace

7c4c1e4Ben Gamari9 years ago

Text/HTML/Parser.hs+14−6

compare with master

unifiedsplit

@@ -109,13 +109,21 @@ tagOpen =

109endTagOpen :: Parser Token

110endTagOpen = tagNameClose

111

112+-- | Equivalent to @inClass "\x09\x0a\x0c "@

113+isWhitespace :: Char -> Bool

114+isWhitespace '\x09' = True

115+isWhitespace '\x0a' = True

116+isWhitespace '\x0c' = True

117+isWhitespace ' ' = True

118+isWhitespace _ = False

119+

112-- | /§8.2.4.8/: Tag name state: the open case

120-- | /§8.2.4.8/: Tag name state: the open case

113--

121--

114-- deviation: no lower-casing, don't handle NULL characters

122-- deviation: no lower-casing, don't handle NULL characters

115tagNameOpen :: Parser Token

123tagNameOpen :: Parser Token

116tagNameOpen = do

124tagNameOpen = do

117 tag <- tagName'

125 tag <- tagName'

118− id $ (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag [])

126+ id $ (satisfy isWhitespace >> beforeAttrName tag [])

119 <|> (char '/' >> selfClosingStartTag tag [])

127 <|> (char '/' >> selfClosingStartTag tag [])

120 <|> (char '>' >> return (TagOpen tag []))

128 <|> (char '>' >> return (TagOpen tag []))

121

129

@@ -146,7 +154,7 @@ selfClosingStartTag tag attrs = do

146-- deviation: no lower-casing

154-- deviation: no lower-casing

147beforeAttrName :: TagName -> [Attr] -> Parser Token

155beforeAttrName :: TagName -> [Attr] -> Parser Token

148beforeAttrName tag attrs = do

156beforeAttrName tag attrs = do

149− skipWhile $ inClass "\x09\x0a\x0c "

157+ skipWhile isWhitespace

150 id $ (char '/' >> selfClosingStartTag tag attrs)

158 id $ (char '/' >> selfClosingStartTag tag attrs)

151 <|> (char '>' >> return (TagOpen tag attrs))

159 <|> (char '>' >> return (TagOpen tag attrs))

152 -- <|> (char '\x00' >> attrName tag attrs) -- TODO: NULL

160 -- <|> (char '\x00' >> attrName tag attrs) -- TODO: NULL

@@ -167,7 +175,7 @@ attrName tag attrs = do

167-- | /§8.2.4.34/: After attribute name state

175-- | /§8.2.4.34/: After attribute name state

168afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token

176afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token

169afterAttrName tag attrs name = do

177afterAttrName tag attrs name = do

170− skipWhile $ inClass "\x09\x0a\x0c "

178+ skipWhile isWhitespace

171 id $ (char '/' >> selfClosingStartTag tag attrs)

179 id $ (char '/' >> selfClosingStartTag tag attrs)

172 <|> (char '=' >> beforeAttrValue tag attrs name)

180 <|> (char '=' >> beforeAttrValue tag attrs name)

173 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))

181 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))

@@ -177,7 +185,7 @@ afterAttrName tag attrs name = do

177-- | /§8.2.4.35/: Before attribute value state

185-- | /§8.2.4.35/: Before attribute value state

178beforeAttrValue :: TagName -> [Attr] -> AttrName -> Parser Token

186beforeAttrValue :: TagName -> [Attr] -> AttrName -> Parser Token

179beforeAttrValue tag attrs name = do

187beforeAttrValue tag attrs name = do

180− skipWhile $ inClass "\x09\x0a\x0c "

188+ skipWhile isWhitespace

181 id $ (char '"' >> attrValueDQuoted tag attrs name)

189 id $ (char '"' >> attrValueDQuoted tag attrs name)

182 <|> (char '\'' >> attrValueSQuoted tag attrs name)

190 <|> (char '\'' >> attrValueSQuoted tag attrs name)

183 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))

191 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))

@@ -201,14 +209,14 @@ attrValueSQuoted tag attrs name = do

201attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token

209attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token

202attrValueUnquoted tag attrs name = do

210attrValueUnquoted tag attrs name = do

203 value <- takeTill (inClass "\x09\x0a\x0c >")

211 value <- takeTill (inClass "\x09\x0a\x0c >")

204− id $ (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs) -- unsure: don't emit?

212+ id $ (satisfy isWhitespace >> beforeAttrName tag attrs) -- unsure: don't emit?

205 <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))

213 <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))

206 <|> (endOfInput >> return endOfFileToken)

214 <|> (endOfInput >> return endOfFileToken)

207

215

208-- | /§8.2.4.39/: After attribute value (quoted) state

216-- | /§8.2.4.39/: After attribute value (quoted) state

209afterAttrValueQuoted :: TagName -> [Attr] -> AttrName -> AttrValue -> Parser Token

217afterAttrValueQuoted :: TagName -> [Attr] -> AttrName -> AttrValue -> Parser Token

210afterAttrValueQuoted tag attrs name value =

218afterAttrValueQuoted tag attrs name value =

211− (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs')

219+ (satisfy isWhitespace >> beforeAttrName tag attrs')

212 <|> (char '/' >> selfClosingStartTag tag attrs')

220 <|> (char '/' >> selfClosingStartTag tag attrs')

213 <|> (char '>' >> return (TagOpen tag attrs'))

221 <|> (char '>' >> return (TagOpen tag attrs'))

214 <|> (endOfInput >> return endOfFileToken)

222 <|> (endOfInput >> return endOfFileToken)