db55f7c · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

HTML reader: parse <main> like <div role=main>. (#3791)

db55f7cbucklereed9 years ago

src/Text/Pandoc/Readers/HTML.hs+11−7

compare with master

unifiedsplit

@@ -54,7 +54,7 @@ import Text.Pandoc.Parsing hiding ((<|>))

54import Text.Pandoc.Walk

55import qualified Data.Map as M

56import Data.Foldable ( for_ )

57−import Data.Maybe ( fromMaybe, isJust)

57+import Data.Maybe ( fromMaybe, isJust, isNothing )

58import Data.List ( intercalate, isPrefixOf )

59import Data.Char ( isDigit, isLetter, isAlphaNum )

60import Control.Monad ( guard, mzero, void, unless )

@@ -377,6 +377,7 @@ pDiv = try $ do

377 guardEnabled Ext_native_divs

378 let isDivLike "div" = True

379 isDivLike "section" = True

380+ isDivLike "main" = True

380 isDivLike _ = False

381 isDivLike _ = False

381 TagOpen tag attr' <- lookAhead $ pSatisfy $ tagOpen isDivLike (const True)

382 TagOpen tag attr' <- lookAhead $ pSatisfy $ tagOpen isDivLike (const True)

382 let attr = toStringAttr attr'

383 let attr = toStringAttr attr'

@@ -385,7 +386,10 @@ pDiv = try $ do

385 let classes' = if tag == "section"

386 let classes' = if tag == "section"

386 then "section":classes

387 then "section":classes

387 else classes

388 else classes

389+ kvs' = if tag == "main" && isNothing (lookup "role" kvs)

390+ then ("role", "main"):kvs

391+ else kvs

388− return $ B.divWith (ident, classes', kvs) contents

392+ return $ B.divWith (ident, classes', kvs') contents

389

393

390pRawHtmlBlock :: PandocMonad m => TagParser m Blocks

394pRawHtmlBlock :: PandocMonad m => TagParser m Blocks

391pRawHtmlBlock = do

395pRawHtmlBlock = do

@@ -940,7 +944,7 @@ blockHtmlTags = Set.fromList

940 "dir", "div", "dl", "dt", "fieldset", "figcaption", "figure",

944 "dir", "div", "dl", "dt", "fieldset", "figcaption", "figure",

941 "footer", "form", "h1", "h2", "h3", "h4",

945 "footer", "form", "h1", "h2", "h3", "h4",

942 "h5", "h6", "head", "header", "hgroup", "hr", "html",

946 "h5", "h6", "head", "header", "hgroup", "hr", "html",

943− "isindex", "menu", "noframes", "ol", "output", "p", "pre",

947+ "isindex", "main", "menu", "noframes", "ol", "output", "p", "pre",

944 "section", "table", "tbody", "textarea",

948 "section", "table", "tbody", "textarea",

945 "thead", "tfoot", "ul", "dd",

949 "thead", "tfoot", "ul", "dd",

946 "dt", "frameset", "li", "tbody", "td", "tfoot",

950 "dt", "frameset", "li", "tbody", "td", "tfoot",

@@ -1022,10 +1026,10 @@ _ `closes` "html" = False

1022"optgroup" `closes` "optgroup" = True

1026"optgroup" `closes` "optgroup" = True

1023"optgroup" `closes` "option" = True

1027"optgroup" `closes` "option" = True

1024"option" `closes` "option" = True

1028"option" `closes` "option" = True

1025−-- http://www.w3.org/TR/html-markup/p.html

1029+-- https://html.spec.whatwg.org/multipage/syntax.html#optional-tags

1026x `closes` "p" | x `elem` ["address", "article", "aside", "blockquote",

1030x `closes` "p" | x `elem` ["address", "article", "aside", "blockquote",

1027 "dir", "div", "dl", "fieldset", "footer", "form", "h1", "h2", "h3", "h4",

1031 "dir", "div", "dl", "fieldset", "footer", "form", "h1", "h2", "h3", "h4",

1028− "h5", "h6", "header", "hr", "menu", "nav", "ol", "p", "pre", "section",

1032+ "h5", "h6", "header", "hr", "main", "menu", "nav", "ol", "p", "pre", "section",

1029 "table", "ul"] = True

1033 "table", "ul"] = True

1030"meta" `closes` "meta" = True

1034"meta" `closes` "meta" = True

1031"form" `closes` "form" = True

1035"form" `closes` "form" = True

@@ -1038,8 +1042,8 @@ t `closes` "select" | t /= "option" = True

1038"tfoot" `closes` t | t `elem` ["thead","colgroup"] = True

1042"tfoot" `closes` t | t `elem` ["thead","colgroup"] = True

1039"tbody" `closes` t | t `elem` ["tbody","tfoot","thead","colgroup"] = True

1043"tbody" `closes` t | t `elem` ["tbody","tfoot","thead","colgroup"] = True

1040t `closes` t2 |

1044t `closes` t2 |

1041− t `elem` ["h1","h2","h3","h4","h5","h6","dl","ol","ul","table","div","p"] &&

1045+ t `elem` ["h1","h2","h3","h4","h5","h6","dl","ol","ul","table","div","main","p"] &&

1042− t2 `elem` ["h1","h2","h3","h4","h5","h6","p" ] = True -- not "div"

1046+ t2 `elem` ["h1","h2","h3","h4","h5","h6","p" ] = True -- not "div" or "main"

1043t1 `closes` t2 |

1047t1 `closes` t2 |

1044 t1 `Set.member` blockTags &&

1048 t1 `Set.member` blockTags &&

1045 t2 `Set.notMember` blockTags &&

1049 t2 `Set.notMember` blockTags &&

test/Tests/Readers/HTML.hs+15

@@ -11,6 +11,9 @@ import Data.Text (Text)

11html :: Text -> Pandoc

12html = purely $ readHtml def

14+htmlNativeDivs :: Text -> Pandoc

15+htmlNativeDivs = purely $ readHtml def { readerExtensions = enableExtension Ext_native_divs $ readerExtensions def }

16+

14tests :: [TestTree]

17tests :: [TestTree]

15tests = [ testGroup "base tag"

18tests = [ testGroup "base tag"

16 [ test html "simple" $

19 [ test html "simple" $

@@ -36,4 +39,16 @@ tests = [ testGroup "base tag"

36 , test html "xml:lang on <html>" $ "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"es\"><head></head><body>hola</body></html>" =?>

39 , test html "xml:lang on <html>" $ "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"es\"><head></head><body>hola</body></html>" =?>

37 setMeta "lang" (text "es") (doc (plain (text "hola")))

40 setMeta "lang" (text "es") (doc (plain (text "hola")))

38 ]

41 ]

42+ , testGroup "main"

43+ [ test htmlNativeDivs "<main> becomes <div role=main>" $ "<main>hello</main>" =?>

44+ doc (divWith ("", [], [("role", "main")]) (plain (text "hello")))

45+ , test htmlNativeDivs "<main role=X> becomes <div role=X>" $ "<main role=foobar>hello</main>" =?>

46+ doc (divWith ("", [], [("role", "foobar")]) (plain (text "hello")))

47+ , test htmlNativeDivs "<main> has attributes preserved" $ "<main id=foo class=bar data-baz=qux>hello</main>" =?>

48+ doc (divWith ("foo", ["bar"], [("role", "main"), ("data-baz", "qux")]) (plain (text "hello")))

49+ , test htmlNativeDivs "<main> closes <p>" $ "<p>hello<main>main content</main>" =?>

50+ doc (para (text "hello") <> divWith ("", [], [("role", "main")]) (plain (text "main content")))

51+ , test htmlNativeDivs "<main> followed by text" $ "<main>main content</main>non-main content" =?>

52+ doc (divWith ("", [], [("role", "main")]) (plain (text "main content")) <> plain (text "non-main content"))

53+ ]

39 ]

54 ]