DocBook reader: support "role" attribute (#11255)

The `role` attribute is parsed and added to Pandoc AST elements,
using a wrapper Div if needed.

1 files changed, 28 insertions, 22 deletions

diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index 66128b12e..c5de8b74f 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -46,7 +46,7 @@ import Text.Pandoc.Builder
 import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
 import Text.Pandoc.Options
 import Text.Pandoc.Logging (LogMessage(..))
-import Text.Pandoc.Shared (safeRead, extractSpaces)
+import Text.Pandoc.Shared (safeRead, extractSpaces, addPandocAttributes)
 import Text.Pandoc.Sources (ToSources(..), sourcesToText)
 import Text.Pandoc.Transforms (headerShift)
 import Text.TeXMath (readMathML, writeTeX)
@@ -731,9 +731,7 @@ blockTags = Set.fromList $
   , "articleinfo"
   , "attribution"
   , "authorinitials"
-  , "bibliodiv"
   , "biblioentry"
-  , "bibliography"
   , "bibliomisc"
   , "bibliomixed"
   , "blockquote"
@@ -772,31 +770,19 @@ blockTags = Set.fromList $
   , "preface"
   , "procedure"
   , "programlisting"
-  , "qandadiv"
   , "question"
-  , "refsect1"
   , "refsect1info"
-  , "refsect2"
   , "refsect2info"
-  , "refsect3"
   , "refsect3info"
-  , "refsection"
   , "refsectioninfo"
   , "screen"
-  , "sect1"
   , "sect1info"
-  , "sect2"
   , "sect2info"
-  , "sect3"
   , "sect3info"
-  , "sect4"
   , "sect4info"
-  , "sect5"
   , "sect5info"
-  , "section"
   , "sectioninfo"
   , "simpara"
-  , "simplesect"
   , "substeps"
   , "subtitle"
   , "table"
@@ -804,7 +790,13 @@ blockTags = Set.fromList $
   , "titleabbrev"
   , "toc"
   , "variablelist"
-  ] ++ admonitionTags
+  ] ++ sectionTags ++ admonitionTags
+
+sectionTags :: [Text]
+sectionTags = ["bibliography", "bibliodiv"
+              , "sect1", "sect2", "sect3", "sect4", "sect5", "section", "simplesect"
+              , "refsect1", "refsect2", "refsect3", "refsection", "qandadiv"
+              ]
 
 admonitionTags :: [Text]
 admonitionTags = ["caution","danger","important","note","tip","warning"]
@@ -866,14 +858,19 @@ getBlocks e = do
   modify (\st -> st{ dbElementStack = drop 1 $ dbElementStack st })
   return blocks
 
+getRoleAttr :: Element -> [(Text, Text)] -- extract role attribute and add it to the attribute list
+getRoleAttr e = case attrValue "role" e of
+                  "" -> []
+                  r  -> [("role", r)]
+
 parseBlock :: PandocMonad m => Content -> DB m Blocks
 parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE
 parseBlock (Text (CData _ s _)) = if T.all isSpace s
                                      then return mempty
                                      else return $ plain $ trimInlines $ text s
 parseBlock (CRef x) = return $ plain $ str $ T.toUpper x
-parseBlock (Elem e) =
-  case qName (elName e) of
+parseBlock (Elem e) = do
+  parsedBlock <- case qName (elName e) of
         "toc"   -> skip -- skip TOC, since in pandoc it's autogenerated
         "index" -> skip -- skip index, since page numbers meaningless
         "para"  -> parseMixed para (elContent e)
@@ -985,6 +982,9 @@ parseBlock (Elem e) =
         "title" -> return mempty     -- handled in parent element
         "subtitle" -> return mempty  -- handled in parent element
         _ -> skip >> getBlocks e
+  if qName (elName e) `elem` sectionTags
+     then return parsedBlock
+     else return $ addPandocAttributes (getRoleAttr e) parsedBlock
    where skip = do
            let qn = qName $ elName e
            let name = if "pi-" `T.isPrefixOf` qn
@@ -1120,7 +1120,10 @@ parseBlock (Elem e) =
            modify $ \st -> st{ dbSectionLevel = n }
            b <- getBlocks e
            modify $ \st -> st{ dbSectionLevel = n - 1 }
-           return $ headerWith (elId, classes, maybeToList titleabbrevElAsAttr++attrs) n' headerText <> b
+           let hdr = addPandocAttributes (getRoleAttr e)
+                        $ headerWith (elId, classes, maybeToList titleabbrevElAsAttr ++ attrs)
+                                      n' headerText
+           return $ hdr <> b
          titleabbrevElAsAttr =
            case filterChild (named "titleabbrev") e `mplus`
                 (filterChild (named "info") e >>=
@@ -1143,7 +1146,7 @@ parseBlock (Elem e) =
            b <- p
            case mbt of
              Nothing -> return b
-             Just t -> return $ divWith (attrValue "id" e,[],[])
+             Just t -> return $ divWith (attrValue "id" e, [], getRoleAttr e)
                          (divWith ("", ["title"], []) (plain t) <> b)
 
          -- Admonitions are parsed into a div. Following other Docbook tools that output HTML,
@@ -1243,8 +1246,8 @@ parseInline (Text (CData _ s _)) = do
      else return $ text s
 parseInline (CRef ref) =
   return $ text $ fromMaybe (T.toUpper ref) $ lookupEntity ref
-parseInline (Elem e) =
-  case qName (elName e) of
+parseInline (Elem e) = do
+  parsedInline <- case qName (elName e) of
         "anchor" -> do
            return $ spanWith (attrValue "id" e, [], []) mempty
         "phrase" -> do
@@ -1366,6 +1369,9 @@ parseInline (Elem e) =
         -- <?asciidor-br?> to in handleInstructions, above.
         "pi-asciidoc-br" -> return linebreak
         _          -> skip >> innerInlines id
+  return $ case qName (elName e) of
+    "emphasis" -> parsedInline
+    _ -> addPandocAttributes (getRoleAttr e) parsedInline
    where skip = do
            let qn = qName $ elName e
            let name = if "pi-" `T.isPrefixOf` qn