git.iko.soy/typeable/pandoc
on master help sign in
HTML reader: parse <main> like <div role=main>. (#3791)

* HTML reader: parse <main> like <div role=main>. * <main> closes <p> and behaves like a block element generally

commitdb55f7c1b243cbc82c70276c7dfb9c0403e369b0 authorbucklereed <horridimpfoobarbaz@chammy.info> dateWed 9 Aug 2017, 17:10 (9 years ago) parentcfa597f
2 files changed+26−7
compare with master
unifiedsplit
src/Text/Pandoc/Readers/HTML.hs+11−7 test/Tests/Readers/HTML.hs+15
src/Text/Pandoc/Readers/HTML.hs+11−7
@@ -54,7 +54,7 @@ import Text.Pandoc.Parsing hiding ((<|>))
5454import Text.Pandoc.Walk
5555import qualified Data.Map as M
5656import Data.Foldable ( for_ )
57−import Data.Maybe ( fromMaybe, isJust)
57+import Data.Maybe ( fromMaybe, isJust, isNothing )
5858import Data.List ( intercalate, isPrefixOf )
5959import Data.Char ( isDigit, isLetter, isAlphaNum )
6060import Control.Monad ( guard, mzero, void, unless )
@@ -377,6 +377,7 @@ pDiv = try $ do
377377 guardEnabled Ext_native_divs
378378 let isDivLike "div" = True
379379 isDivLike "section" = True
380+ isDivLike "main" = True
380381 isDivLike _ = False
381382 TagOpen tag attr' <- lookAhead $ pSatisfy $ tagOpen isDivLike (const True)
382383 let attr = toStringAttr attr'
@@ -385,7 +386,10 @@ pDiv = try $ do
385386 let classes' = if tag == "section"
386387 then "section":classes
387388 else classes
388− return $ B.divWith (ident, classes', kvs) contents
389+ kvs' = if tag == "main" && isNothing (lookup "role" kvs)
390+ then ("role", "main"):kvs
391+ else kvs
392+ return $ B.divWith (ident, classes', kvs') contents
389393
390394pRawHtmlBlock :: PandocMonad m => TagParser m Blocks
391395pRawHtmlBlock = do
@@ -940,7 +944,7 @@ blockHtmlTags = Set.fromList
940944 "dir", "div", "dl", "dt", "fieldset", "figcaption", "figure",
941945 "footer", "form", "h1", "h2", "h3", "h4",
942946 "h5", "h6", "head", "header", "hgroup", "hr", "html",
943− "isindex", "menu", "noframes", "ol", "output", "p", "pre",
947+ "isindex", "main", "menu", "noframes", "ol", "output", "p", "pre",
944948 "section", "table", "tbody", "textarea",
945949 "thead", "tfoot", "ul", "dd",
946950 "dt", "frameset", "li", "tbody", "td", "tfoot",
@@ -1022,10 +1026,10 @@ _ `closes` "html" = False
10221026"optgroup" `closes` "optgroup" = True
10231027"optgroup" `closes` "option" = True
10241028"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
10261030x `closes` "p" | x `elem` ["address", "article", "aside", "blockquote",
10271031 "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",
10291033 "table", "ul"] = True
10301034"meta" `closes` "meta" = True
10311035"form" `closes` "form" = True
@@ -1038,8 +1042,8 @@ t `closes` "select" | t /= "option" = True
10381042"tfoot" `closes` t | t `elem` ["thead","colgroup"] = True
10391043"tbody" `closes` t | t `elem` ["tbody","tfoot","thead","colgroup"] = True
10401044t `closes` t2 |
1041− t `elem` ["h1","h2","h3","h4","h5","h6","dl","ol","ul","table","div","p"] &&
1042− t2 `elem` ["h1","h2","h3","h4","h5","h6","p" ] = True -- not "div"
1045+ t `elem` ["h1","h2","h3","h4","h5","h6","dl","ol","ul","table","div","main","p"] &&
1046+ t2 `elem` ["h1","h2","h3","h4","h5","h6","p" ] = True -- not "div" or "main"
10431047t1 `closes` t2 |
10441048 t1 `Set.member` blockTags &&
10451049 t2 `Set.notMember` blockTags &&
test/Tests/Readers/HTML.hs+15
@@ -11,6 +11,9 @@ import Data.Text (Text)
1111html :: Text -> Pandoc
1212html = purely $ readHtml def
1313
14+htmlNativeDivs :: Text -> Pandoc
15+htmlNativeDivs = purely $ readHtml def { readerExtensions = enableExtension Ext_native_divs $ readerExtensions def }
16+
1417tests :: [TestTree]
1518tests = [ testGroup "base tag"
1619 [ test html "simple" $
@@ -36,4 +39,16 @@ tests = [ testGroup "base tag"
3639 , test html "xml:lang on <html>" $ "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"es\"><head></head><body>hola</body></html>" =?>
3740 setMeta "lang" (text "es") (doc (plain (text "hola")))
3841 ]
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+ ]
3954 ]