diff options
| author | John MacFarlane <jgm@berkeley.edu> | 2017-12-21 23:16:03 -0700 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2017-12-21 23:16:03 -0700 |
| commit | af048816555046d83f2cc4813d61e0430321476e (patch) | |
| tree | 2a36019c921f30506611ffa417b777744efa1c58 /src/Text/Pandoc/Writers/JATS.hs | |
| parent | 32f9dbbae5e3e1cce43d372db5564da378947388 (diff) | |
| parent | d85357139748ea657f030ab314c39e70f56764f4 (diff) | |
Merge pull request #4177 from stencila/jats-xml-reader
Add Basic JATS reader based on DocBook reader
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 901bcb646..e9e380a6c 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")] <$> @@ -349,8 +358,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 |