@@ -107,7 +107,7 @@ endTagOpen = tagNameClose
107107
108108-- | /§8.2.4.8/: Tag name state: the open case
109109--
110−-- deviation: no lower-casing
110+-- deviation: no lower-casing, don't handle NULL characters
111111tagNameOpen :: Parser Token
112112tagNameOpen = do
113113 tag <- tagName'
@@ -123,20 +123,20 @@ tagNameClose = do
123123
124124-- | /§8.2.4.10/: Tag name state: common code
125125--
126−-- deviation: no lower-casing
126+-- deviation: no lower-casing, don't handle NULL characters
127127tagName' :: Parser Text
128128tagName' = do
129129 c <- peekChar'
130130 guard $ isAsciiUpper c || isAsciiLower c
131131 takeWhile $ notInClass "\x09\x0a\x0c /<>"
132132
133−-- | /§8.2.4.43/: Self-closing start tag state
133+-- | /§8.2.4.40/: Self-closing start tag state
134134selfClosingStartTag :: TagName -> [Attr] -> Parser Token
135135selfClosingStartTag tag attrs = do
136136 (char '>' >> return (TagSelfClose tag attrs))
137137 <|> beforeAttrName tag attrs
138138
139−-- | /§8.2.4.34/: Before attribute name state
139+-- | /§8.2.4.32/: Before attribute name state
140140--
141141-- deviation: no lower-casing
142142beforeAttrName :: TagName -> [Attr] -> Parser Token
@@ -147,7 +147,7 @@ beforeAttrName tag attrs = do
147147 -- <|> (char '\x00' >> attrName tag attrs) -- TODO: NULL
148148 <|> attrName tag attrs
149149
150−-- | /§8.2.4.35/: Attribute name state
150+-- | /§8.2.4.33/: Attribute name state
151151attrName :: TagName -> [Attr] -> Parser Token
152152attrName tag attrs = do
153153 name <- takeWhile $ notInClass "\x09\x0a\x0c /=<>\x00"
@@ -157,7 +157,7 @@ attrName tag attrs = do
157157 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
158158 -- <|> -- TODO: NULL
159159
160−-- | /§8.2.4.36/: After attribute name state
160+-- | /§8.2.4.34/: After attribute name state
161161afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token
162162afterAttrName tag attrs name = do
163163 skipWhile $ inClass "\x09\x0a\x0c "
@@ -166,7 +166,7 @@ afterAttrName tag attrs name = do
166166 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
167167 <|> attrName tag (Attr name T.empty : attrs) -- not exactly sure this is right
168168
169−-- | /§8.2.4.37/: Before attribute value state
169+-- | /§8.2.4.35/: Before attribute value state
170170beforeAttrValue :: TagName -> [Attr] -> AttrName -> Parser Token
171171beforeAttrValue tag attrs name = do
172172 skipWhile $ inClass "\x09\x0a\x0c "
@@ -175,28 +175,28 @@ beforeAttrValue tag attrs name = do
175175 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
176176 <|> attrValueUnquoted tag attrs name
177177
178−-- | /§8.2.4.38/: Attribute value (double-quoted) state
178+-- | /§8.2.4.36/: Attribute value (double-quoted) state
179179attrValueDQuoted :: TagName -> [Attr] -> AttrName -> Parser Token
180180attrValueDQuoted tag attrs name = do
181181 value <- takeWhile (/= '"')
182182 _ <- char '"'
183183 afterAttrValueQuoted tag attrs name value
184184
185−-- | /§8.2.4.39/: Attribute value (single-quoted) state
185+-- | /§8.2.4.37/: Attribute value (single-quoted) state
186186attrValueSQuoted :: TagName -> [Attr] -> AttrName -> Parser Token
187187attrValueSQuoted tag attrs name = do
188188 value <- takeWhile (/= '\'')
189189 _ <- char '\''
190190 afterAttrValueQuoted tag attrs name value
191191
192−-- | /§8.2.4.40/: Attribute value (unquoted) state
192+-- | /§8.2.4.38/: Attribute value (unquoted) state
193193attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token
194194attrValueUnquoted tag attrs name = do
195195 value <- takeTill (inClass "\x09\x0a\x0c >")
196196 id $ (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs) -- unsure: don't emit?
197197 <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))
198198
199−-- | /§8.2.4.42/: After attribute value (quoted) state
199+-- | /§8.2.4.39/: After attribute value (quoted) state
200200afterAttrValueQuoted :: TagName -> [Attr] -> AttrName -> AttrValue -> Parser Token
201201afterAttrValueQuoted tag attrs name value =
202202 (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs')
@@ -204,6 +204,14 @@ afterAttrValueQuoted tag attrs name value =
204204 <|> (char '>' >> return (TagOpen tag attrs'))
205205 where attrs' = Attr name value : attrs
206206
207+-- | /§8.2.4.41/: Bogus comment state
208+bogusComment :: Builder -> Parser Token
209+bogusComment content = do
210+ (char '>' >> return (Comment content))
211+ <|> (endOfInput >> return (Comment content))
212+ <|> (char '\x00' >> bogusComment (content <> "\xfffd"))
213+ <|> (anyChar >>= \c -> bogusComment (content <> B.singleton c))
214+
207215-- | /§8.2.4.42/: Markup declaration open state
208216markupDeclOpen :: Parser Token
209217markupDeclOpen =
@@ -297,14 +305,6 @@ doctype = do
297305 _ <- char '>'
298306 return $ Doctype content
299307
300−-- | /§8.2.4.41/: Bogus comment state
301−bogusComment :: Builder -> Parser Token
302−bogusComment content = do
303− (char '>' >> return (Comment content))
304− <|> (endOfInput >> return (Comment content))
305− <|> (char '\x00' >> bogusComment (content <> "\xfffd"))
306− <|> (anyChar >>= \c -> bogusComment (content <> B.singleton c))
307−
308308-- | Parse a lazy list of tokens from strict 'Text'.
309309parseTokens :: Text -> [Token]
310310parseTokens = unfoldr f