From 9b5082b086359a63b92bdb40166fa59dea27afe1 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <me@michaelpj.com>
Date: Fri, 23 Aug 2019 17:13:32 +0100
Subject: docbook: richer parse for admonitions (#5593)

Fixes #1234.

This parses admonitions not as a blockquote, but rather as a div with an
appropriate class. We also handle titles for admonitions as a nested div
with the "title" class.

(I followed the behaviour of other docbook-to-html converters in this -
there are clearly other ways you could encode it.)

In general, the handling of elements with nested title elements is very
inconsistent. I think we should make it consistent, but I'm leaivng that
for later to make this a small change.

Example:
```docbook
<warning xml:id="someId">
<title>My title</title>
<simpara>An admonition block</simpara>
</warning>
```

goes to

```html
<div id="someId" class="warning">
<div class="title">My title</div>
<p>An admonition block</p>
</div>
```
---
 src/Text/Pandoc/Readers/DocBook.hs | 43 ++++++++++++++++++++++++--------------
 1 file changed, 27 insertions(+), 16 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index 9352cd938..80b7798a0 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -619,19 +619,23 @@ instance HasMeta DBState where
   deleteMeta field s = s {dbMeta = deleteMeta field (dbMeta s)}
 
 isBlockElement :: Content -> Bool
-isBlockElement (Elem e) = qName (elName e) `elem` blocktags
-  where blocktags = ["toc","index","para","formalpara","simpara",
+isBlockElement (Elem e) = qName (elName e) `elem` blockTags
+isBlockElement _ = False
+
+blockTags :: [String]
+blockTags = ["toc","index","para","formalpara","simpara",
            "ackno","epigraph","blockquote","bibliography","bibliodiv",
            "biblioentry","glossee","glosseealso","glossary",
            "glossdiv","glosslist","chapter","appendix","preface",
            "bridgehead","sect1","sect2","sect3","sect4","sect5","section",
-           "refsect1","refsect2","refsect3","refsection",
-           "important","caution","note","tip","warning","qandadiv",
+           "refsect1","refsect2","refsect3","refsection", "qandadiv",
            "question","answer","abstract","itemizedlist","orderedlist",
            "variablelist","article","book","table","informaltable",
            "informalexample", "linegroup",
-           "screen","programlisting","example","calloutlist"]
-isBlockElement _ = False
+           "screen","programlisting","example","calloutlist"] ++ admonitionTags
+
+admonitionTags :: [String]
+admonitionTags = ["important","caution","note","tip","warning"]
 
 -- Trim leading and trailing newline characters
 trimNl :: String -> String
@@ -736,16 +740,7 @@ parseBlock (Elem e) =
         "refsect2" -> sect 2
         "refsect3" -> sect 3
         "refsection" -> gets dbSectionLevel >>= sect . (+1)
-        "important" -> blockQuote . (para (strong $ str "Important") <>)
-                        <$> getBlocks e
-        "caution" -> blockQuote . (para (strong $ str "Caution") <>)
-                        <$> getBlocks e
-        "note" -> blockQuote . (para (strong $ str "Note") <>)
-                        <$> getBlocks e
-        "tip" -> blockQuote . (para (strong $ str "Tip") <>)
-                        <$> getBlocks e
-        "warning" -> blockQuote . (para (strong $ str "Warning") <>)
-                        <$> getBlocks e
+        l@_ | l `elem` admonitionTags -> parseAdmonition l
         "area" -> skip
         "areaset" -> skip
         "areaspec" -> skip
@@ -913,6 +908,22 @@ parseBlock (Elem e) =
                      modify $ \st -> st{ dbSectionLevel = n - 1 }
                      return $ headerWith (ident,[],[]) n' headerText <> b
          lineItems = mapM getInlines $ filterChildren (named "line") e
+         -- | Admonitions are parsed into a div. Following other Docbook tools that output HTML,
+         -- we parse the optional title as a div with the @title@ class, and give the
+         -- block itself a class corresponding to the admonition name.
+         parseAdmonition label = do
+           -- <title> elements can be directly nested inside an admonition block, use
+           -- it if it's there. It is unclear whether we should include the label in
+           -- the title: docbook references are ambiguous on that, and some implementations of admonitions
+           -- (e.g. asciidoctor) just use an icon in all cases. To be conservative, we don't
+           -- include the label and leave it to styling.
+           title <- case filterChild (named "title") e of
+                        Just t  -> divWith ("", ["title"], []) . plain <$> getInlines t
+                        Nothing -> return $ mempty
+           -- this will ignore the title element if it is present
+           b <- getBlocks e
+           -- we also attach the label as a class, so it can be styled properly
+           return $ divWith (attrValue "id" e,[label],[]) (title <> b)
 
 getInlines :: PandocMonad m => Element -> DB m Inlines
 getInlines e' = (trimInlines . mconcat) <$>
-- 
cgit v1.2.3