diff options
| author | Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> | 2017-12-20 23:55:48 +1300 |
|---|---|---|
| committer | Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> | 2017-12-22 15:24:54 +1300 |
| commit | d85357139748ea657f030ab314c39e70f56764f4 (patch) | |
| tree | c85eaa9f1762ed93d6bc51ee050eb1e599061f03 /src/Text/Pandoc/Writers/JATS.hs | |
| parent | 5d3c9e56460165be452b672f12fc476e7a5ed3a9 (diff) | |
Improve support for code language in JATS
Diffstat (limited to 'src/Text/Pandoc/Writers/JATS.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/JATS.hs | 47 |
1 files changed, 29 insertions, 18 deletions
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 |