@@ -54,26 +54,25 @@ readHtml :: ParserState -- ^ Parser state
5454 -> String -- ^ String to parse (assumes @'\n'@ line endings)
5555 -> Pandoc
5656readHtml st inp = Pandoc meta blocks
57− where blocks = readWith parseBody st body
58− tags = canonicalizeTags $
59− parseTagsOptions parseOptions{ optTagPosition = True } inp
57+ where blocks = readWith parseBody st rest
58+ tags = canonicalizeTags $
59+ parseTagsOptions parseOptions{ optTagPosition = True } inp
6060 hasHeader = any (~== TagOpen "head" []) tags
6161 (meta, rest) = if hasHeader
6262 then parseHeader tags
6363 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
6764
6865type TagParser = GenParser (Tag String) ParserState
6966
67+-- TODO - fix this - not every header has a title tag
7068parseHeader :: [Tag String] -> (Meta, [Tag String])
7169parseHeader tags = (Meta{docTitle = tit'', docAuthors = [], docDate = []}, rest)
72− where (tit,r) = break (~== TagClose "title") $ drop 1 $
70+ where (tit,_) = break (~== TagClose "title") $ drop 1 $
7371 dropWhile (\t -> not $ t ~== TagOpen "title" []) tags
7472 tit' = concatMap fromTagText $ filter isTagText tit
7573 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
7776
7877parseBody :: TagParser [Block]
7978parseBody = liftM concat $ manyTill block eof
@@ -157,12 +156,19 @@ pDefListItem = try $ do
157156 let term = intercalate [LineBreak] terms
158157 return (term, defs)
159158
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+
160167pRawHtmlBlock :: TagParser [Block]
161168pRawHtmlBlock = do
162− raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|>
163− liftM (renderTags' . (:[])) pAnyTag
169+ raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pRawTag
164170 state <- getState
165− if stateParseRaw state
171+ if stateParseRaw state && not (null raw)
166172 then return [RawHtml raw]
167173 else return []
168174
@@ -283,9 +289,9 @@ pStrikeout = do
283289 pInlinesInTags "s" Strikeout <|>
284290 pInlinesInTags "strike" Strikeout <|>
285291 pInlinesInTags "del" Strikeout <|>
286− do pSatisfy (~== TagOpen "span" [("class","strikeout")])
287− contents <- liftM concat $ manyTill inline (pCloses "span")
288− return [Strikeout contents]
292+ try (do pSatisfy (~== TagOpen "span" [("class","strikeout")])
293+ contents <- liftM concat $ manyTill inline (pCloses "span")
294+ return [Strikeout contents])
289295
290296pLineBreak :: TagParser [Inline]
291297pLineBreak = do
@@ -293,7 +299,7 @@ pLineBreak = do
293299 return [LineBreak]
294300
295301pLink :: TagParser [Inline]
296−pLink = do
302+pLink = try $ do
297303 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
298304 let url = fromAttrib "href" tag
299305 let title = fromAttrib "title" tag
@@ -309,7 +315,7 @@ pImage = do
309315 return [Image (toList $ text alt) (escapeURI url, title)]
310316
311317pCode :: TagParser [Inline]
312−pCode = do
318+pCode = try $ do
313319 (TagOpen open _) <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
314320 result <- manyTill pAnyTag (pCloses open)
315321 return [Code $ intercalate " " $ lines $ innerText result]
@@ -347,7 +353,7 @@ pCloses tagtype = try $ do
347353 _ -> pzero
348354
349355pTagText :: TagParser [Inline]
350−pTagText = do
356+pTagText = try $ do
351357 (TagText str) <- pSatisfy isTagText
352358 st <- getState
353359 case runParser (many pTagContents) st "text" str of
@@ -358,7 +364,7 @@ pTagContents :: GenParser Char ParserState Inline
358364pTagContents = pStr <|> pSpace <|> smartPunctuation pTagContents <|> pSymbol
359365
360366pStr :: 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)
362368
363369isSpecial :: Char -> Bool
364370isSpecial '"' = True
@@ -381,7 +387,7 @@ pSpace = many1 (satisfy isSpace) >> return Space
381387-- Constants
382388--
383389
384−eitherBlockOrInline :: [[Char]]
390+eitherBlockOrInline :: [String]
385391eitherBlockOrInline = ["applet", "button", "del", "iframe", "ins",
386392 "map", "area", "object"]
387393
@@ -394,11 +400,11 @@ inlineHtmlTags = ["a", "abbr", "acronym", "b", "basefont", "bdo", "big",
394400 "textarea", "tt", "u", "var"]
395401-}
396402
397−blockHtmlTags :: [[Char]]
403+blockHtmlTags :: [String]
398404blockHtmlTags = ["address", "blockquote", "body", "center", "dir", "div",
399405 "dl", "fieldset", "form", "h1", "h2", "h3", "h4",
400− "h5", "h6", "head", "hr", "html", "isindex", "menu", "noframes",
401− "noscript", "ol", "p", "pre", "table", "ul", "dd",
406+ "h5", "h6", "head", "hr", "html", "isindex", "menu",
407+ "noframes", "noscript", "ol", "p", "pre", "table", "ul", "dd",
402408 "dt", "frameset", "li", "tbody", "td", "tfoot",
403409 "th", "thead", "tr", "script", "style"]
404410