aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--pandoc.cabal1
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs36
-rw-r--r--test/Tests/Writers/JATS.hs119
-rw-r--r--test/test-pandoc.hs2
4 files changed, 152 insertions, 6 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index fa02ebfd9..63f20122c 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -635,6 +635,7 @@ test-suite test-pandoc
Tests.Writers.ConTeXt
Tests.Writers.Docbook
Tests.Writers.HTML
+ Tests.Writers.JATS
Tests.Writers.Markdown
Tests.Writers.Org
Tests.Writers.Plain
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 0ac37efba..fe5a36d13 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -168,6 +168,13 @@ blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) =
blockToJATS opts (Div ("refs",_,_) xs) = do
contents <- blocksToJATS opts xs
return $ inTagsIndented "ref-list" contents
+blockToJATS opts (Div (ident,[cls],kvs) bs) | cls `elem` ["fig", "caption", "table-wrap"] = do
+ contents <- blocksToJATS opts bs
+ let attr = [("id", ident) | not (null ident)] ++
+ [("xml:lang",l) | ("lang",l) <- kvs] ++
+ [(k,v) | (k,v) <- kvs, k `elem` ["specific-use",
+ "content-type", "orientation", "position"]]
+ return $ inTags True cls attr contents
blockToJATS opts (Div (ident,_,kvs) bs) = do
contents <- blocksToJATS opts bs
let attr = [("id", ident) | not (null ident)] ++
@@ -175,10 +182,9 @@ blockToJATS opts (Div (ident,_,kvs) bs) = do
[(k,v) | (k,v) <- kvs, k `elem` ["specific-use",
"content-type", "orientation", "position"]]
return $ inTags True "boxed-text" attr contents
-blockToJATS _ h@(Header{}) = do
- -- should not occur after hierarchicalize, except inside lists/blockquotes
- report $ BlockNotRendered h
- return empty
+blockToJATS opts (Header _ _ title) = do
+ title' <- inlinesToJATS opts title
+ return $ inTagsSimple "title" title'
-- No Plain, everything needs to be in a block-level tag
blockToJATS opts (Plain lst) = blockToJATS opts (Para lst)
-- title beginning with fig: indicates that the image is a figure
@@ -204,6 +210,24 @@ blockToJATS opts (Para [Image (ident,_,kvs) txt
("xlink:title",tit)]
return $ inTags True "fig" attr $
capt $$ selfClosingTag "graphic" graphicattr
+blockToJATS _ (Para [Image (ident,_,kvs) _ (src, tit)]) = do
+ let mbMT = getMimeType src
+ let maintype = fromMaybe "image" $
+ lookup "mimetype" kvs `mplus`
+ (takeWhile (/='/') <$> mbMT)
+ let subtype = fromMaybe "" $
+ lookup "mime-subtype" kvs `mplus`
+ ((drop 1 . dropWhile (/='/')) <$> mbMT)
+ let attr = [("id", ident) | not (null ident)] ++
+ [("mimetype", maintype),
+ ("mime-subtype", subtype),
+ ("xlink:href", src)] ++
+ [("xlink:title", tit) | not (null tit)] ++
+ [(k,v) | (k,v) <- kvs, k `elem` ["baseline-shift",
+ "content-type", "specific-use", "xlink:actuate",
+ "xlink:href", "xlink:role", "xlink:show",
+ "xlink:type"]]
+ return $ selfClosingTag "graphic" attr
blockToJATS opts (Para lst) =
inTagsIndented "p" <$> inlinesToJATS opts lst
blockToJATS opts (LineBlock lns) =
@@ -379,8 +403,8 @@ inlineToJATS _ (Link _attr [Str t] ('m':'a':'i':'l':'t':'o':':':email, _))
return $ inTagsSimple "email" $ text (escapeStringForXML email)
inlineToJATS opts (Link (ident,_,kvs) txt ('#':src, _)) = do
let attr = [("id", ident) | not (null ident)] ++
- [("alt", stringify txt),
- ("rid", src)] ++
+ [("alt", stringify txt) | not (null txt)] ++
+ [("rid", src)] ++
[(k,v) | (k,v) <- kvs, k `elem` ["ref-type", "specific-use"]]
contents <- inlinesToJATS opts txt
return $ inTags False "xref" attr contents
diff --git a/test/Tests/Writers/JATS.hs b/test/Tests/Writers/JATS.hs
new file mode 100644
index 000000000..cd4609849
--- /dev/null
+++ b/test/Tests/Writers/JATS.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.Writers.JATS (tests) where
+
+import Data.Text (unpack)
+import Test.Tasty
+import Tests.Helpers
+import Text.Pandoc
+import Text.Pandoc.Arbitrary ()
+import Text.Pandoc.Builder
+
+jats :: (ToPandoc a) => a -> String
+jats = unpack . purely (writeJATS def{ writerWrapText = WrapNone }) . toPandoc
+
+{-
+ "my test" =: X =?> Y
+
+is shorthand for
+
+ test jats "my test" $ X =?> Y
+
+which is in turn shorthand for
+
+ test jats "my test" (X,Y)
+-}
+
+infix 4 =:
+(=:) :: (ToString a, ToPandoc a)
+ => String -> (a, String) -> TestTree
+(=:) = test jats
+
+tests :: [TestTree]
+tests = [ testGroup "inline code"
+ [ "basic" =: code "@&" =?> "<p>\n <monospace>@&amp;</monospace>\n</p>"
+ ]
+ , testGroup "images"
+ [ "basic" =:
+ image "/url" "title" mempty
+ =?> "<graphic mimetype=\"image\" mime-subtype=\"\" xlink:href=\"/url\" xlink:title=\"title\" />"
+ ]
+ , testGroup "inlines"
+ [ "Emphasis" =: emph ("emphasized")
+ =?> "<p>\n <italic>emphasized</italic>\n</p>"
+ ]
+ , "bullet list" =: bulletList [ plain $ text "first"
+ , plain $ text "second"
+ , plain $ text "third"
+ ]
+ =?> "<list list-type=\"bullet\">\n\
+ \ <list-item>\n\
+ \ <p>\n\
+ \ first\n\
+ \ </p>\n\
+ \ </list-item>\n\
+ \ <list-item>\n\
+ \ <p>\n\
+ \ second\n\
+ \ </p>\n\
+ \ </list-item>\n\
+ \ <list-item>\n\
+ \ <p>\n\
+ \ third\n\
+ \ </p>\n\
+ \ </list-item>\n\
+ \</list>"
+ , testGroup "definition lists"
+ [ "with internal link" =: definitionList [(link "#go" "" (str "testing"),
+ [plain (text "hi there")])] =?>
+ "<def-list>\n\
+ \ <def-item>\n\
+ \ <term>\n\
+ \ <xref alt=\"testing\" rid=\"go\">testing</xref>\n\
+ \ </term>\n\
+ \ <def>\n\
+ \ <p>\n\
+ \ hi there\n\
+ \ </p>\n\
+ \ </def>\n\
+ \ </def-item>\n\
+ \</def-list>"
+ ]
+ , testGroup "math"
+ [ "escape |" =: para (math "\\sigma|_{\\{x\\}}") =?>
+ "<p>\n\
+ \ <inline-formula><alternatives>\n\
+ \ <tex-math><![CDATA[\\sigma|_{\\{x\\}}]]></tex-math>\n\
+ \ <mml:math display=\"inline\" xmlns:mml=\"http://www.w3.org/1998/Math/MathML\"><mml:mrow><mml:mi>σ</mml:mi><mml:msub><mml:mo stretchy=\"false\" form=\"prefix\">|</mml:mo><mml:mrow><mml:mo stretchy=\"false\" form=\"prefix\">{</mml:mo><mml:mi>x</mml:mi><mml:mo stretchy=\"false\" form=\"postfix\">}</mml:mo></mml:mrow></mml:msub></mml:mrow></mml:math></alternatives></inline-formula>\n\
+ \</p>"
+ ]
+ , testGroup "headers"
+ [ "unnumbered header" =:
+ headerWith ("foo",["unnumbered"],[]) 1
+ (text "Header 1" <> note (plain $ text "note")) =?>
+ "<sec id=\"foo\">\n\
+ \ <title>Header 1<fn>\n\
+ \ <p>\n\
+ \ note\n\
+ \ </p>\n\
+ \ </fn></title>\n\
+ \</sec>"
+ , "unnumbered sub header" =:
+ headerWith ("foo",["unnumbered"],[]) 1
+ (text "Header")
+ <> headerWith ("foo",["unnumbered"],[]) 2
+ (text "Sub-Header") =?>
+ "<sec id=\"foo\">\n\
+ \ <title>Header</title>\n\
+ \ <sec id=\"foo\">\n\
+ \ <title>Sub-Header</title>\n\
+ \ </sec>\n\
+ \</sec>"
+ , "containing image" =:
+ header 1 (image "imgs/foo.jpg" "" (text "Alt text")) =?>
+ "<sec>\n\
+ \ <title><inline-graphic mimetype=\"image\" mime-subtype=\"jpeg\" xlink:href=\"imgs/foo.jpg\" /></title>\n\
+ \</sec>"
+ ]
+ ]
+
+
diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs
index e1ce1bc70..123434411 100644
--- a/test/test-pandoc.hs
+++ b/test/test-pandoc.hs
@@ -25,6 +25,7 @@ import qualified Tests.Writers.Docbook
import qualified Tests.Writers.Docx
import qualified Tests.Writers.FB2
import qualified Tests.Writers.HTML
+import qualified Tests.Writers.JATS
import qualified Tests.Writers.LaTeX
import qualified Tests.Writers.Markdown
import qualified Tests.Writers.Muse
@@ -44,6 +45,7 @@ tests = testGroup "pandoc tests" [ Tests.Command.tests
, testGroup "ConTeXt" Tests.Writers.ConTeXt.tests
, testGroup "LaTeX" Tests.Writers.LaTeX.tests
, testGroup "HTML" Tests.Writers.HTML.tests
+ , testGroup "JATS" Tests.Writers.JATS.tests
, testGroup "Docbook" Tests.Writers.Docbook.tests
, testGroup "Markdown" Tests.Writers.Markdown.tests
, testGroup "Org" Tests.Writers.Org.tests