{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{- |
   Module      : Text.Pandoc.Writers.JATS
   Copyright   : 2017-2022 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.Reader
import Control.Monad.State
import Data.Generics (everywhere, mkT)
import Data.List (partition)
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.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.
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

-- | 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
  let isBackBlock :: Block -> Bool
isBackBlock (Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_) = Bool
True
      isBackBlock Block
_                    = Bool
False
  let ([Block]
backblocks, [Block]
bodyblocks) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Block -> Bool
isBackBlock [Block]
blocks
  -- 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 fromBlocks :: [Block] -> JATS m (Doc Text)
fromBlocks = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False (forall a. a -> Maybe a
Just Int
startLvl)
  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
                 [Block] -> JATS m (Doc Text)
fromBlocks
                 (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 <- [Block] -> JATS m (Doc Text)
fromBlocks [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 <- [Block] -> JATS m (Doc Text)
fromBlocks [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
  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
"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

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)

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

-- | 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
_ Block
Null = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToJATS WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
kvs) (Header Int
_lvl (Text, [Text], [(Text, Text)])
_ [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 [Inline]
ils
  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
$
      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 [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'
-- 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 (SimpleFigure (Text
ident, [Text]
_, [(Text, Text)]
kvs) [Inline]
txt (Text
src, Text
tit)) = do
  Doc Text
alt <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
  let (Text
maintype, Text
subtype) = Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs
  let capt :: Doc Text
capt = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
                then forall a. Doc a
empty
                else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"caption" forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"p" Doc Text
alt
  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
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"]]
  let graphicattr :: [(Text, Text)]
graphicattr = [(Text
"mimetype",Text
maintype),
                     (Text
"mime-subtype",Text
subtype),
                     (Text
"xlink:href",Text
src),  -- do we need to URL escape this?
                     (Text
"xlink:title",Text
tit)]
  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)]
attr forall a b. (a -> b) -> a -> b
$
              Doc Text
capt forall a. Doc a -> Doc a -> Doc a
$$ forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"graphic" [(Text, Text)]
graphicattr
blockToJATS WriterOptions
_ (Para [Image (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
_ (Text
src, Text
tit)]) = do
  let (Text
maintype, Text
subtype) = Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs
  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
"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"]]
  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
"graphic" [(Text, Text)]
attr
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)

-- | 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
tag [(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
          tag :: Text
tag          = if Text -> Bool
T.null Text
lang then Text
"monospace" else Text
"code"
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
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
_ (Text
src, Text
tit)) = do
  let mbMT :: Maybe Text
mbMT = String -> Maybe Text
getMimeType (Text -> String
T.unpack Text
src)
  let 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)
  let 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)
  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
"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"]]
  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
"inline-graphic" [(Text, Text)]
attr

isParaOrList :: Block -> Bool
isParaOrList :: Block -> Bool
isParaOrList SimpleFigure{}   = Bool
False  -- implicit figures are not paragraphs
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"]