fig, table-wrap & caption Divs for JATS writer
Support writing <fig> and <table-wrap> elements with <title> 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.
This commit is contained in:
Hamish Mackenzie
parent
7d23031b90
commit
ec1693505c
4 changed files with 152 additions and 6 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
119
test/Tests/Writers/JATS.hs
Normal file
119
test/Tests/Writers/JATS.hs
Normal file
|
|
@ -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></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>"
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue