@@ -51,7 +51,7 @@ import Data.Maybe ( fromMaybe )
5151import Data.List ( isPrefixOf, isSuffixOf, intercalate )
5252import Data.Char ( toLower, isAlphaNum )
5353import Network.URI ( parseURIReference, URI (..) )
54−import Control.Monad ( liftM )
54+import Control.Monad ( liftM, when )
5555
5656-- | Convert HTML-formatted string to 'Pandoc' document.
5757readHtml :: ParserState -- ^ Parser state
@@ -199,11 +199,11 @@ inlinesTilEnd tag = manyTill inline (htmlEndTag tag)
199199
200200-- | Parse blocks between open and close tag.
201201blocksIn :: String -> GenParser Char ParserState [Block]
202−blocksIn tag = try $ htmlTag tag >> spaces >> blocksTilEnd tag
202+blocksIn tag = try $ htmlOpenTag tag >> spaces >> blocksTilEnd tag
203203
204204-- | Parse inlines between open and close tag.
205205inlinesIn :: String -> GenParser Char ParserState [Inline]
206−inlinesIn tag = try $ htmlTag tag >> spaces >> inlinesTilEnd tag
206+inlinesIn tag = try $ htmlOpenTag tag >> spaces >> inlinesTilEnd tag
207207
208208-- | Extract type from a tag: e.g. @br@ from @\<br\>@
209209extractTagType :: String -> String
@@ -259,18 +259,33 @@ anyHtmlEndTag = try $ do
259259 then return $ "<!-- unsafe HTML removed -->"
260260 else return result
261261
262−htmlTag :: String -> GenParser Char ParserState (String, [(String, String)])
263−htmlTag tag = try $ do
262+htmlTag :: Bool
263+ -> String
264+ -> GenParser Char ParserState (String, [(String, String)])
265+htmlTag selfClosing tag = try $ do
264266 char '<'
265267 spaces
266268 stringAnyCase tag
267269 attribs <- many htmlAttribute
268270 spaces
269− optional (string "/")
270− spaces
271+ -- note: we want to handle both HTML and XHTML,
272+ -- so we don't require the /
273+ when selfClosing $ optional $ char '/' >> spaces
271274 char '>'
272275 return (tag, (map (\(name, content, _) -> (name, content)) attribs))
273276
277+htmlOpenTag :: String
278+ -> GenParser Char ParserState (String, [(String, String)])
279+htmlOpenTag = htmlTag False
280+
281+htmlCloseTag :: String
282+ -> GenParser Char ParserState (String, [(String, String)])
283+htmlCloseTag = htmlTag False . ('/':)
284+
285+htmlSelfClosingTag :: String
286+ -> GenParser Char ParserState (String, [(String, String)])
287+htmlSelfClosingTag = htmlTag True
288+
274289-- parses a quoted html attribute value
275290quoted :: Char -> GenParser Char st (String, String)
276291quoted quoteChar = do
@@ -345,7 +360,7 @@ anyHtmlInlineTag = try $ do
345360-- Scripts must be treated differently, because they can contain '<>' etc.
346361htmlScript :: GenParser Char ParserState [Char]
347362htmlScript = try $ do
348− lookAhead $ htmlTag "script"
363+ lookAhead $ htmlOpenTag "script"
349364 open <- anyHtmlTag
350365 rest <- liftM concat $ manyTill scriptChunk (htmlEndTag "script")
351366 st <- getState
@@ -380,7 +395,7 @@ scriptChunk = jsComment <|> jsString <|> jsChars
380395-- Style tags must be treated differently, because they can contain CSS
381396htmlStyle :: GenParser Char ParserState [Char]
382397htmlStyle = try $ do
383− lookAhead $ htmlTag "style"
398+ lookAhead $ htmlOpenTag "style"
384399 open <- anyHtmlTag
385400 rest <- manyTill anyChar (htmlEndTag "style")
386401 st <- getState
@@ -412,7 +427,8 @@ rawVerbatimBlock = try $ do
412427-- We don't want to parse </body> or </html> as raw HTML, since these
413428-- are handled in parseHtml.
414429rawHtmlBlock' :: GenParser Char ParserState Block
415−rawHtmlBlock' = do notFollowedBy' (htmlTag "/body" <|> htmlTag "/html")
430+rawHtmlBlock' = do notFollowedBy' (htmlCloseTag "body" <|>
431+ htmlCloseTag "html")
416432 rawHtmlBlock
417433
418434-- | Parses an HTML comment.
@@ -442,13 +458,13 @@ definition = try $ do
442458
443459nonTitleNonHead :: GenParser Char ParserState Char
444460nonTitleNonHead = try $ do
445− notFollowedBy $ (htmlTag "title" >> return ' ') <|>
461+ notFollowedBy $ (htmlOpenTag "title" >> return ' ') <|>
446462 (htmlEndTag "head" >> return ' ')
447463 (rawHtmlBlock >> return ' ') <|> anyChar
448464
449465parseTitle :: GenParser Char ParserState [Inline]
450466parseTitle = try $ do
451− (tag, _) <- htmlTag "title"
467+ (tag, _) <- htmlOpenTag "title"
452468 contents <- inlinesTilEnd tag
453469 spaces
454470 return contents
@@ -456,7 +472,7 @@ parseTitle = try $ do
456472-- parse header and return meta-information (for now, just title)
457473parseHead :: GenParser Char ParserState Meta
458474parseHead = try $ do
459− htmlTag "head"
475+ htmlOpenTag "head"
460476 spaces
461477 skipMany nonTitleNonHead
462478 contents <- option [] parseTitle
@@ -464,13 +480,10 @@ parseHead = try $ do
464480 htmlEndTag "head"
465481 return $ Meta contents [] []
466482
467−skipHtmlTag :: String -> GenParser Char ParserState ()
468−skipHtmlTag tag = optional (htmlTag tag)
469−
470483-- h1 class="title" representation of title in body
471484bodyTitle :: GenParser Char ParserState [Inline]
472485bodyTitle = try $ do
473− (_, attribs) <- htmlTag "h1"
486+ (_, attribs) <- htmlOpenTag "h1"
474487 case (extractAttribute "class" attribs) of
475488 Just "title" -> return ""
476489 _ -> fail "not title"
@@ -488,11 +501,11 @@ parseHtml :: GenParser Char ParserState Pandoc
488501parseHtml = do
489502 sepEndBy (choice [xmlDec, definition, htmlComment]) spaces
490503 spaces
491− skipHtmlTag "html"
504+ optional $ htmlOpenTag "html"
492505 spaces
493506 meta <- option (Meta [] [] []) parseHead
494507 spaces
495− skipHtmlTag "body"
508+ optional $ htmlOpenTag "body"
496509 spaces
497510 optional bodyTitle -- skip title in body, because it's represented in meta
498511 blocks <- parseBlocks
@@ -528,7 +541,7 @@ header = choice (map headerLevel (enumFromTo 1 5)) <?> "header"
528541headerLevel :: Int -> GenParser Char ParserState Block
529542headerLevel n = try $ do
530543 let level = "h" ++ show n
531− htmlTag level
544+ htmlOpenTag level
532545 contents <- inlinesTilEnd level
533546 return $ Header n (normalizeSpaces contents)
534547
@@ -538,7 +551,7 @@ headerLevel n = try $ do
538551
539552hrule :: GenParser Char ParserState Block
540553hrule = try $ do
541− (_, attribs) <- htmlTag "hr"
554+ (_, attribs) <- htmlSelfClosingTag "hr"
542555 state <- getState
543556 if not (null attribs) && stateParseRaw state
544557 then unexpected "attributes in hr" -- parse as raw in this case
@@ -552,7 +565,7 @@ hrule = try $ do
552565-- skipped, because they are not portable to output formats other than HTML.
553566codeBlock :: GenParser Char ParserState Block
554567codeBlock = try $ do
555− htmlTag "pre"
568+ htmlOpenTag "pre"
556569 result <- manyTill
557570 (many1 (satisfy (/= '<')) <|>
558571 ((anyHtmlTag <|> anyHtmlEndTag) >> return ""))
@@ -573,7 +586,7 @@ codeBlock = try $ do
573586--
574587
575588blockQuote :: GenParser Char ParserState Block
576−blockQuote = try $ htmlTag "blockquote" >> spaces >>
589+blockQuote = try $ htmlOpenTag "blockquote" >> spaces >>
577590 blocksTilEnd "blockquote" >>= (return . BlockQuote)
578591
579592--
@@ -585,7 +598,7 @@ list = choice [ bulletList, orderedList, definitionList ] <?> "list"
585598
586599orderedList :: GenParser Char ParserState Block
587600orderedList = try $ do
588− (_, attribs) <- htmlTag "ol"
601+ (_, attribs) <- htmlOpenTag "ol"
589602 (start, style) <- option (1, DefaultStyle) $
590603 do failIfStrict
591604 let sta = fromMaybe "1" $
@@ -610,7 +623,7 @@ orderedList = try $ do
610623
611624bulletList :: GenParser Char ParserState Block
612625bulletList = try $ do
613− htmlTag "ul"
626+ htmlOpenTag "ul"
614627 spaces
615628 -- note: if they have an <ol> or <ul> not in scope of a <li>,
616629 -- treat it as a list item, though it's not valid xhtml...
@@ -621,7 +634,7 @@ bulletList = try $ do
621634definitionList :: GenParser Char ParserState Block
622635definitionList = try $ do
623636 failIfStrict -- def lists not part of standard markdown
624− htmlTag "dl"
637+ htmlOpenTag "dl"
625638 spaces
626639 items <- sepEndBy1 definitionListItem spaces
627640 htmlEndTag "dl"
@@ -639,7 +652,7 @@ definitionListItem = try $ do
639652--
640653
641654para :: GenParser Char ParserState Block
642−para = try $ htmlTag "p" >> inlinesTilEnd "p" >>=
655+para = try $ htmlOpenTag "p" >> inlinesTilEnd "p" >>=
643656 return . Para . normalizeSpaces
644657
645658--
@@ -673,8 +686,8 @@ inline = choice [ charRef
673686
674687code :: GenParser Char ParserState Inline
675688code = try $ do
676− htmlTag "code"
677− result <- manyTill anyChar (htmlEndTag "code")
689+ result <- (htmlOpenTag "code" >> manyTill anyChar (htmlEndTag "code"))
690+ <|> (htmlOpenTag "tt" >> manyTill anyChar (htmlEndTag "tt"))
678691 -- remove internal line breaks, leading and trailing space,
679692 -- and decode character references
680693 return $ Code $ decodeCharacterReferences $ removeLeadingTrailingSpace $
@@ -687,7 +700,7 @@ rawHtmlInline = do
687700 if stateParseRaw state then return (HtmlInline result) else return (Str "")
688701
689702betweenTags :: [Char] -> GenParser Char ParserState [Inline]
690−betweenTags tag = try $ htmlTag tag >> inlinesTilEnd tag >>=
703+betweenTags tag = try $ htmlOpenTag tag >> inlinesTilEnd tag >>=
691704 return . normalizeSpaces
692705
693706emph :: GenParser Char ParserState Inline
@@ -709,7 +722,7 @@ strikeout = failIfStrict >> (betweenTags "s" <|> betweenTags "strike") >>=
709722spanStrikeout :: GenParser Char ParserState Inline
710723spanStrikeout = try $ do
711724 failIfStrict -- strict markdown has no strikeout, so treat as raw HTML
712− (_, attributes) <- htmlTag "span"
725+ (_, attributes) <- htmlOpenTag "span"
713726 result <- case (extractAttribute "class" attributes) of
714727 Just "strikeout" -> inlinesTilEnd "span"
715728 _ -> fail "not a strikeout"
@@ -720,7 +733,7 @@ whitespace = many1 space >> return Space
720733
721734-- hard line break
722735linebreak :: GenParser Char ParserState Inline
723−linebreak = htmlTag "br" >> optional newline >> return LineBreak
736+linebreak = htmlSelfClosingTag "br" >> optional newline >> return LineBreak
724737
725738str :: GenParser Char st Inline
726739str = many1 (noneOf "< \t\n&") >>= return . Str
@@ -741,7 +754,7 @@ extractAttribute name ((attrName, contents):rest) =
741754
742755link :: GenParser Char ParserState Inline
743756link = try $ do
744− (_, attributes) <- htmlTag "a"
757+ (_, attributes) <- htmlOpenTag "a"
745758 url <- case (extractAttribute "href" attributes) of
746759 Just url -> return url
747760 Nothing -> fail "no href"
@@ -751,7 +764,7 @@ link = try $ do
751764
752765image :: GenParser Char ParserState Inline
753766image = try $ do
754− (_, attributes) <- htmlTag "img"
767+ (_, attributes) <- htmlSelfClosingTag "img"
755768 url <- case (extractAttribute "src" attributes) of
756769 Just url -> return url
757770 Nothing -> fail "no src"