"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "src/Text/Pandoc/Writers/JATS.hs" between
pandoc-2.11.1.1.tar.gz and pandoc-2.11.2.tar.gz

About: Pandoc converts files from one markup format into another.

JATS.hs  (pandoc-2.11.1.1):JATS.hs  (pandoc-2.11.2)
skipping to change at line 43 skipping to change at line 43
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension) import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.Logging import Text.Pandoc.Logging
import Text.Pandoc.MIME (getMimeType) import Text.Pandoc.MIME (getMimeType)
import Text.Pandoc.Walk (walk) import Text.Pandoc.Walk (walk)
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.DocLayout import Text.DocLayout
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Context(..), Val(..)) import Text.DocTemplates (Context(..), Val(..))
import Text.Pandoc.Writers.JATS.Table (tableToJATS)
import Text.Pandoc.Writers.JATS.Types
import Text.Pandoc.Writers.Math import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML import Text.Pandoc.XML
import Text.TeXMath import Text.TeXMath
import qualified Text.XML.Light as Xml import qualified Text.XML.Light as Xml
data JATSTagSet
= TagSetArchiving -- ^ Archiving and Interchange Tag Set
| TagSetPublishing -- ^ Journal Publishing Tag Set
| TagSetArticleAuthoring -- ^ Article Authoring Tag Set
deriving (Eq)
newtype JATSState = JATSState
{ jatsNotes :: [(Int, Doc Text)] }
type JATS a = StateT JATSState (ReaderT JATSTagSet a)
-- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange -- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange
-- Tag Set.) -- Tag Set.)
writeJatsArchiving :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeJatsArchiving :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsArchiving = writeJats TagSetArchiving writeJatsArchiving = writeJats TagSetArchiving
-- | Convert a @'Pandoc'@ document to JATS (Journal Publishing Tag Set.) -- | Convert a @'Pandoc'@ document to JATS (Journal Publishing Tag Set.)
writeJatsPublishing :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeJatsPublishing :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsPublishing = writeJats TagSetPublishing writeJatsPublishing = writeJats TagSetPublishing
-- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange -- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange
skipping to change at line 86 skipping to change at line 74
-- | Alias for @'writeJatsArchiving'@. This function exists for backwards -- | Alias for @'writeJatsArchiving'@. This function exists for backwards
-- compatibility, but will be deprecated in the future. Use -- compatibility, but will be deprecated in the future. Use
-- @'writeJatsArchiving'@ instead. -- @'writeJatsArchiving'@ instead.
writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJATS = writeJatsArchiving writeJATS = writeJatsArchiving
-- | Convert a @'Pandoc'@ document to JATS. -- | Convert a @'Pandoc'@ document to JATS.
writeJats :: PandocMonad m => JATSTagSet -> WriterOptions -> Pandoc -> m Text writeJats :: PandocMonad m => JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats tagSet opts d = writeJats tagSet opts d =
runReaderT (evalStateT (docToJATS opts d) runReaderT (evalStateT (docToJATS opts d) initialState)
(JATSState{ jatsNotes = [] })) environment
tagSet where initialState = JATSState { jatsNotes = [] }
environment = JATSEnv
{ jatsTagSet = tagSet
, jatsInlinesWriter = inlinesToJATS
, jatsBlockWriter = blockToJATS
}
-- | Convert Pandoc document to string in JATS format. -- | Convert Pandoc document to string in JATS format.
docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text
docToJATS opts (Pandoc meta blocks) = do docToJATS opts (Pandoc meta blocks) = do
let isBackBlock (Div ("refs",_,_) _) = True let isBackBlock (Div ("refs",_,_) _) = True
isBackBlock _ = False isBackBlock _ = False
let (backblocks, bodyblocks) = partition isBackBlock blocks let (backblocks, bodyblocks) = partition isBackBlock blocks
-- The numbering here follows LaTeX's internal numbering -- The numbering here follows LaTeX's internal numbering
let startLvl = case writerTopLevelDivision opts of let startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1 TopLevelPart -> -1
skipping to change at line 113 skipping to change at line 106
let colwidth = if writerWrapText opts == WrapAuto let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts then Just $ writerColumns opts
else Nothing else Nothing
metadata <- metaToContext opts metadata <- metaToContext opts
fromBlocks fromBlocks
(fmap chomp . inlinesToJATS opts) (fmap chomp . inlinesToJATS opts)
meta meta
main <- fromBlocks bodyblocks main <- fromBlocks bodyblocks
notes <- gets (reverse . map snd . jatsNotes) notes <- gets (reverse . map snd . jatsNotes)
backs <- fromBlocks backblocks backs <- fromBlocks backblocks
tagSet <- ask tagSet <- asks jatsTagSet
-- In the "Article Authoring" tag set, occurrence of fn-group elements -- In the "Article Authoring" tag set, occurrence of fn-group elements
-- is restricted to table footers. Footnotes have to be placed inline. -- is restricted to table footers. Footnotes have to be placed inline.
let fns = if null notes || tagSet == TagSetArticleAuthoring let fns = if null notes || tagSet == TagSetArticleAuthoring
then mempty then mempty
else inTagsIndented "fn-group" $ vcat notes else inTagsIndented "fn-group" $ vcat notes
let back = backs $$ fns let back = backs $$ fns
let date = let date =
case getField "date" metadata of case getField "date" metadata of
Nothing -> NullVal Nothing -> NullVal
Just (SimpleVal (x :: Doc Text)) -> Just (SimpleVal (x :: Doc Text)) ->
skipping to change at line 314 skipping to change at line 307
[(k,v) | (k,v) <- kvs, k `elem` ["baseline-shift", [(k,v) | (k,v) <- kvs, k `elem` ["baseline-shift",
"content-type", "specific-use", "xlink:actuate", "content-type", "specific-use", "xlink:actuate",
"xlink:href", "xlink:role", "xlink:show", "xlink:href", "xlink:role", "xlink:show",
"xlink:type"]] "xlink:type"]]
return $ selfClosingTag "graphic" attr return $ selfClosingTag "graphic" attr
blockToJATS opts (Para lst) = blockToJATS opts (Para lst) =
inTagsSimple "p" <$> inlinesToJATS opts lst inTagsSimple "p" <$> inlinesToJATS opts lst
blockToJATS opts (LineBlock lns) = blockToJATS opts (LineBlock lns) =
blockToJATS opts $ linesToPara lns blockToJATS opts $ linesToPara lns
blockToJATS opts (BlockQuote blocks) = do blockToJATS opts (BlockQuote blocks) = do
tagSet <- ask tagSet <- asks jatsTagSet
let blocksToJats' = if tagSet == TagSetArticleAuthoring let blocksToJats' = if tagSet == TagSetArticleAuthoring
then wrappedBlocksToJATS (not . isPara) then wrappedBlocksToJATS (not . isPara)
else blocksToJATS else blocksToJATS
inTagsIndented "disp-quote" <$> blocksToJats' opts blocks inTagsIndented "disp-quote" <$> blocksToJats' opts blocks
blockToJATS _ (CodeBlock a str) = return $ blockToJATS _ (CodeBlock a str) = return $
inTags False tag attr (flush (text (T.unpack $ escapeStringForXML str))) inTags False tag attr (flush (text (T.unpack $ escapeStringForXML str)))
where (lang, attr) = codeAttr a where (lang, attr) = codeAttr a
tag = if T.null lang then "preformat" else "code" tag = if T.null lang then "preformat" else "code"
blockToJATS _ (BulletList []) = return empty blockToJATS _ (BulletList []) = return empty
blockToJATS opts (BulletList lst) = blockToJATS opts (BulletList lst) =
inTags True "list" [("list-type", "bullet")] <$> inTags True "list" [("list-type", "bullet")] <$>
listItemsToJATS opts Nothing lst listItemsToJATS opts Nothing lst
blockToJATS _ (OrderedList _ []) = return empty blockToJATS _ (OrderedList _ []) = return empty
blockToJATS opts (OrderedList (start, numstyle, delimstyle) items) = do blockToJATS opts (OrderedList (start, numstyle, delimstyle) items) = do
tagSet <- ask tagSet <- asks jatsTagSet
let listType = let listType =
-- The Article Authoring tag set doesn't allow a more specific -- The Article Authoring tag set doesn't allow a more specific
-- @list-type@ attribute than "order". -- @list-type@ attribute than "order".
if tagSet == TagSetArticleAuthoring if tagSet == TagSetArticleAuthoring
then "order" then "order"
else case numstyle of else case numstyle of
DefaultStyle -> "order" DefaultStyle -> "order"
Decimal -> "order" Decimal -> "order"
Example -> "order" Example -> "order"
UpperAlpha -> "alpha-upper" UpperAlpha -> "alpha-upper"
skipping to change at line 359 skipping to change at line 352
inTags True "list" [("list-type", listType)] <$> inTags True "list" [("list-type", listType)] <$>
listItemsToJATS opts markers items listItemsToJATS opts markers items
blockToJATS opts (DefinitionList lst) = blockToJATS opts (DefinitionList lst) =
inTags True "def-list" [] <$> deflistItemsToJATS opts lst inTags True "def-list" [] <$> deflistItemsToJATS opts lst
blockToJATS _ b@(RawBlock f str) blockToJATS _ b@(RawBlock f str)
| f == "jats" = return $ text $ T.unpack str -- raw XML block | f == "jats" = return $ text $ T.unpack str -- raw XML block
| otherwise = do | otherwise = do
report $ BlockNotRendered b report $ BlockNotRendered b
return empty return empty
blockToJATS _ HorizontalRule = return empty -- not semantic blockToJATS _ HorizontalRule = return empty -- not semantic
blockToJATS opts (Table _ blkCapt specs th tb tf) = blockToJATS opts (Table attr blkCapt specs th tb tf) =
case toLegacyTable blkCapt specs th tb tf of tableToJATS opts attr blkCapt specs th tb tf
([], aligns, widths, headers, rows) -> captionlessTable aligns widths header
s rows
(caption, aligns, widths, headers, rows) -> do
captionDoc <- inTagsIndented "caption" <$> blockToJATS opts (Para caption)
tbl <- captionlessTable aligns widths headers rows
return $ inTags True "table-wrap" [] $ captionDoc $$ tbl
where
captionlessTable aligns widths headers rows = do
let percent w = tshow (truncate (100*w) :: Integer) <> "*"
let coltags = vcat $ zipWith (\w al -> selfClosingTag "col"
([("width", percent w) | w > 0] ++
[("align", alignmentToText al)])) widths aligns
thead <- if all null headers
then return empty
else inTagsIndented "thead" <$> tableRowToJATS opts True heade
rs
tbody <- inTagsIndented "tbody" . vcat <$>
mapM (tableRowToJATS opts False) rows
return $ inTags True "table" [] $ coltags $$ thead $$ tbody
alignmentToText :: Alignment -> Text
alignmentToText alignment = case alignment of
AlignLeft -> "left"
AlignRight -> "right"
AlignCenter -> "center"
AlignDefault -> "left"
tableRowToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [[Block]]
-> JATS m (Doc Text)
tableRowToJATS opts isHeader cols =
inTagsIndented "tr" . vcat <$> mapM (tableItemToJATS opts isHeader) cols
tableItemToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [Block]
-> JATS m (Doc Text)
tableItemToJATS opts isHeader [Plain item] =
inTags False (if isHeader then "th" else "td") [] <$>
inlinesToJATS opts item
tableItemToJATS opts isHeader item =
inTags False (if isHeader then "th" else "td") [] . vcat <$>
mapM (blockToJATS opts) item
-- | Convert a list of inline elements to JATS. -- | Convert a list of inline elements to JATS.
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text) inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst) inlinesToJATS opts lst = hcat <$> mapM (inlineToJATS opts) (fixCitations lst)
where where
fixCitations [] = [] fixCitations [] = []
fixCitations (x:xs) | needsFixing x = fixCitations (x:xs) | needsFixing x =
x : Str (stringify ys) : fixCitations zs x : Str (stringify ys) : fixCitations zs
where where
needsFixing (RawInline (Format "jats") z) = needsFixing (RawInline (Format "jats") z) =
skipping to change at line 461 skipping to change at line 410
| otherwise = do | otherwise = do
report $ InlineNotRendered il report $ InlineNotRendered il
return empty return empty
inlineToJATS _ LineBreak = return cr -- not allowed as child of p inlineToJATS _ LineBreak = return cr -- not allowed as child of p
-- see https://jats.nlm.nih.gov/publishing/tag-library/1.2/element/break.html -- see https://jats.nlm.nih.gov/publishing/tag-library/1.2/element/break.html
inlineToJATS _ Space = return space inlineToJATS _ Space = return space
inlineToJATS opts SoftBreak inlineToJATS opts SoftBreak
| writerWrapText opts == WrapPreserve = return cr | writerWrapText opts == WrapPreserve = return cr
| otherwise = return space | otherwise = return space
inlineToJATS opts (Note contents) = do inlineToJATS opts (Note contents) = do
tagSet <- ask tagSet <- asks jatsTagSet
-- Footnotes must occur inline when using the Article Authoring tag set. -- Footnotes must occur inline when using the Article Authoring tag set.
if tagSet == TagSetArticleAuthoring if tagSet == TagSetArticleAuthoring
then inTagsIndented "fn" <$> wrappedBlocksToJATS (not . isPara) opts content s then inTagsIndented "fn" <$> wrappedBlocksToJATS (not . isPara) opts content s
else do else do
notes <- gets jatsNotes notes <- gets jatsNotes
let notenum = case notes of let notenum = case notes of
(n, _):_ -> n + 1 (n, _):_ -> n + 1
[] -> 1 [] -> 1
thenote <- inTags True "fn" [("id","fn" <> tshow notenum)] thenote <- inTags True "fn" [("id","fn" <> tshow notenum)]
<$> wrappedBlocksToJATS (not . isPara) opts <$> wrappedBlocksToJATS (not . isPara) opts
skipping to change at line 507 skipping to change at line 456
(\e -> e{ Xml.elAttribs = map addPref (Xml.elAttribs e) }) (\e -> e{ Xml.elAttribs = map addPref (Xml.elAttribs e) })
let conf = Xml.useShortEmptyTags (const False) Xml.defaultConfigPP let conf = Xml.useShortEmptyTags (const False) Xml.defaultConfigPP
res <- convertMath writeMathML t str res <- convertMath writeMathML t str
let tagtype = case t of let tagtype = case t of
DisplayMath -> "disp-formula" DisplayMath -> "disp-formula"
InlineMath -> "inline-formula" InlineMath -> "inline-formula"
let rawtex = text "<![CDATA[" <> literal str <> text "]]>" let rawtex = text "<![CDATA[" <> literal str <> text "]]>"
let texMath = inTagsSimple "tex-math" rawtex let texMath = inTagsSimple "tex-math" rawtex
tagSet <- ask tagSet <- asks jatsTagSet
return . inTagsSimple tagtype $ return . inTagsSimple tagtype $
case res of case res of
Right r -> let mathMl = text (Xml.ppcElement conf $ fixNS r) Right r -> let mathMl = text (Xml.ppcElement conf $ fixNS r)
-- tex-math is unsupported in Article Authoring tag set -- tex-math is unsupported in Article Authoring tag set
in if tagSet == TagSetArticleAuthoring in if tagSet == TagSetArticleAuthoring
then mathMl then mathMl
else inTagsSimple "alternatives" $ else inTagsSimple "alternatives" $
cr <> texMath $$ mathMl cr <> texMath $$ mathMl
Left _ -> if tagSet /= TagSetArticleAuthoring Left _ -> if tagSet /= TagSetArticleAuthoring
then texMath then texMath
 End of changes. 9 change blocks. 
67 lines changed or deleted 17 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)