aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Readers/JATS.hs21
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs47
2 files changed, 48 insertions, 20 deletions
diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs
index fc71e9a51..851fbec35 100644
--- a/src/Text/Pandoc/Readers/JATS.hs
+++ b/src/Text/Pandoc/Readers/JATS.hs
@@ -15,6 +15,8 @@ import Text.Pandoc.Options
import Text.Pandoc.Shared (underlineSpan, crFilter, safeRead)
import Text.TeXMath (readMathML, writeTeX)
import Text.XML.Light
+import qualified Data.Set as S (fromList, member)
+import Data.Set ((\\))
type JATS m = StateT JATSState m
@@ -98,8 +100,8 @@ instance HasMeta JATSState where
deleteMeta field s = s {jatsMeta = deleteMeta field (jatsMeta s)}
isBlockElement :: Content -> Bool
-isBlockElement (Elem e) = qName (elName e) `elem` blocktags
- where blocktags = paragraphLevel ++ lists ++ mathML ++ other
+isBlockElement (Elem e) = qName (elName e) `S.member` blocktags
+ where blocktags = S.fromList (paragraphLevel ++ lists ++ mathML ++ other) \\ S.fromList inlinetags
paragraphLevel = ["address", "array", "boxed-text", "chem-struct-wrap",
"code", "fig", "fig-group", "graphic", "media", "preformat",
"supplementary-material", "table-wrap", "table-wrap-group",
@@ -108,6 +110,21 @@ isBlockElement (Elem e) = qName (elName e) `elem` blocktags
mathML = ["tex-math", "mml:math"]
other = ["p", "related-article", "related-object", "ack", "disp-quote",
"speech", "statement", "verse-group", "x"]
+ inlinetags = ["email", "ext-link", "uri", "inline-supplementary-material",
+ "related-article", "related-object", "hr", "bold", "fixed-case",
+ "italic", "monospace", "overline", "overline-start", "overline-end",
+ "roman", "sans-serif", "sc", "strike", "underline", "underline-start",
+ "underline-end", "ruby", "alternatives", "inline-graphic", "private-char",
+ "chem-struct", "inline-formula", "tex-math", "mml:math", "abbrev",
+ "milestone-end", "milestone-start", "named-content", "styled-content",
+ "fn", "target", "xref", "sub", "sup", "x", "address", "array",
+ "boxed-text", "chem-struct-wrap", "code", "fig", "fig-group", "graphic",
+ "media", "preformat", "supplementary-material", "table-wrap",
+ "table-wrap-group", "disp-formula", "disp-formula-group",
+ "citation-alternatives", "element-citation", "mixed-citation",
+ "nlm-citation", "award-id", "funding-source", "open-access",
+ "def-list", "list", "ack", "disp-quote", "speech", "statement",
+ "verse-group"]
isBlockElement _ = False
-- Trim leading and trailing newline characters
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 8824eeb24..8dda969d9 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -170,6 +170,28 @@ imageMimeType src kvs =
((drop 1 . dropWhile (/='/')) <$> mbMT)
in (maintype, subtype)
+languageFor :: [String] -> String
+languageFor classes =
+ case langs of
+ (l:_) -> escapeStringForXML l
+ [] -> ""
+ where isLang l = map toLower l `elem` map (map toLower) languages
+ langsFrom s = if isLang s
+ then [s]
+ else languagesByExtension . map toLower $ s
+ langs = concatMap langsFrom classes
+
+codeAttr :: Attr -> (String, [(String, String)])
+codeAttr (ident,classes,kvs) = (lang, attr)
+ where
+ attr = [("id",ident) | not (null ident)] ++
+ [("language",lang) | not (null lang)] ++
+ [(k,v) | (k,v) <- kvs, k `elem` ["code-type",
+ "code-version", "executable",
+ "language-version", "orientation",
+ "platforms", "position", "specific-use"]]
+ lang = languageFor classes
+
-- | Convert a Pandoc block element to JATS.
blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc
blockToJATS _ Null = return empty
@@ -233,23 +255,10 @@ blockToJATS opts (LineBlock lns) =
blockToJATS opts $ linesToPara lns
blockToJATS opts (BlockQuote blocks) =
inTagsIndented "disp-quote" <$> blocksToJATS opts blocks
-blockToJATS _ (CodeBlock (ident,classes,kvs) str) = return $
+blockToJATS _ (CodeBlock a str) = return $
inTags False tag attr (flush (text (escapeStringForXML str)))
- where attr = [("id",ident) | not (null ident)] ++
- [("language",lang) | not (null lang)] ++
- [(k,v) | (k,v) <- kvs, k `elem` ["code-type",
- "code-version", "executable",
- "language-version", "orientation",
- "platforms", "position", "specific-use"]]
- tag = if null lang then "preformat" else "code"
- lang = case langs of
- (l:_) -> escapeStringForXML l
- [] -> ""
- isLang l = map toLower l `elem` map (map toLower) languages
- langsFrom s = if isLang s
- then [s]
- else languagesByExtension . map toLower $ s
- langs = concatMap langsFrom classes
+ where (lang, attr) = codeAttr a
+ tag = if null lang then "preformat" else "code"
blockToJATS _ (BulletList []) = return empty
blockToJATS opts (BulletList lst) =
inTags True "list" [("list-type", "bullet")] <$>
@@ -346,8 +355,10 @@ inlineToJATS opts (Quoted SingleQuote lst) = do
inlineToJATS opts (Quoted DoubleQuote lst) = do
contents <- inlinesToJATS opts lst
return $ char '“' <> contents <> char '”'
-inlineToJATS _ (Code _ str) =
- return $ inTagsSimple "monospace" $ text (escapeStringForXML str)
+inlineToJATS _ (Code a str) =
+ return $ inTags False tag attr $ text (escapeStringForXML str)
+ where (lang, attr) = codeAttr a
+ tag = if null lang then "monospace" else "code"
inlineToJATS _ il@(RawInline f x)
| f == "jats" = return $ text x
| otherwise = do