{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.JATS
   Copyright   : 2017-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to JATS XML.
Reference:
https://jats.nlm.nih.gov/publishing/tag-library
-}
module Text.Pandoc.Writers.JATS
  ( writeJATS
  , writeJatsArchiving
  , writeJatsPublishing
  , writeJatsArticleAuthoring
  ) where
import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Data.Generics (everywhere, mkT)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.Citeproc (getReferences)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.Logging
import Text.Pandoc.MIME (getMimeType)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Context(..), Val(..))
import Text.Pandoc.Writers.JATS.References (referencesToJATS)
import Text.Pandoc.Writers.JATS.Table (tableToJATS)
import Text.Pandoc.Writers.JATS.Types
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import qualified Text.XML.Light as Xml

-- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange
-- Tag Set.)
writeJatsArchiving :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsArchiving :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArchiving = forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
TagSetArchiving

-- | Convert a @'Pandoc'@ document to JATS (Journal Publishing Tag Set.)
writeJatsPublishing :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsPublishing :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsPublishing = forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
TagSetPublishing

-- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange
-- Tag Set.)
writeJatsArticleAuthoring :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsArticleAuthoring :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArticleAuthoring = forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
TagSetArticleAuthoring

-- | Alias for @'writeJatsArchiving'@. This function exists for backwards
-- compatibility, but will be deprecated in the future. Use
-- @'writeJatsArchiving'@ instead.
{-# DEPRECATED writeJATS "Use writeJatsArchiving instead" #-}
writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJATS = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArchiving

-- | Convert a @'Pandoc'@ document to JATS.
writeJats :: PandocMonad m => JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats :: forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
tagSet WriterOptions
opts Pandoc
d = do
  [Reference Inlines]
refs <- if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_element_citations forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions WriterOptions
opts
          then forall (m :: * -> *).
PandocMonad m =>
Maybe Locale -> Pandoc -> m [Reference Inlines]
getReferences forall a. Maybe a
Nothing Pandoc
d
          else forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  let environment :: JATSEnv m
environment = JATSEnv
          { jatsTagSet :: JATSTagSet
jatsTagSet = JATSTagSet
tagSet
          , jatsInlinesWriter :: WriterOptions -> [Inline] -> JATS m (Doc Text)
jatsInlinesWriter = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS
          , jatsBlockWriter :: (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
jatsBlockWriter = forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS
          , jatsReferences :: [Reference Inlines]
jatsReferences = [Reference Inlines]
refs
          }
  let initialState :: JATSState
initialState = JATSState { jatsNotes :: [(Int, Doc Text)]
jatsNotes = [] }
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> JATS m Text
docToJATS WriterOptions
opts Pandoc
d) JATSState
initialState)
             JATSEnv m
environment

-- see #9017 for motivation
ensureReferenceHeader :: [Block] -> [Block]
ensureReferenceHeader :: [Block] -> [Block]
ensureReferenceHeader [] = []
ensureReferenceHeader (h :: Block
h@(Header{}):refs :: Block
refs@(Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_) : [Block]
xs) =
  Block
hforall a. a -> [a] -> [a]
:Block
refsforall a. a -> [a] -> [a]
:[Block]
xs
ensureReferenceHeader (refs :: Block
refs@(Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_) : [Block]
xs) =
  Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
Header Int
1 (Text, [Text], [(Text, Text)])
nullAttr forall a. Monoid a => a
mempty forall a. a -> [a] -> [a]
: Block
refs forall a. a -> [a] -> [a]
: [Block]
xs
ensureReferenceHeader (Block
x:[Block]
xs) = Block
x forall a. a -> [a] -> [a]
:[Block] -> [Block]
ensureReferenceHeader [Block]
xs

-- | Convert Pandoc document to string in JATS format.
docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text
docToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> JATS m Text
docToJATS WriterOptions
opts (Pandoc Meta
meta [Block]
blocks') = do
  -- The numbering here follows LaTeX's internal numbering
  let startLvl :: Int
startLvl = case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts of
                   TopLevelDivision
TopLevelPart    -> -Int
1
                   TopLevelDivision
TopLevelChapter -> Int
0
                   TopLevelDivision
TopLevelSection -> Int
1
                   TopLevelDivision
TopLevelDefault -> Int
1
  let blocks :: [Block]
blocks = Bool -> Maybe Int -> [Block] -> [Block]
makeSections (WriterOptions -> Bool
writerNumberSections WriterOptions
opts) (forall a. a -> Maybe a
Just Int
startLvl)
                  forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
ensureReferenceHeader [Block]
blocks'
  let splitBackBlocks :: Block -> ([Block], [Block]) -> ([Block], [Block])
splitBackBlocks b :: Block
b@(Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_) ([Block]
fs, [Block]
bs) = ([Block]
fs, Block
bforall a. a -> [a] -> [a]
:[Block]
bs)
      splitBackBlocks (Div (Text
ident,(Text
"section":[Text]
_),[(Text, Text)]
_)
                               [ Header Int
lev (Text
_,[Text]
hcls,[(Text, Text)]
hkvs) [Inline]
hils
                               , (Div rattrs :: (Text, [Text], [(Text, Text)])
rattrs@(Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
rs)
                               ]) ([Block]
fs, [Block]
bs)
                       = ([Block]
fs, (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
rattrs
                               (Int -> (Text, [Text], [(Text, Text)]) -> [Inline] -> Block
Header Int
lev (Text
ident,[Text]
hcls,[(Text, Text)]
hkvs) [Inline]
hils forall a. a -> [a] -> [a]
: [Block]
rs) forall a. a -> [a] -> [a]
: [Block]
bs)
      splitBackBlocks Block
b ([Block]
fs, [Block]
bs) = (Block
bforall a. a -> [a] -> [a]
:[Block]
fs, [Block]
bs)
  let ([Block]
bodyblocks, [Block]
backblocks) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Block -> ([Block], [Block]) -> ([Block], [Block])
splitBackBlocks ([],[]) [Block]
blocks
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
  Context Text
metadata <- forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                 (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts)
                 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Doc a -> Doc a
chomp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts)
                 Meta
meta
  Doc Text
main <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
bodyblocks
  [Doc Text]
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. JATSState -> [(Int, Doc Text)]
jatsNotes)
  Doc Text
backs <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
backblocks
  JATSTagSet
tagSet <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
  -- In the "Article Authoring" tag set, occurrence of fn-group elements
  -- is restricted to table footers. Footnotes have to be placed inline.
  let fns :: Doc Text
fns = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
notes Bool -> Bool -> Bool
|| JATSTagSet
tagSet forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
            then forall a. Monoid a => a
mempty
            else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"fn-group" forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat [Doc Text]
notes
  let back :: Doc Text
back = Doc Text
backs forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
fns
  let date :: Val Text
date =
        case forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"date" Context Text
metadata of
          Maybe (Val Text)
Nothing -> forall a. Val a
NullVal
          Just (SimpleVal (Doc Text
x :: Doc Text)) ->
             case Text -> Maybe Day
parseDate (forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing Doc Text
x) of
               Maybe Day
Nothing  -> forall a. Val a
NullVal
               Just Day
day ->
                 let (Year
y,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
day
                 in  forall a. Context a -> Val a
MapVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Map Text (Val a) -> Context a
Context forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                      [(Text
"year" :: Text, forall a. Doc a -> Val a
SimpleVal forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Year
y)
                      ,(Text
"month", forall a. Doc a -> Val a
SimpleVal forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
m)
                      ,(Text
"day", forall a. Doc a -> Val a
SimpleVal forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
d)
                      ,(Text
"iso-8601", forall a. Doc a -> Val a
SimpleVal forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$
                            forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F" Day
day)
                      ]
          Just Val Text
x -> Val Text
x
  Doc Text
title' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
fixLineBreak
               (Text -> Meta -> [Inline]
lookupMetaInlines Text
"title" Meta
meta)
  let context :: Context Text
context = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"back" Doc Text
back
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"title" Doc Text
title'
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"date" Val Text
date
              forall a b. (a -> b) -> a -> b
$ forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathml" (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
                                        HTMLMathMethod
MathML -> Bool
True
                                        HTMLMathMethod
_      -> Bool
False) Context Text
metadata
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
    (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Maybe (Template Text)
Nothing  -> Doc Text
main
       Just Template Text
tpl -> forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Convert a list of Pandoc blocks to JATS.
blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS = forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (forall a b. a -> b -> a
const Bool
False)

-- | Like @'blocksToJATS'@, but wraps top-level blocks into a @<p>@
-- element if the @needsWrap@ predicate evaluates to @True@.
wrappedBlocksToJATS :: PandocMonad m
                    => (Block -> Bool)
                    -> WriterOptions
                    -> [Block]
                    -> JATS m (Doc Text)
wrappedBlocksToJATS :: forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS Block -> Bool
needsWrap WriterOptions
opts =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
wrappedBlockToJATS
  where
    wrappedBlockToJATS :: Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
wrappedBlockToJATS Block
b = do
      Doc Text
inner <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts Block
b
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        if Block -> Bool
needsWrap Block
b
           then forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"p" [(Text
"specific-use",Text
"wrapper")] Doc Text
inner
           else Doc Text
inner

-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara Block
x         = Block
x

-- | Convert a list of pairs of terms and definitions into a list of
-- JATS varlistentrys.
deflistItemsToJATS :: PandocMonad m
                   => WriterOptions
                   -> [([Inline],[[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS WriterOptions
opts [([Inline], [[Block]])]
items =
  forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS WriterOptions
opts)) [([Inline], [[Block]])]
items

-- | Convert a term and a list of blocks into a JATS varlistentry.
deflistItemToJATS :: PandocMonad m
                  => WriterOptions
                  -> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS WriterOptions
opts [Inline]
term [[Block]]
defs = do
  Doc Text
term' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
term
  Doc Text
def' <- forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara)
              WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
demoteHeaderAndRefs forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
defs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"def-item" forall a b. (a -> b) -> a -> b
$
      forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"term" Doc Text
term' forall a. Doc a -> Doc a -> Doc a
$$
      forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"def" Doc Text
def'

-- | Convert a list of lists of blocks to a list of JATS list items.
listItemsToJATS :: PandocMonad m
                => WriterOptions
                -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS WriterOptions
opts Maybe [Text]
markers [[Block]]
items =
  case Maybe [Text]
markers of
       Maybe [Text]
Nothing -> forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS WriterOptions
opts forall a. Maybe a
Nothing) [[Block]]
items
       Just [Text]
ms -> forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS WriterOptions
opts) (forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Maybe a
Just [Text]
ms) [[Block]]
items

-- | Convert a list of blocks into a JATS list item.
listItemToJATS :: PandocMonad m
               => WriterOptions
               -> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS WriterOptions
opts Maybe Text
mbmarker [Block]
item = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isParaOrList) WriterOptions
opts
                 (forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
demoteHeaderAndRefs [Block]
item)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"list-item" forall a b. (a -> b) -> a -> b
$
           forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Doc a
empty (forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"label" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasChars a => String -> Doc a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Maybe Text
mbmarker
           forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents

languageFor :: WriterOptions -> [Text] -> Text
languageFor :: WriterOptions -> [Text] -> Text
languageFor WriterOptions
opts [Text]
classes =
  case [Text]
langs of
     (Text
l:[Text]
_) -> Text -> Text
escapeStringForXML Text
l
     []    -> Text
""
    where
          syntaxMap :: SyntaxMap
syntaxMap = WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts
          isLang :: Text -> Bool
isLang Text
l    = Text -> Text
T.toLower Text
l forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower (SyntaxMap -> [Text]
languages SyntaxMap
syntaxMap)
          langsFrom :: Text -> [Text]
langsFrom Text
s = if Text -> Bool
isLang Text
s
                           then [Text
s]
                           else (SyntaxMap -> Text -> [Text]
languagesByExtension SyntaxMap
syntaxMap) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text
s
          langs :: [Text]
langs       = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
langsFrom [Text]
classes

codeAttr :: WriterOptions -> Attr -> (Text, [(Text, Text)])
codeAttr :: WriterOptions
-> (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr WriterOptions
opts (Text
ident,[Text]
classes,[(Text, Text)]
kvs) = (Text
lang, [(Text, Text)]
attr)
    where
       attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] forall a. [a] -> [a] -> [a]
++
              [(Text
"language",Text
lang) | Bool -> Bool
not (Text -> Bool
T.null Text
lang)] forall a. [a] -> [a] -> [a]
++
              [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"code-type",
                Text
"code-version", Text
"executable",
                Text
"language-version", Text
"orientation",
                    Text
"platforms", Text
"position", Text
"specific-use"]]
       lang :: Text
lang  = WriterOptions -> [Text] -> Text
languageFor WriterOptions
opts [Text]
classes

-- <break/> is only allowed as a direct child of <td> or <title> or
-- <article-title>
fixLineBreak :: Inline -> Inline
fixLineBreak :: Inline -> Inline
fixLineBreak Inline
LineBreak = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"jats") Text
"<break/>"
fixLineBreak Inline
x = Inline
x

-- | Convert a Pandoc block element to JATS.
blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
kvs) (Header Int
_lvl (Text
_,[Text]
_,[(Text, Text)]
hkvs) [Inline]
ils : [Block]
xs)) = do
  let idAttr :: [(Text, Text)]
idAttr = [ (Text
"id", WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeNCName Text
id')
               | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
  let otherAttrs :: [Text]
otherAttrs = [Text
"sec-type", Text
"specific-use"]
  let attribs :: [(Text, Text)]
attribs = [(Text, Text)]
idAttr forall a. [a] -> [a] -> [a]
++ [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
otherAttrs]
  Doc Text
title' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts (forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
fixLineBreak [Inline]
ils)
  let label :: Doc Text
label = if WriterOptions -> Bool
writerNumberSections WriterOptions
opts
                 then
                   case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
hkvs of
                     Just Text
num -> forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"label" (forall a. HasChars a => a -> Doc a
literal Text
num)
                     Maybe Text
Nothing -> forall a. Monoid a => a
mempty
                 else forall a. Monoid a => a
mempty
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
xs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"sec" [(Text, Text)]
attribs forall a b. (a -> b) -> a -> b
$
      Doc Text
label forall a. Doc a -> Doc a -> Doc a
$$
      forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
-- Bibliography reference:
blockToJATS WriterOptions
opts (Div (Text
ident,[Text]
_,[(Text, Text)]
_) [Para [Inline]
lst]) | Text
"ref-" Text -> Text -> Bool
`T.isPrefixOf` Text
ident =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"ref" [(Text
"id", Text -> Text
escapeNCName Text
ident)] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"mixed-citation" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
blockToJATS WriterOptions
opts (Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
xs) = do
  [Reference Inlines]
refs <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). JATSEnv m -> [Reference Inlines]
jatsReferences
  Doc Text
contents <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Reference Inlines]
refs
              then forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
xs
              else forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Reference Inlines] -> JATS m (Doc Text)
referencesToJATS WriterOptions
opts [Reference Inlines]
refs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"ref-list" Doc Text
contents
blockToJATS WriterOptions
opts (Div (Text
ident,[Text
cls],[(Text, Text)]
kvs) [Block]
bs) | Text
cls forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"fig", Text
"caption", Text
"table-wrap"] = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
bs
  let attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] forall a. [a] -> [a] -> [a]
++
             [(Text
"xml:lang",Text
l) | (Text
"lang",Text
l) <- [(Text, Text)]
kvs] forall a. [a] -> [a] -> [a]
++
             [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"specific-use",
                 Text
"content-type", Text
"orientation", Text
"position"]]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
cls [(Text, Text)]
attr Doc Text
contents
blockToJATS WriterOptions
opts (Div (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Block]
bs) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
bs
  let attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] forall a. [a] -> [a] -> [a]
++
             [(Text
"xml:lang",Text
l) | (Text
"lang",Text
l) <- [(Text, Text)]
kvs] forall a. [a] -> [a] -> [a]
++
             [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"specific-use",
                 Text
"content-type", Text
"orientation", Text
"position"]]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"boxed-text" [(Text, Text)]
attr Doc Text
contents
blockToJATS WriterOptions
opts (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
title) = do
  Doc Text
title' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts (forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
fixLineBreak [Inline]
title)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title'
-- Special cases for bare images, which are rendered as graphics
blockToJATS WriterOptions
_opts (Plain [Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt]) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Doc Text
graphic (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
blockToJATS WriterOptions
_opts (Para [Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt]) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Doc Text
graphic (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
-- No Plain, everything needs to be in a block-level tag
blockToJATS WriterOptions
opts (Plain [Inline]
lst) = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts ([Inline] -> Block
Para [Inline]
lst)
blockToJATS WriterOptions
opts (Para [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"p" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
blockToJATS WriterOptions
opts (LineBlock [[Inline]]
lns) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToJATS WriterOptions
opts (BlockQuote [Block]
blocks) = do
  JATSTagSet
tagSet <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
  let needsWrap :: Block -> Bool
needsWrap = if JATSTagSet
tagSet forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
                  then Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara
                  else \case
                    Header{}       -> Bool
True
                    Block
HorizontalRule -> Bool
True
                    Block
_              -> Bool
False
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"disp-quote" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS Block -> Bool
needsWrap WriterOptions
opts [Block]
blocks
blockToJATS WriterOptions
opts (CodeBlock (Text, [Text], [(Text, Text)])
a Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
tag [(Text, Text)]
attr (forall a. Doc a -> Doc a
flush (forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str)))
    where (Text
lang, [(Text, Text)]
attr) = WriterOptions
-> (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr WriterOptions
opts (Text, [Text], [(Text, Text)])
a
          tag :: Text
tag          = if Text -> Bool
T.null Text
lang then Text
"preformat" else Text
"code"
blockToJATS WriterOptions
_ (BulletList []) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToJATS WriterOptions
opts (BulletList [[Block]]
lst) =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"list" [(Text
"list-type", Text
"bullet")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS WriterOptions
opts forall a. Maybe a
Nothing [[Block]]
lst
blockToJATS WriterOptions
_ (OrderedList ListAttributes
_ []) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToJATS WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
delimstyle) [[Block]]
items) = do
  JATSTagSet
tagSet <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
  let listType :: Text
listType =
        -- The Article Authoring tag set doesn't allow a more specific
        -- @list-type@ attribute than "order".
        if JATSTagSet
tagSet forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
        then Text
"order"
        else case ListNumberStyle
numstyle of
               ListNumberStyle
DefaultStyle -> Text
"order"
               ListNumberStyle
Decimal      -> Text
"order"
               ListNumberStyle
Example      -> Text
"order"
               ListNumberStyle
UpperAlpha   -> Text
"alpha-upper"
               ListNumberStyle
LowerAlpha   -> Text
"alpha-lower"
               ListNumberStyle
UpperRoman   -> Text
"roman-upper"
               ListNumberStyle
LowerRoman   -> Text
"roman-lower"
  let simpleList :: Bool
simpleList = Int
start forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& (ListNumberDelim
delimstyle forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim Bool -> Bool -> Bool
||
                                  ListNumberDelim
delimstyle forall a. Eq a => a -> a -> Bool
== ListNumberDelim
Period)
  let markers :: Maybe [Text]
markers = if Bool
simpleList
                   then forall a. Maybe a
Nothing
                   else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                          ListAttributes -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
numstyle, ListNumberDelim
delimstyle)
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"list" [(Text
"list-type", Text
listType)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS WriterOptions
opts Maybe [Text]
markers [[Block]]
items
blockToJATS WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
lst) =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"def-list" [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS WriterOptions
opts [([Inline], [[Block]])]
lst
blockToJATS WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
  | Format
f forall a. Eq a => a -> a -> Bool
== Format
"jats"    = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str -- raw XML block
  | Bool
otherwise      = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToJATS WriterOptions
_ Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty -- not semantic
blockToJATS WriterOptions
opts (Table (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Table -> JATS m (Doc Text)
tableToJATS WriterOptions
opts ((Text, [Text], [(Text, Text)])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot)
blockToJATS WriterOptions
opts (Figure (Text
ident, [Text]
_, [(Text, Text)]
kvs) (Caption Maybe [Inline]
_short [Block]
longcapt) [Block]
body) = do
  -- Remove the alt text from images if it's the same as the caption text.
  let unsetAltIfDupl :: Inline -> Inline
unsetAltIfDupl = \case
        Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
          | forall a. Walkable Inline a => a -> Text
stringify [Inline]
alt forall a. Eq a => a -> a -> Bool
== forall a. Walkable Inline a => a -> Text
stringify [Block]
longcapt -> (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
attr [] (Text, Text)
tgt
        Inline
inline -> Inline
inline
  Doc Text
capt <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
longcapt
          then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Doc a
empty
          else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"caption" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
longcapt
  Doc Text
figbod <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unsetAltIfDupl [Block]
body
  let figattr :: [(Text, Text)]
figattr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] forall a. [a] -> [a] -> [a]
++
                [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
                       , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"fig-type", Text
"orientation"
                                  , Text
"position", Text
"specific-use"]]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"fig" [(Text, Text)]
figattr forall a b. (a -> b) -> a -> b
$ Doc Text
capt forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
figbod

-- | Convert a list of inline elements to JATS.
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst = forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS WriterOptions
opts) ([Inline] -> [Inline]
fixCitations [Inline]
lst)
  where
   fixCitations :: [Inline] -> [Inline]
fixCitations [] = []
   fixCitations (Inline
x:[Inline]
xs) | Inline -> Bool
needsFixing Inline
x =
     Inline
x forall a. a -> [a] -> [a]
: Text -> Inline
Str (forall a. Walkable Inline a => a -> Text
stringify [Inline]
ys) forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixCitations [Inline]
zs
     where
       needsFixing :: Inline -> Bool
needsFixing (RawInline (Format Text
"jats") Text
z) =
           Text
"<pub-id pub-id-type=" Text -> Text -> Bool
`T.isPrefixOf` Text
z
       needsFixing Inline
_           = Bool
False
       isRawInline :: Inline -> Bool
isRawInline RawInline{} = Bool
True
       isRawInline Inline
_           = Bool
False
       ([Inline]
ys,[Inline]
zs)                 = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Inline -> Bool
isRawInline [Inline]
xs
   fixCitations (Inline
x:[Inline]
xs) = Inline
x forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixCitations [Inline]
xs

-- | Convert an inline element to JATS.
inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS WriterOptions
_ (Str Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToJATS WriterOptions
opts (Emph [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"italic" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Underline [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"underline" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Strong [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"bold" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Strikeout [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"strike" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Superscript [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"sup" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Subscript [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"sub" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (SmallCaps [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"sc" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Char -> Doc a
char Char
'‘' forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'’'
inlineToJATS WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Char -> Doc a
char Char
'“' forall a. Semigroup a => a -> a -> a
<> Doc Text
contents forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
'”'
inlineToJATS WriterOptions
opts (Code (Text, [Text], [(Text, Text)])
a Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"monospace" [(Text, Text)]
attr forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str)
    where (Text
_lang, [(Text, Text)]
attr) = WriterOptions
-> (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr WriterOptions
opts (Text, [Text], [(Text, Text)])
a
inlineToJATS WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
x)
  | Format
f forall a. Eq a => a -> a -> Bool
== Format
"jats" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
x
  | Bool
otherwise   = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToJATS WriterOptions
_ Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
cr -- not allowed as child of p
-- see https://jats.nlm.nih.gov/publishing/tag-library/1.2/element/break.html
inlineToJATS WriterOptions
_ Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToJATS WriterOptions
opts Inline
SoftBreak
  | WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
cr
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToJATS WriterOptions
opts (Note [Block]
contents) = do
  JATSTagSet
tagSet <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
  -- Footnotes must occur inline when using the Article Authoring tag set.
  if JATSTagSet
tagSet forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
    then forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"fn" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara) WriterOptions
opts [Block]
contents
    else do
      [(Int, Doc Text)]
notes <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> [(Int, Doc Text)]
jatsNotes
      let notenum :: Int
notenum = case [(Int, Doc Text)]
notes of
                      (Int
n, Doc Text
_):[(Int, Doc Text)]
_ -> Int
n forall a. Num a => a -> a -> a
+ Int
1
                      []       -> Int
1
      Doc Text
thenote <- forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"fn" [(Text
"id", Text
"fn" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
notenum)]
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"label" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow Int
notenum) forall a. Semigroup a => a -> a -> a
<>)
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara) WriterOptions
opts
                         (forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
demoteHeaderAndRefs [Block]
contents)
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsNotes :: [(Int, Doc Text)]
jatsNotes = (Int
notenum, Doc Text
thenote) forall a. a -> [a] -> [a]
: [(Int, Doc Text)]
notes }
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"xref" [(Text
"ref-type", Text
"fn"),
                                    (Text
"rid", Text
"fn" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
notenum)]
             forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => String -> Doc a
text (forall a. Show a => a -> String
show Int
notenum)
inlineToJATS WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Span (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
ils
  let commonAttr :: [(Text, Text)]
commonAttr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] forall a. [a] -> [a] -> [a]
++
                   [(Text
"xml:lang",Text
l) | (Text
"lang",Text
l) <- [(Text, Text)]
kvs] forall a. [a] -> [a] -> [a]
++
                   [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs,  Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"alt", Text
"specific-use"]]
  -- A named-content element is a good fit for spans, but requires a
  -- content-type attribute to be present. We use either the explicit
  -- attribute or the first class as content type. If neither is
  -- available, then we fall back to using a @styled-content@ element.
  let (Text
tag, [(Text, Text)]
specificAttr) =
        case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"content-type" [(Text, Text)]
kvs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. [a] -> Maybe a
listToMaybe [Text]
classes of
          Just Text
ct -> ( Text
"named-content"
                     , (Text
"content-type", Text
ct) forall a. a -> [a] -> [a]
:
                       [(Text
k, Text
v) | (Text
k, Text
v) <- [(Text, Text)]
kvs
                       , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"rid", Text
"vocab", Text
"vocab-identifier",
                                   Text
"vocab-term", Text
"vocab-term-identifier"]])
          -- Fall back to styled-content
          Maybe Text
Nothing -> (Text
"styled-content"
                     , [(Text
k, Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
                       , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"style", Text
"style-type", Text
"style-detail",
                                   Text
"toggle"]])
  let attr :: [(Text, Text)]
attr = [(Text, Text)]
commonAttr forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
specificAttr
  -- unwrap if wrapping element would have no attributes
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
attr
    then Doc Text
contents
    else forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
tag [(Text, Text)]
attr Doc Text
contents
inlineToJATS WriterOptions
_ (Math MathType
t Text
str) = do
  let addPref :: Attr -> Attr
addPref (Xml.Attr QName
q String
v)
         | QName -> String
Xml.qName QName
q forall a. Eq a => a -> a -> Bool
== String
"xmlns" = QName -> String -> Attr
Xml.Attr QName
q{ qName :: String
Xml.qName = String
"xmlns:mml" } String
v
         | Bool
otherwise = QName -> String -> Attr
Xml.Attr QName
q String
v
  let fixNS' :: Element -> Element
fixNS' Element
e = Element
e{ elName :: QName
Xml.elName =
                         (Element -> QName
Xml.elName Element
e){ qPrefix :: Maybe String
Xml.qPrefix = forall a. a -> Maybe a
Just String
"mml" } }
  let fixNS :: Element -> Element
fixNS = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Element -> Element
fixNS') forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (\Element
e -> Element
e{ elAttribs :: [Attr]
Xml.elAttribs = forall a b. (a -> b) -> [a] -> [b]
map Attr -> Attr
addPref (Element -> [Attr]
Xml.elAttribs Element
e) })
  let conf :: ConfigPP
conf = (QName -> Bool) -> ConfigPP -> ConfigPP
Xml.useShortEmptyTags (forall a b. a -> b -> a
const Bool
False) ConfigPP
Xml.defaultConfigPP
  Either Inline Element
res <- forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeMathML MathType
t Text
str
  let tagtype :: Text
tagtype = case MathType
t of
                     MathType
DisplayMath -> Text
"disp-formula"
                     MathType
InlineMath  -> Text
"inline-formula"

  let rawtex :: Doc Text
rawtex = forall a. HasChars a => String -> Doc a
text String
"<![CDATA[" forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
str forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => String -> Doc a
text String
"]]>"
  let texMath :: Doc Text
texMath = forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"tex-math" Doc Text
rawtex

  JATSTagSet
tagSet <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
tagtype forall a b. (a -> b) -> a -> b
$
    case Either Inline Element
res of
      Right Element
r  -> let mathMl :: Doc Text
mathMl = forall a. HasChars a => String -> Doc a
text (ConfigPP -> Element -> String
Xml.ppcElement ConfigPP
conf forall a b. (a -> b) -> a -> b
$ Element -> Element
fixNS Element
r)
                  -- tex-math is unsupported in Article Authoring tag set
                  in if JATSTagSet
tagSet forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
                     then Doc Text
mathMl
                     else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"alternatives" forall a b. (a -> b) -> a -> b
$
                          forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> Doc Text
texMath forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
mathMl
      Left Inline
_   -> if JATSTagSet
tagSet forall a. Eq a => a -> a -> Bool
/= JATSTagSet
TagSetArticleAuthoring
                  then Doc Text
texMath
                  else Doc Text
rawtex
inlineToJATS WriterOptions
_ (Link (Text, [Text], [(Text, Text)])
_attr [Str Text
t] (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" -> Just Text
email, Text
_))
  | Text -> Text
escapeURI Text
t forall a. Eq a => a -> a -> Bool
== Text
email =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"email" forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
email)
inlineToJATS WriterOptions
opts (Link (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
src), Text
_)) = do
  let attr :: [(Text, Text)]
attr = forall a. Monoid a => [a] -> a
mconcat
             [ [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
             , [(Text
"alt", forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt)]
             , [(Text
"rid", Text -> Text
escapeNCName Text
src)]
             , [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"ref-type", Text
"specific-use"]]
             , [(Text
"ref-type", Text
"bibr") | Text
"ref-" Text -> Text -> Bool
`T.isPrefixOf` Text
src]
             ]
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"xref" [(Text, Text)]
attr
     else do
        Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"xref" [(Text, Text)]
attr Doc Text
contents
inlineToJATS WriterOptions
opts (Link (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
txt (Text
src, Text
tit)) = do
  let attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] forall a. [a] -> [a] -> [a]
++
             [(Text
"ext-link-type", Text
"uri"),
              (Text
"xlink:href", Text
src)] forall a. [a] -> [a] -> [a]
++
             [(Text
"xlink:title", Text
tit) | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] forall a. [a] -> [a] -> [a]
++
             [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"assigning-authority",
                                              Text
"specific-use", Text
"xlink:actuate",
                                              Text
"xlink:role", Text
"xlink:show",
                                              Text
"xlink:type"]]
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"ext-link" [(Text, Text)]
attr Doc Text
contents
inlineToJATS WriterOptions
_ (Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt) = do
  let elattr :: [(Text, Text)]
elattr = (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> [(Text, Text)]
graphicAttr (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [Inline] -> Maybe (Doc Text)
altToJATS [Inline]
alt of
             Maybe (Doc Text)
Nothing -> forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"inline-graphic" [(Text, Text)]
elattr
             Just Doc Text
altTag -> forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"inline-graphic" [(Text, Text)]
elattr Doc Text
altTag

graphic :: Attr -> [Inline] -> Target -> (Doc Text)
graphic :: (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Doc Text
graphic (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt =
  let elattr :: [(Text, Text)]
elattr = (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> [(Text, Text)]
graphicAttr (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
  in case [Inline] -> Maybe (Doc Text)
altToJATS [Inline]
alt of
       Maybe (Doc Text)
Nothing -> forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"graphic" [(Text, Text)]
elattr
       Just Doc Text
altTag -> forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"graphic" [(Text, Text)]
elattr Doc Text
altTag

graphicAttr :: Attr -> [Inline] -> Target -> [(Text, Text)]
graphicAttr :: (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> [(Text, Text)]
graphicAttr (Text
ident, [Text]
_, [(Text, Text)]
kvs) [Inline]
_alt (Text
src, Text
tit) =
  let (Text
maintype, Text
subtype) = Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs
  in [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] forall a. [a] -> [a] -> [a]
++
     [ (Text
"mimetype", Text
maintype)
     , (Text
"mime-subtype", Text
subtype)
     , (Text
"xlink:href", Text
src)
     ] forall a. [a] -> [a] -> [a]
++
     [(Text
"xlink:title", Text
tit) | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] forall a. [a] -> [a] -> [a]
++
     [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
            , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"baseline-shift", Text
"content-type", Text
"specific-use"
                       , Text
"xlink:actuate", Text
"xlink:href", Text
"xlink:role"
                       , Text
"xlink:show", Text
"xlink:type"]
            ]

altToJATS :: [Inline] -> Maybe (Doc Text)
altToJATS :: [Inline] -> Maybe (Doc Text)
altToJATS [Inline]
alt =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt
  then forall a. Maybe a
Nothing
  else forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"alt-text" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall a. [Doc a] -> Doc a
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. HasChars a => a -> Doc a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify [Inline]
alt

imageMimeType :: Text -> [(Text, Text)] -> (Text, Text)
imageMimeType :: Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs =
  let mbMT :: Maybe Text
mbMT = String -> Maybe Text
getMimeType (Text -> String
T.unpack Text
src)
      maintype :: Text
maintype = forall a. a -> Maybe a -> a
fromMaybe Text
"image" forall a b. (a -> b) -> a -> b
$
                  forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"mimetype" [(Text, Text)]
kvs forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                  ((Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'/') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mbMT)
      subtype :: Text
subtype = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$
                  forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"mime-subtype" [(Text, Text)]
kvs forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                  (Int -> Text -> Text
T.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'/') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mbMT)
  in (Text
maintype, Text
subtype)

isParaOrList :: Block -> Bool
isParaOrList :: Block -> Bool
isParaOrList Para{}           = Bool
True
isParaOrList Plain{}          = Bool
True
isParaOrList BulletList{}     = Bool
True
isParaOrList OrderedList{}    = Bool
True
isParaOrList DefinitionList{} = Bool
True
isParaOrList Block
_                = Bool
False

isPara :: Block -> Bool
isPara :: Block -> Bool
isPara Para{}  = Bool
True
isPara Plain{} = Bool
True
isPara Block
_       = Bool
False

demoteHeaderAndRefs :: Block -> Block
demoteHeaderAndRefs :: Block -> Block
demoteHeaderAndRefs (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
ils) = [Inline] -> Block
Para [Inline]
ils
demoteHeaderAndRefs (Div (Text
"refs",[Text]
cls,[(Text, Text)]
kvs) [Block]
bs) =
                       (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"",[Text]
cls,[(Text, Text)]
kvs) [Block]
bs
demoteHeaderAndRefs Block
x = Block
x

parseDate :: Text -> Maybe Day
parseDate :: Text -> Maybe Day
parseDate Text
s = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Maybe Day
`parsetimeWith` Text -> String
T.unpack Text
s) [String]
formats)
  where parsetimeWith :: String -> String -> Maybe Day
parsetimeWith = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
        formats :: [String]
formats = [String
"%x",String
"%m/%d/%Y", String
"%D",String
"%F", String
"%d %b %Y",
                    String
"%e %B %Y", String
"%b. %e, %Y", String
"%B %e, %Y",
                    String
"%Y%m%d", String
"%Y%m", String
"%Y"]