git.iko.soy/typeable/html-parse
on master help sign in
Be a bit more diligent in handling EOF
commit58ca75aef0e2f7de6bcad7967d924fa5eccc1345 authorBen Gamari <ben@smart-cactus.org> dateMon 15 May 2017, 13:18 (9 years ago) parent810b9de
1 file changed+11−1
Text/HTML/Parser.hs+11−1
Text/HTML/Parser.hs+11−1
@@ -69,6 +69,10 @@ data Token
6969 | Doctype !Text
7070 deriving (Show, Ord, Eq, Generic)
7171
72+-- | This is a bit of a hack
73+endOfFileToken :: Token
74+endOfFileToken = ContentText ""
75+
7276-- | An attribute of a tag
7377data Attr = Attr !AttrName !AttrValue
7478 deriving (Show, Eq, Ord)
@@ -134,6 +138,7 @@ tagName' = do
134138selfClosingStartTag :: TagName -> [Attr] -> Parser Token
135139selfClosingStartTag tag attrs = do
136140 (char '>' >> return (TagSelfClose tag attrs))
141+ <|> (endOfInput >> return endOfFileToken)
137142 <|> beforeAttrName tag attrs
138143
139144-- | /§8.2.4.32/: Before attribute name state
@@ -166,7 +171,7 @@ afterAttrName tag attrs name = do
166171 id $ (char '/' >> selfClosingStartTag tag attrs)
167172 <|> (char '=' >> beforeAttrValue tag attrs name)
168173 <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
169− <|> (endOfInput >> return (ContentText ""))
174+ <|> (endOfInput >> return endOfFileToken)
170175 <|> attrName tag (Attr name T.empty : attrs) -- not exactly sure this is right
171176
172177-- | /§8.2.4.35/: Before attribute value state
@@ -198,6 +203,7 @@ attrValueUnquoted tag attrs name = do
198203 value <- takeTill (inClass "\x09\x0a\x0c >")
199204 id $ (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs) -- unsure: don't emit?
200205 <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))
206+ <|> (endOfInput >> return endOfFileToken)
201207
202208-- | /§8.2.4.39/: After attribute value (quoted) state
203209afterAttrValueQuoted :: TagName -> [Attr] -> AttrName -> AttrValue -> Parser Token
@@ -205,6 +211,7 @@ afterAttrValueQuoted tag attrs name value =
205211 (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs')
206212 <|> (char '/' >> selfClosingStartTag tag attrs')
207213 <|> (char '>' >> return (TagOpen tag attrs'))
214+ <|> (endOfInput >> return endOfFileToken)
208215 where attrs' = Attr name value : attrs
209216
210217-- | /§8.2.4.41/: Bogus comment state
@@ -241,6 +248,7 @@ commentStartDash :: Parser Token
241248commentStartDash =
242249 (char '-' >> commentEnd mempty)
243250 <|> (char '>' >> return (Comment mempty))
251+ <|> (endOfInput >> return (Comment mempty))
244252 <|> (comment (B.singleton '-'))
245253
246254-- | /§8.2.4.45/: Comment state
@@ -250,6 +258,7 @@ comment content0 = do
250258 id $ (char '<' >> commentLessThan (content0 <> content <> "<"))
251259 <|> (char '-' >> commentEndDash (content0 <> content))
252260 <|> (char '\x00' >> comment (content0 <> content <> B.singleton '\xfffd'))
261+ <|> (endOfInput >> return (Comment $ content0 <> content))
253262
254263-- | /§8.2.46/: Comment less-than sign state
255264commentLessThan :: Builder -> Parser Token
@@ -281,6 +290,7 @@ commentLessThanBangDashDash content =
281290commentEndDash :: Builder -> Parser Token
282291commentEndDash content = do
283292 (char '-' >> commentEnd content)
293+ <|> (endOfInput >> return (Comment content))
284294 <|> (comment (content <> "-"))
285295
286296-- | /§8.2.4.51/: Comment end state