aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs36
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