JATS writer: use either styled-content or named-content for spans.

If the element has a content-type attribute, or at least one class, then
that value is used as `content-type` and the span is put inside a
`<named-content>` element. Otherwise a `<styled-content>` element is
used instead.

Closes: #7211

1 files changed, 26 insertions, 10 deletions

diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 0bcfa0df4..9db8723d1 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -21,12 +21,13 @@ module Text.Pandoc.Writers.JATS
   , writeJatsPublishing
   , writeJatsArticleAuthoring
   ) where
+import Control.Applicative ((<|>))
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Generics (everywhere, mkT)
 import Data.List (partition)
 import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, listToMaybe)
 import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
 import qualified Data.Text as T
 import Data.Text (Text)
@@ -449,18 +450,33 @@ inlineToJATS opts (Note contents) = do
              $ text (show notenum)
 inlineToJATS opts (Cite _ lst) =
   inlinesToJATS opts lst
-inlineToJATS opts (Span (ident,_,kvs) ils) = do
+inlineToJATS opts (Span (ident,classes,kvs) ils) = do
   contents <- inlinesToJATS opts ils
-  let attr = [("id", escapeNCName ident) | not (T.null ident)] ++
-             [("xml:lang",l) | ("lang",l) <- kvs] ++
-             [(k,v) | (k,v) <- kvs
-                    ,  k `elem` ["alt", "content-type", "rid", "specific-use",
-                                 "vocab", "vocab-identifier", "vocab-term",
-                                 "vocab-term-identifier"]]
+  let commonAttr = [("id", escapeNCName ident) | not (T.null ident)] ++
+                   [("xml:lang",l) | ("lang",l) <- kvs] ++
+                   [(k,v) | (k,v) <- kvs,  k `elem` ["alt", "specific-use"]]
+  -- A named-content element is a good fit for spans, but requires a
+  -- content-type attribute to be present. We use either the explicit
+  -- attribute or the first class as content type. If neither is
+  -- available, then we fall back to using a @styled-content@ element.
+  let (tag, specificAttr) =
+        case lookup "content-type" kvs <|> listToMaybe classes of
+          Just ct -> ( "named-content"
+                     , ("content-type", ct) :
+                       [(k, v) | (k, v) <- kvs
+                       , k `elem` ["rid", "vocab", "vocab-identifier",
+                                   "vocab-term", "vocab-term-identifier"]])
+          -- Fall back to styled-content
+          Nothing -> ("styled-content"
+                     , [(k, v) | (k,v) <- kvs
+                       , k `elem` ["style", "style-type", "style-detail",
+                                   "toggle"]])
+  let attr = commonAttr ++ specificAttr
+  -- unwrap if wrapping element would have no attributes
   return $
     if null attr
-    then contents  -- unwrap if no relevant attributes are given
-    else inTags False "named-content" attr contents
+    then contents
+    else inTags False tag attr contents
 inlineToJATS _ (Math t str) = do
   let addPref (Xml.Attr q v)
          | Xml.qName q == "xmlns" = Xml.Attr q{ Xml.qName = "xmlns:mml" } v