git.iko.soy/typeable/pandoc
on master help sign in
HTML reader: Fixed some parsing bugs.
d6f28afJohn MacFarlane
src/Text/Pandoc/Readers/HTML.hs+28−22
compare with master
unifiedsplit
@@ -54,26 +54,25 @@ readHtml :: ParserState -- ^ Parser state
54 -> String -- ^ String to parse (assumes @'\n'@ line endings)
54 -> String -- ^ String to parse (assumes @'\n'@ line endings)
55 -> Pandoc
55 -> Pandoc
56readHtml st inp = Pandoc meta blocks
56readHtml st inp = Pandoc meta blocks
57− where blocks = readWith parseBody st body
57+ where blocks = readWith parseBody st rest
58− tags = canonicalizeTags $
58+ tags = canonicalizeTags $
59− parseTagsOptions parseOptions{ optTagPosition = True } inp
59+ parseTagsOptions parseOptions{ optTagPosition = True } inp
60 hasHeader = any (~== TagOpen "head" []) tags
60 hasHeader = any (~== TagOpen "head" []) tags
61 (meta, rest) = if hasHeader
61 (meta, rest) = if hasHeader
62 then parseHeader tags
62 then parseHeader tags
63 else (Meta [] [] [], tags)
63 else (Meta [] [] [], tags)
64− body = filter (\t -> not $
65− tagOpen (`elem` ["html","head","body"]) (const True) t ||
66− tagClose (`elem` ["html","head","body"]) t) rest
67
64
68type TagParser = GenParser (Tag String) ParserState
65type TagParser = GenParser (Tag String) ParserState
69
66
67+-- TODO - fix this - not every header has a title tag
70parseHeader :: [Tag String] -> (Meta, [Tag String])
68parseHeader :: [Tag String] -> (Meta, [Tag String])
71parseHeader tags = (Meta{docTitle = tit'', docAuthors = [], docDate = []}, rest)
69parseHeader tags = (Meta{docTitle = tit'', docAuthors = [], docDate = []}, rest)
72− where (tit,r) = break (~== TagClose "title") $ drop 1 $
70+ where (tit,_) = break (~== TagClose "title") $ drop 1 $
73 dropWhile (\t -> not $ t ~== TagOpen "title" []) tags
71 dropWhile (\t -> not $ t ~== TagOpen "title" []) tags
74 tit' = concatMap fromTagText $ filter isTagText tit
72 tit' = concatMap fromTagText $ filter isTagText tit
75 tit'' = normalizeSpaces $ toList $ text tit'
73 tit'' = normalizeSpaces $ toList $ text tit'
76− rest = drop 1 $ dropWhile (\t -> not $ t ~== TagClose "head") r
74+ rest = drop 1 $ dropWhile (\t -> not $ t ~== TagClose "head" ||
75+ t ~== TagOpen "body" []) tags
77
76
78parseBody :: TagParser [Block]
77parseBody :: TagParser [Block]
79parseBody = liftM concat $ manyTill block eof
78parseBody = liftM concat $ manyTill block eof
@@ -157,12 +156,19 @@ pDefListItem = try $ do
157 let term = intercalate [LineBreak] terms
156 let term = intercalate [LineBreak] terms
158 return (term, defs)
157 return (term, defs)
159
158
159+pRawTag :: TagParser String
160+pRawTag = do
161+ tag <- pAnyTag
162+ let ignorable x = x `elem` ["html","head","body"]
163+ if tagOpen ignorable (const True) tag || tagClose ignorable tag
164+ then return []
165+ else return $ renderTags' [tag]
166+
160pRawHtmlBlock :: TagParser [Block]
167pRawHtmlBlock :: TagParser [Block]
161pRawHtmlBlock = do
168pRawHtmlBlock = do
162− raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|>
169+ raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pRawTag
163− liftM (renderTags' . (:[])) pAnyTag
164 state <- getState
170 state <- getState
165− if stateParseRaw state
171+ if stateParseRaw state && not (null raw)
166 then return [RawHtml raw]
172 then return [RawHtml raw]
167 else return []
173 else return []
168
174
@@ -283,9 +289,9 @@ pStrikeout = do
283 pInlinesInTags "s" Strikeout <|>
289 pInlinesInTags "s" Strikeout <|>
284 pInlinesInTags "strike" Strikeout <|>
290 pInlinesInTags "strike" Strikeout <|>
285 pInlinesInTags "del" Strikeout <|>
291 pInlinesInTags "del" Strikeout <|>
286− do pSatisfy (~== TagOpen "span" [("class","strikeout")])
292+ try (do pSatisfy (~== TagOpen "span" [("class","strikeout")])
287− contents <- liftM concat $ manyTill inline (pCloses "span")
293+ contents <- liftM concat $ manyTill inline (pCloses "span")
288− return [Strikeout contents]
294+ return [Strikeout contents])
289
295
290pLineBreak :: TagParser [Inline]
296pLineBreak :: TagParser [Inline]
291pLineBreak = do
297pLineBreak = do
@@ -293,7 +299,7 @@ pLineBreak = do
293 return [LineBreak]
299 return [LineBreak]
294
300
295pLink :: TagParser [Inline]
301pLink :: TagParser [Inline]
296−pLink = do
302+pLink = try $ do
297 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
303 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
298 let url = fromAttrib "href" tag
304 let url = fromAttrib "href" tag
299 let title = fromAttrib "title" tag
305 let title = fromAttrib "title" tag
@@ -309,7 +315,7 @@ pImage = do
309 return [Image (toList $ text alt) (escapeURI url, title)]
315 return [Image (toList $ text alt) (escapeURI url, title)]
310
316
311pCode :: TagParser [Inline]
317pCode :: TagParser [Inline]
312−pCode = do
318+pCode = try $ do
313 (TagOpen open _) <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
319 (TagOpen open _) <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
314 result <- manyTill pAnyTag (pCloses open)
320 result <- manyTill pAnyTag (pCloses open)
315 return [Code $ intercalate " " $ lines $ innerText result]
321 return [Code $ intercalate " " $ lines $ innerText result]
@@ -347,7 +353,7 @@ pCloses tagtype = try $ do
347 _ -> pzero
353 _ -> pzero
348
354
349pTagText :: TagParser [Inline]
355pTagText :: TagParser [Inline]
350−pTagText = do
356+pTagText = try $ do
351 (TagText str) <- pSatisfy isTagText
357 (TagText str) <- pSatisfy isTagText
352 st <- getState
358 st <- getState
353 case runParser (many pTagContents) st "text" str of
359 case runParser (many pTagContents) st "text" str of
@@ -358,7 +364,7 @@ pTagContents :: GenParser Char ParserState Inline
358pTagContents = pStr <|> pSpace <|> smartPunctuation pTagContents <|> pSymbol
364pTagContents = pStr <|> pSpace <|> smartPunctuation pTagContents <|> pSymbol
359
365
360pStr :: GenParser Char ParserState Inline
366pStr :: GenParser Char ParserState Inline
361−pStr = many1 (satisfy (\c -> not (isSpace c) && not (isSpecial c))) >>= return . Str
367+pStr = liftM Str $ many1 $ satisfy $ \c -> not (isSpace c) && not (isSpecial c)
362
368
363isSpecial :: Char -> Bool
369isSpecial :: Char -> Bool
364isSpecial '"' = True
370isSpecial '"' = True
@@ -381,7 +387,7 @@ pSpace = many1 (satisfy isSpace) >> return Space
381-- Constants
387-- Constants
382--
388--
383
389
384−eitherBlockOrInline :: [[Char]]
390+eitherBlockOrInline :: [String]
385eitherBlockOrInline = ["applet", "button", "del", "iframe", "ins",
391eitherBlockOrInline = ["applet", "button", "del", "iframe", "ins",
386 "map", "area", "object"]
392 "map", "area", "object"]
387
393
@@ -394,11 +400,11 @@ inlineHtmlTags = ["a", "abbr", "acronym", "b", "basefont", "bdo", "big",
394 "textarea", "tt", "u", "var"]
400 "textarea", "tt", "u", "var"]
395-}
401-}
396
402
397−blockHtmlTags :: [[Char]]
403+blockHtmlTags :: [String]
398blockHtmlTags = ["address", "blockquote", "body", "center", "dir", "div",
404blockHtmlTags = ["address", "blockquote", "body", "center", "dir", "div",
399 "dl", "fieldset", "form", "h1", "h2", "h3", "h4",
405 "dl", "fieldset", "form", "h1", "h2", "h3", "h4",
400− "h5", "h6", "head", "hr", "html", "isindex", "menu", "noframes",
406+ "h5", "h6", "head", "hr", "html", "isindex", "menu",
401− "noscript", "ol", "p", "pre", "table", "ul", "dd",
407+ "noframes", "noscript", "ol", "p", "pre", "table", "ul", "dd",
402 "dt", "frameset", "li", "tbody", "td", "tfoot",
408 "dt", "frameset", "li", "tbody", "td", "tfoot",
403 "th", "thead", "tr", "script", "style"]
409 "th", "thead", "tr", "script", "style"]
404
410