58ca75a · typeable/html-parse

git.iko.soy/typeable/html-parse

on master help sign in

Be a bit more diligent in handling EOF

58ca75aBen Gamari9 years ago

Text/HTML/Parser.hs+11−1

compare with master

unifiedsplit

@@ -69,6 +69,10 @@ data Token

69 | Doctype !Text

70 deriving (Show, Ord, Eq, Generic)

72+-- | This is a bit of a hack

73+endOfFileToken :: Token

74+endOfFileToken = ContentText ""

75+

72-- | An attribute of a tag

76-- | An attribute of a tag

73data Attr = Attr !AttrName !AttrValue

77data Attr = Attr !AttrName !AttrValue

74 deriving (Show, Eq, Ord)

78 deriving (Show, Eq, Ord)

@@ -134,6 +138,7 @@ tagName' = do

134selfClosingStartTag :: TagName -> [Attr] -> Parser Token

138selfClosingStartTag :: TagName -> [Attr] -> Parser Token

135selfClosingStartTag tag attrs = do

139selfClosingStartTag tag attrs = do

136 (char '>' >> return (TagSelfClose tag attrs))

140 (char '>' >> return (TagSelfClose tag attrs))

141+ <|> (endOfInput >> return endOfFileToken)

137 <|> beforeAttrName tag attrs

142 <|> beforeAttrName tag attrs

138

143

139-- | /§8.2.4.32/: Before attribute name state

144-- | /§8.2.4.32/: Before attribute name state

@@ -166,7 +171,7 @@ afterAttrName tag attrs name = do

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

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

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

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

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

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

169− <|> (endOfInput >> return (ContentText ""))

174+ <|> (endOfInput >> return endOfFileToken)

170 <|> attrName tag (Attr name T.empty : attrs) -- not exactly sure this is right

175 <|> attrName tag (Attr name T.empty : attrs) -- not exactly sure this is right

171

176

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

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

@@ -198,6 +203,7 @@ attrValueUnquoted tag attrs name = do

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

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

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

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

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

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

206+ <|> (endOfInput >> return endOfFileToken)

201

207

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

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

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

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

@@ -205,6 +211,7 @@ afterAttrValueQuoted tag attrs name value =

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

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

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

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

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

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

214+ <|> (endOfInput >> return endOfFileToken)

208 where attrs' = Attr name value : attrs

215 where attrs' = Attr name value : attrs

209

216

210-- | /§8.2.4.41/: Bogus comment state

217-- | /§8.2.4.41/: Bogus comment state

@@ -241,6 +248,7 @@ commentStartDash :: Parser Token

241commentStartDash =

248commentStartDash =

242 (char '-' >> commentEnd mempty)

249 (char '-' >> commentEnd mempty)

243 <|> (char '>' >> return (Comment mempty))

250 <|> (char '>' >> return (Comment mempty))

251+ <|> (endOfInput >> return (Comment mempty))

244 <|> (comment (B.singleton '-'))

252 <|> (comment (B.singleton '-'))

245

253

246-- | /§8.2.4.45/: Comment state

254-- | /§8.2.4.45/: Comment state

@@ -250,6 +258,7 @@ comment content0 = do

250 id $ (char '<' >> commentLessThan (content0 <> content <> "<"))

258 id $ (char '<' >> commentLessThan (content0 <> content <> "<"))

251 <|> (char '-' >> commentEndDash (content0 <> content))

259 <|> (char '-' >> commentEndDash (content0 <> content))

252 <|> (char '\x00' >> comment (content0 <> content <> B.singleton '\xfffd'))

260 <|> (char '\x00' >> comment (content0 <> content <> B.singleton '\xfffd'))

261+ <|> (endOfInput >> return (Comment $ content0 <> content))

253

262

254-- | /§8.2.46/: Comment less-than sign state

263-- | /§8.2.46/: Comment less-than sign state

255commentLessThan :: Builder -> Parser Token

264commentLessThan :: Builder -> Parser Token

@@ -281,6 +290,7 @@ commentLessThanBangDashDash content =

281commentEndDash :: Builder -> Parser Token

290commentEndDash :: Builder -> Parser Token

282commentEndDash content = do

291commentEndDash content = do

283 (char '-' >> commentEnd content)

292 (char '-' >> commentEnd content)

293+ <|> (endOfInput >> return (Comment content))

284 <|> (comment (content <> "-"))

294 <|> (comment (content <> "-"))

285

295

286-- | /§8.2.4.51/: Comment end state

296-- | /§8.2.4.51/: Comment end state