From ec1693505c65ef5dfca1df09d415f852a2787c15 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 13 Dec 2017 12:06:22 +1300 Subject: fig, table-wrap & caption Divs for JATS writer Support writing and elements with and <caption> inside them by using Divs with class set to on of fig, table-wrap or cation. The title is included as a Heading so the constraint on where Heading can occur is also relaxed. Also leaves out empty alt attributes on links. --- test/Tests/Writers/JATS.hs | 119 +++++++++++++++++++++++++++++++++++++++++++++ test/test-pandoc.hs | 2 + 2 files changed, 121 insertions(+) create mode 100644 test/Tests/Writers/JATS.hs (limited to 'test') 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>@&</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>\n\ + \" + , "unnumbered sub header" =: + headerWith ("foo",["unnumbered"],[]) 1 + (text "Header") + <> headerWith ("foo",["unnumbered"],[]) 2 + (text "Sub-Header") =?> + "\n\ + \ Header\n\ + \ \n\ + \ Sub-Header\n\ + \ \n\ + \" + , "containing image" =: + header 1 (image "imgs/foo.jpg" "" (text "Alt text")) =?> + "\n\ + \ <inline-graphic mimetype=\"image\" mime-subtype=\"jpeg\" xlink:href=\"imgs/foo.jpg\" />\n\ + \" + ] + ] + + 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 -- cgit v1.2.3 From fa0241592c0341c85246e94b5a0342ef3a301755 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Thu, 14 Dec 2017 18:38:19 +1300 Subject: Deduplicate JATS writer image mime type code --- src/Text/Pandoc/Writers/JATS.hs | 29 ++++++++++++++--------------- test/writer.jats | 2 +- 2 files changed, 15 insertions(+), 16 deletions(-) (limited to 'test') diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index fe5a36d13..8824eeb24 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -159,6 +159,17 @@ listItemToJATS opts mbmarker item = do maybe empty (\lbl -> inTagsIndented "label" (text lbl)) mbmarker $$ contents +imageMimeType :: String -> [(String, String)] -> (String, String) +imageMimeType src kvs = + let mbMT = getMimeType src + maintype = fromMaybe "image" $ + lookup "mimetype" kvs `mplus` + (takeWhile (/='/') <$> mbMT) + subtype = fromMaybe "" $ + lookup "mime-subtype" kvs `mplus` + ((drop 1 . dropWhile (/='/')) <$> mbMT) + in (maintype, subtype) + -- | Convert a Pandoc block element to JATS. blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc blockToJATS _ Null = return empty @@ -191,33 +202,21 @@ blockToJATS opts (Plain lst) = blockToJATS opts (Para lst) blockToJATS opts (Para [Image (ident,_,kvs) txt (src,'f':'i':'g':':':tit)]) = do alt <- inlinesToJATS opts txt + let (maintype, subtype) = imageMimeType src kvs let capt = if null txt then empty else inTagsSimple "caption" alt let attr = [("id", ident) | not (null ident)] ++ [(k,v) | (k,v) <- kvs, k `elem` ["fig-type", "orientation", "position", "specific-use"]] - 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 graphicattr = [("mimetype",maintype), - ("mime-subtype",drop 1 subtype), + ("mime-subtype",subtype), ("xlink:href",src), -- do we need to URL escape this? ("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 (maintype, subtype) = imageMimeType src kvs let attr = [("id", ident) | not (null ident)] ++ [("mimetype", maintype), ("mime-subtype", subtype), diff --git a/test/writer.jats b/test/writer.jats index 0f52965bc..507e9f672 100644 --- a/test/writer.jats +++ b/test/writer.jats @@ -1379,7 +1379,7 @@ These should not be escaped: \$ \\ \> \[ \{

lalune - +

Here is a movie -- cgit v1.2.3