@@ -109,13 +109,29 @@ tagOpen =
109109endTagOpen :: Parser Token
110110endTagOpen = tagNameClose
111111
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+
120+orC :: (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
121+orC f g c = f c || g c
122+{-# INLINE orC #-}
123+
124+isC :: Char -> Char -> Bool
125+isC = (==)
126+{-# INLINE isC #-}
127+
112128-- | /§8.2.4.8/: Tag name state: the open case
113129--
114130-- deviation: no lower-casing, don't handle NULL characters
115131tagNameOpen :: Parser Token
116132tagNameOpen = do
117133 tag <- tagName'
118− id $ (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag [])
134+ id $ (satisfy isWhitespace >> beforeAttrName tag [])
119135 <|> (char '/' >> selfClosingStartTag tag [])
120136 <|> (char '>' >> return (TagOpen tag []))
121137
@@ -132,7 +148,7 @@ tagName' :: Parser Text
132148tagName' = do
133149 c <- peekChar'
134150 guard $ isAsciiUpper c || isAsciiLower c
135− takeWhile $ notInClass "\x09\x0a\x0c /<>"
151+ takeWhile $ not . (isWhitespace `orC` isC '/' `orC` isC '<' `orC` isC '>')
136152
137153-- | /§8.2.4.40/: Self-closing start tag state
138154selfClosingStartTag :: TagName -> [Attr] -> Parser Token
@@ -146,7 +162,7 @@ selfClosingStartTag tag attrs = do
146162-- deviation: no lower-casing
147163beforeAttrName :: TagName -> [Attr] -> Parser Token
148164beforeAttrName tag attrs = do
149− skipWhile $ inClass "\x09\x0a\x0c "
165+ skipWhile isWhitespace
150166 id $ (char '/' >> selfClosingStartTag tag attrs)
151167 <|> (char '>' >> return (TagOpen tag attrs))
152168 -- <|> (char '\x00' >> attrName tag attrs) -- TODO: NULL
@@ -155,7 +171,7 @@ beforeAttrName tag attrs = do
155171-- | /§8.2.4.33/: Attribute name state
156172attrName :: TagName -> [Attr] -> Parser Token
157173attrName tag attrs = do
158− name <- takeWhile $ notInClass "\x09\x0a\x0c /=>"
174+ name <- takeWhile $ not . (isWhitespace `orC` isC '/' `orC` isC '=' `orC` isC '>')
159175 id $ (endOfInput >> afterAttrName tag attrs name)
160176 <|> (char '=' >> beforeAttrValue tag attrs name)
161177 <|> try (do mc <- peekChar
@@ -167,7 +183,7 @@ attrName tag attrs = do
167183-- | /§8.2.4.34/: After attribute name state
168184afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token
169185afterAttrName tag attrs name = do
170− skipWhile $ inClass "\x09\x0a\x0c "
186+ skipWhile isWhitespace
171187 id $ (char '/' >> selfClosingStartTag tag attrs)
172188 <|> (char '=' >> beforeAttrValue tag attrs name)
173189 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
@@ -177,7 +193,7 @@ afterAttrName tag attrs name = do
177193-- | /§8.2.4.35/: Before attribute value state
178194beforeAttrValue :: TagName -> [Attr] -> AttrName -> Parser Token
179195beforeAttrValue tag attrs name = do
180− skipWhile $ inClass "\x09\x0a\x0c "
196+ skipWhile isWhitespace
181197 id $ (char '"' >> attrValueDQuoted tag attrs name)
182198 <|> (char '\'' >> attrValueSQuoted tag attrs name)
183199 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
@@ -201,14 +217,14 @@ attrValueSQuoted tag attrs name = do
201217attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token
202218attrValueUnquoted tag attrs name = do
203219 value <- takeTill (inClass "\x09\x0a\x0c >")
204− id $ (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs) -- unsure: don't emit?
220+ id $ (satisfy isWhitespace >> beforeAttrName tag attrs) -- unsure: don't emit?
205221 <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))
206222 <|> (endOfInput >> return endOfFileToken)
207223
208224-- | /§8.2.4.39/: After attribute value (quoted) state
209225afterAttrValueQuoted :: TagName -> [Attr] -> AttrName -> AttrValue -> Parser Token
210226afterAttrValueQuoted tag attrs name value =
211− (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs')
227+ (satisfy isWhitespace >> beforeAttrName tag attrs')
212228 <|> (char '/' >> selfClosingStartTag tag attrs')
213229 <|> (char '>' >> return (TagOpen tag attrs'))
214230 <|> (endOfInput >> return endOfFileToken)
@@ -229,7 +245,7 @@ markupDeclOpen =
229245 <|> try docType
230246 <|> bogusComment mempty
231247 where
232− comment_ = string "--" >> commentStart
248+ comment_ = char '-' >> char '-' >> commentStart
233249 docType = do
234250 -- switching this to asciiCI slowed things down by a factor of two
235251 s <- take 7
@@ -254,7 +270,7 @@ commentStartDash =
254270-- | /§8.2.4.45/: Comment state
255271comment :: Builder -> Parser Token
256272comment content0 = do
257− content <- B.fromText <$> takeWhile (notInClass "-\x00<")
273+ content <- B.fromText <$> takeWhile (not . (isC '-' `orC` isC '\x00' `orC` isC '<'))
258274 id $ (char '<' >> commentLessThan (content0 <> content <> "<"))
259275 <|> (char '-' >> commentEndDash (content0 <> content))
260276 <|> (char '\x00' >> comment (content0 <> content <> B.singleton '\xfffd'))