    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns        #-}
    {- |
       Module      : Text.Pandoc.Writers.JATS
       Copyright   : 2017-2024 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, isNothing)
    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(..), toVal)
    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

    -- | Default human-readable names for roles in the Contributor Role
    -- Taxonomy (CRediT). This is useful for generating JATS that annotate
    -- contributor roles
    creditNames :: M.Map Text Text
    creditNames :: Map Text Text
    creditNames = [(Text, Text)] -> Map Text Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [
        (Text
    "conceptualization", Text
    "Conceptualization"),
        (Text
    "data-curation", Text
    "Data curation"),
        (Text
    "formal-analysis", Text
    "Formal analysis"),
        (Text
    "funding-acquisition", Text
    "Funding acquisition"),
        (Text
    "investigation", Text
    "Investigation"),
        (Text
    "methodology", Text
    "Methodology"),
        (Text
    "project-administration", Text
    "Project administration"),
        (Text
    "resources", Text
    "Resources"),
        (Text
    "software", Text
    "Software"),
        (Text
    "supervision", Text
    "Supervision"),
        (Text
    "validation", Text
    "Validation"),
        (Text
    "visualization", Text
    "Visualization"),
        (Text
    "writing-original-draft", Text
    "Writing – original draft"),
        (Text
    "writing-review-editing", Text
    "Writing – review &amp; editing")]

    -- | Ensure every role with a `credit` key also has a `credit-name`,
    -- using a default value if necessary
    addCreditNames :: Context Text -> Context Text
    addCreditNames :: Context Text -> Context Text
    addCreditNames Context Text
    context =
      case Text -> Context Text -> Maybe (Val Text)
    forall a b. FromContext a b => Text -> Context a -> Maybe b
    getField Text
    "author" Context Text
    context of
        -- If there is an "authors" key, then we replace the existing value
        -- with one we mutate by running the addCreditNamesToAuthor helper
        -- function on each
        Just (ListVal [Val Text]
    authors) ->
          Text -> [Val Text] -> Context Text -> Context Text
    forall a b. ToContext a b => Text -> b -> Context a -> Context a
    resetField Text
    "author" ((Val Text -> Val Text) -> [Val Text] -> [Val Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Val Text -> Val Text
    addCreditNamesToAuthor [Val Text]
    authors) Context Text
    context
        -- If there is no "authors" key in the context, then we don't have to do
        -- anything, and just return the context as is
        Maybe (Val Text)
    _ -> Context Text
    context
      where
        addCreditNamesToAuthor :: Val Text -> Val Text
        addCreditNamesToAuthor :: Val Text -> Val Text
    addCreditNamesToAuthor Val Text
    val = Val Text -> Maybe (Val Text) -> Val Text
    forall a. a -> Maybe a -> a
    fromMaybe Val Text
    val (Maybe (Val Text) -> Val Text) -> Maybe (Val Text) -> Val Text
    forall a b. (a -> b) -> a -> b
    $ do
          MapVal authorCtx <- Val Text -> Maybe (Val Text)
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Val Text
    val
          ListVal roles <- getField "roles" authorCtx
          return $ toVal $ resetField "roles" (map addCreditNameToRole roles) authorCtx

        addCreditNameToRole :: Val Text -> Val Text
        addCreditNameToRole :: Val Text -> Val Text
    addCreditNameToRole Val Text
    val = Val Text -> Maybe (Val Text) -> Val Text
    forall a. a -> Maybe a -> a
    fromMaybe Val Text
    val (Maybe (Val Text) -> Val Text) -> Maybe (Val Text) -> Val Text
    forall a b. (a -> b) -> a -> b
    $ do
          MapVal roleCtx <- Val Text -> Maybe (Val Text)
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Val Text
    val
          guard $ isNothing (getField "credit-name" roleCtx :: Maybe (Val Text))
          creditId <- getField "credit" roleCtx
          creditName <- M.lookup creditId creditNames
          return $ toVal $ resetField "credit-name" creditName roleCtx

    -- | 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 = JATSTagSet -> WriterOptions -> Pandoc -> m Text
    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 = JATSTagSet -> WriterOptions -> Pandoc -> m Text
    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 = JATSTagSet -> WriterOptions -> Pandoc -> m Text
    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 = WriterOptions -> Pandoc -> m Text
    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
      refs <- if Extension -> Extensions -> Bool
    extensionEnabled Extension
    Ext_element_citations (Extensions -> Bool) -> Extensions -> Bool
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Extensions
    writerExtensions WriterOptions
    opts
              then Maybe Locale -> Pandoc -> m [Reference Inlines]
    forall (m :: * -> *).
    PandocMonad m =>
    Maybe Locale -> Pandoc -> m [Reference Inlines]
    getReferences Maybe Locale
    forall a. Maybe a
    Nothing Pandoc
    d
              else [Reference Inlines] -> m [Reference Inlines]
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
      let environment = JATSEnv
              { jatsTagSet :: JATSTagSet
    jatsTagSet = JATSTagSet
    tagSet
              , jatsInlinesWriter :: WriterOptions -> [Inline] -> JATS m (Doc Text)
    jatsInlinesWriter = WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS
              , jatsBlockWriter :: (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    jatsBlockWriter = (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    wrappedBlocksToJATS
              , jatsReferences :: [Reference Inlines]
    jatsReferences = [Reference Inlines]
    refs
              }
      let initialState = JATSState { jatsNotes :: [(Int, Doc Text)]
    jatsNotes = [] }
      runReaderT (evalStateT (docToJATS opts d) initialState)
                 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
    hBlock -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    :Block
    refsBlock -> [Block] -> [Block]
    forall 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 [Inline]
    forall a. Monoid a => a
    mempty Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : Block
    refs Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    xs
    ensureReferenceHeader (Block
    x:[Block]
    xs) = Block
    x Block -> [Block] -> [Block]
    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) (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    startLvl)
                      ([Block] -> [Block]) -> [Block] -> [Block]
    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
    bBlock -> [Block] -> [Block]
    forall 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]
    rest
                                   )) ([Block]
    fs, [Block]
    bs)
                           = ([Block]
    fs [Block] -> [Block] -> [Block]
    forall a. [a] -> [a] -> [a]
    ++ [Block]
    rest,
                                (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 Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    rs) Block -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    : [Block]
    bs)
          splitBackBlocks Block
    b ([Block]
    fs, [Block]
    bs) = (Block
    bBlock -> [Block] -> [Block]
    forall a. a -> [a] -> [a]
    :[Block]
    fs, [Block]
    bs)
      let ([Block]
    bodyblocks, [Block]
    backblocks) = (Block -> ([Block], [Block]) -> ([Block], [Block]))
    -> ([Block], [Block]) -> [Block] -> ([Block], [Block])
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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 WrapOption -> WrapOption -> Bool
    forall a. Eq a => a -> a -> Bool
    == WrapOption
    WrapAuto
                        then Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ WriterOptions -> Int
    writerColumns WriterOptions
    opts
                        else Maybe Int
    forall a. Maybe a
    Nothing
      metadata <- WriterOptions
    -> ([Block] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> ([Inline]
        -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> Meta
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Context Text)
    forall (m :: * -> *) a.
    (Monad m, TemplateTarget a) =>
    WriterOptions
    -> ([Block] -> m (Doc a))
    -> ([Inline] -> m (Doc a))
    -> Meta
    -> m (Context a)
    metaToContext WriterOptions
    opts
                     (WriterOptions
    -> [Block] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS WriterOptions
    opts ([Block] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> ([Block] -> [Block])
    -> [Block]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> Maybe Int -> [Block] -> [Block]
    makeSections Bool
    False (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    startLvl))
                     ((Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b.
    (a -> b)
    -> StateT JATSState (ReaderT (JATSEnv m) m) a
    -> StateT JATSState (ReaderT (JATSEnv m) m) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Doc Text -> Doc Text
    forall a. Doc a -> Doc a
    chomp (StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
     -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> ([Inline]
        -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> [Inline]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts)
                     Meta
    meta
      main <- blocksToJATS opts bodyblocks
      notes <- gets (reverse . map snd . jatsNotes)
      backs <- blocksToJATS opts backblocks
      tagSet <- asks 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 = if [Doc Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Doc Text]
    notes Bool -> Bool -> Bool
    || JATSTagSet
    tagSet JATSTagSet -> JATSTagSet -> Bool
    forall a. Eq a => a -> a -> Bool
    == JATSTagSet
    TagSetArticleAuthoring
                then Doc Text
    forall a. Monoid a => a
    mempty
                else Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented Text
    "fn-group" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat [Doc Text]
    notes
      let back = Doc Text
    backs Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    fns
      let date =
            case Text -> Context Text -> Maybe (Val Text)
    forall a b. FromContext a b => Text -> Context a -> Maybe b
    getField Text
    "date" Context Text
    metadata of
              Maybe (Val Text)
    Nothing -> Val Text
    forall a. Val a
    NullVal
              Just (SimpleVal (Doc Text
    x :: Doc Text)) ->
                 case Text -> Maybe Day
    parseDate (Maybe Int -> Doc Text -> Text
    forall a. HasChars a => Maybe Int -> Doc a -> a
    render Maybe Int
    forall a. Maybe a
    Nothing Doc Text
    x) of
                   Maybe Day
    Nothing  -> Val Text
    forall a. Val a
    NullVal
                   Just Day
    day ->
                     let (Integer
    y,Int
    m,Int
    d) = Day -> (Integer, Int, Int)
    toGregorian Day
    day
                     in  Context Text -> Val Text
    forall a. Context a -> Val a
    MapVal (Context Text -> Val Text)
    -> (Map Text (Val Text) -> Context Text)
    -> Map Text (Val Text)
    -> Val Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Text (Val Text) -> Context Text
    forall a. Map Text (Val a) -> Context a
    Context (Map Text (Val Text) -> Val Text)
    -> Map Text (Val Text) -> Val Text
    forall a b. (a -> b) -> a -> b
    $ [(Text, Val Text)] -> Map Text (Val Text)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList
                          [(Text
    "year" :: Text, Doc Text -> Val Text
    forall a. Doc a -> Val a
    SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (String -> Doc Text) -> String -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Integer -> String
    forall a. Show a => a -> String
    show Integer
    y)
                          ,(Text
    "month", Doc Text -> Val Text
    forall a. Doc a -> Val a
    SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (String -> Doc Text) -> String -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    m)
                          ,(Text
    "day", Doc Text -> Val Text
    forall a. Doc a -> Val a
    SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (String -> Doc Text) -> String -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    d)
                          ,(Text
    "iso-8601", Doc Text -> Val Text
    forall a. Doc a -> Val a
    SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (String -> Doc Text) -> String -> Doc Text
    forall a b. (a -> b) -> a -> b
    $
                                TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%F" Day
    day)
                          ]
              Just Val Text
    x -> Val Text
    x
      title' <- inlinesToJATS opts $ map fixLineBreak
                   (lookupMetaInlines "title" meta)
      let context = Text -> Doc Text -> Context Text -> Context Text
    forall a b. ToContext a b => Text -> b -> Context a -> Context a
    defField Text
    "body" Doc Text
    main
                  (Context Text -> Context Text) -> Context Text -> Context Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc Text -> Context Text -> Context Text
    forall a b. ToContext a b => Text -> b -> Context a -> Context a
    defField Text
    "back" Doc Text
    back
                  (Context Text -> Context Text) -> Context Text -> Context Text
    forall a b. (a -> b) -> a -> b
    $ Context Text -> Context Text
    addCreditNames
                  (Context Text -> Context Text) -> Context Text -> Context Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc Text -> Context Text -> Context Text
    forall a b. ToContext a b => Text -> b -> Context a -> Context a
    resetField Text
    "title" Doc Text
    title'
                  (Context Text -> Context Text) -> Context Text -> Context Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Val Text -> Context Text -> Context Text
    forall a b. ToContext a b => Text -> b -> Context a -> Context a
    resetField Text
    "date" Val Text
    date
                  (Context Text -> Context Text) -> Context Text -> Context Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Bool -> Context Text -> Context Text
    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
      return $ render colwidth $
        (if writerPreferAscii opts then fmap toEntities else id) $
        case writerTemplate opts of
           Maybe (Template Text)
    Nothing  -> Doc Text
    main
           Just Template Text
    tpl -> Template Text -> Context Text -> Doc Text
    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 = (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    wrappedBlocksToJATS (Bool -> Block -> Bool
    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 =
      ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b.
    (a -> b)
    -> StateT JATSState (ReaderT (JATSEnv m) m) a
    -> StateT JATSState (ReaderT (JATSEnv m) m) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat (StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
     -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> ([Block] -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text])
    -> [Block]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> [Block] -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    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
          inner <- WriterOptions
    -> Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS WriterOptions
    opts Block
    b
          return $
            if needsWrap b
               then inTags True "p" [("specific-use","wrapper")] inner
               else 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 =
      [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([Inline], [[Block]])
     -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> [([Inline], [[Block]])]
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (([Inline]
     -> [[Block]]
     -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> ([Inline], [[Block]])
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (WriterOptions
    -> [Inline]
    -> [[Block]]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    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
      term' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    term
      def' <- wrappedBlocksToJATS (not . isPara)
                  opts $ concatMap (walk demoteHeaderAndRefs .
                                    map plainToPara) defs
      return $ inTagsIndented "def-item" $
          inTagsSimple "term" term' $$
          inTagsIndented "def" 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 -> [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([Block] -> JATS m (Doc Text))
    -> [[Block]] -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
    listItemToJATS WriterOptions
    opts Maybe Text
    forall a. Maybe a
    Nothing) [[Block]]
    items
           Just [Text]
    ms -> [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe Text -> [Block] -> JATS m (Doc Text))
    -> [Maybe Text]
    -> [[Block]]
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
    listItemToJATS WriterOptions
    opts) ((Text -> Maybe Text) -> [Text] -> [Maybe Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Maybe Text
    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
      contents <- (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    wrappedBlocksToJATS (Bool -> Bool
    not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Block -> Bool
    isParaOrList) WriterOptions
    opts
                     ((Block -> Block) -> [Block] -> [Block]
    forall a b. Walkable a b => (a -> a) -> b -> b
    walk Block -> Block
    demoteHeaderAndRefs [Block]
    item)
      return $ inTagsIndented "list-item" $
               maybe empty (inTagsSimple "label" . text . T.unpack) mbmarker
               $$ 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 Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (Text -> Text) -> [Text] -> [Text]
    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) (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.toLower (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text
    s
              langs :: [Text]
    langs       = (Text -> [Text]) -> [Text] -> [Text]
    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)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                  [(Text
    "language",Text
    lang) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    lang)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                  [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 Text -> Text -> Text
    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 [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++ [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    otherAttrs]
      title' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts ((Inline -> Inline) -> [Inline] -> [Inline]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Inline
    fixLineBreak [Inline]
    ils)
      let label = if WriterOptions -> Bool
    writerNumberSections WriterOptions
    opts
                     then
                       case Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "number" [(Text, Text)]
    hkvs of
                         Just Text
    num -> Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "label" (Text -> Doc Text
    forall a. HasChars a => a -> Doc a
    literal Text
    num)
                         Maybe Text
    Nothing -> Doc Text
    forall a. Monoid a => a
    mempty
                     else Doc Text
    forall a. Monoid a => a
    mempty
      contents <- blocksToJATS opts xs
      return $ inTags True "sec" attribs $
          label $$
          inTagsSimple "title" title' $$ contents
    -- Bibliography reference:
    blockToJATS WriterOptions
    opts (Div (Text
    ident,[Text]
    _,[(Text, Text)]
    _) [Para [Inline]
    lst]) | Text
    "ref-" Text -> Text -> Bool
    `T.isPrefixOf` Text
    ident =
      Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
    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)] (Doc Text -> Doc Text)
    -> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "mixed-citation" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
      WriterOptions -> [Inline] -> JATS m (Doc Text)
    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
      refs <- (JATSEnv m -> [Reference Inlines])
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Reference Inlines]
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks JATSEnv m -> [Reference Inlines]
    forall (m :: * -> *). JATSEnv m -> [Reference Inlines]
    jatsReferences
      contents <- if null refs
                  then blocksToJATS opts xs
                  else do
                    titleElement <- case xs of
                      (Header Int
    _ (Text, [Text], [(Text, Text)])
    _ [Inline]
    title:[Block]
    _) ->
                        Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "title" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    title
                      [Block]
    _ -> Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Monoid a => a
    mempty
                    elementRefs <- referencesToJATS opts refs
                    return $ titleElement $$ elementRefs
      return $ inTagsIndented "ref-list" contents
    blockToJATS WriterOptions
    opts (Div (Text
    ident,[Text
    cls],[(Text, Text)]
    kvs) [Block]
    bs) | Text
    cls Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text
    "fig", Text
    "caption", Text
    "table-wrap"] = do
      contents <- WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS WriterOptions
    opts [Block]
    bs
      let attr = [(Text
    "id", Text -> Text
    escapeNCName Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    "xml:lang",Text
    l) | (Text
    "lang",Text
    l) <- [(Text, Text)]
    kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text
    "specific-use",
                     Text
    "content-type", Text
    "orientation", Text
    "position"]]
      return $ inTags True cls attr contents
    blockToJATS WriterOptions
    opts (Div (Text
    ident,[Text]
    _,[(Text, Text)]
    kvs) [Block]
    bs) = do
      contents <- WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS WriterOptions
    opts [Block]
    bs
      let attr = [(Text
    "id", Text -> Text
    escapeNCName Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    "xml:lang",Text
    l) | (Text
    "lang",Text
    l) <- [(Text, Text)]
    kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text
    "specific-use",
                     Text
    "content-type", Text
    "orientation", Text
    "position"]]
      return $ inTags True "boxed-text" attr contents
    blockToJATS WriterOptions
    opts (Header Int
    _ (Text, [Text], [(Text, Text)])
    _ [Inline]
    title) = do
      title' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts ((Inline -> Inline) -> [Inline] -> [Inline]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Inline
    fixLineBreak [Inline]
    title)
      return $ inTagsSimple "title" 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]) =
      Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
    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]) =
      Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
    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) = WriterOptions -> Block -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS WriterOptions
    opts ([Inline] -> Block
    Para [Inline]
    lst)
    blockToJATS WriterOptions
    opts (Para [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "p" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    blockToJATS WriterOptions
    opts (LineBlock [[Inline]]
    lns) =
      WriterOptions -> Block -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS WriterOptions
    opts (Block -> JATS m (Doc Text)) -> Block -> JATS m (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ [[Inline]] -> Block
    linesToPara [[Inline]]
    lns
    blockToJATS WriterOptions
    opts (BlockQuote [Block]
    blocks) = do
      tagSet <- (JATSEnv m -> JATSTagSet)
    -> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks JATSEnv m -> JATSTagSet
    forall (m :: * -> *). JATSEnv m -> JATSTagSet
    jatsTagSet
      let needsWrap = if JATSTagSet
    tagSet JATSTagSet -> JATSTagSet -> Bool
    forall a. Eq a => a -> a -> Bool
    == JATSTagSet
    TagSetArticleAuthoring
                      then Bool -> Bool
    not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
    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
      inTagsIndented "disp-quote" <$> wrappedBlocksToJATS needsWrap opts blocks
    blockToJATS WriterOptions
    opts (CodeBlock (Text, [Text], [(Text, Text)])
    a Text
    str) = Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
    forall a b. (a -> b) -> a -> b
    $
      Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    False Text
    tag [(Text, Text)]
    attr (Doc Text -> Doc Text
    forall a. Doc a -> Doc a
    flush (String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (Text -> String
    T.unpack (Text -> String) -> Text -> String
    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 []) = Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToJATS WriterOptions
    opts (BulletList [[Block]]
    lst) =
      Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    True Text
    "list" [(Text
    "list-type", Text
    "bullet")] (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
      WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
    listItemsToJATS WriterOptions
    opts Maybe [Text]
    forall a. Maybe a
    Nothing [[Block]]
    lst
    blockToJATS WriterOptions
    _ (OrderedList ListAttributes
    _ []) = Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToJATS WriterOptions
    opts (OrderedList (Int
    start, ListNumberStyle
    numstyle, ListNumberDelim
    delimstyle) [[Block]]
    items) = do
      tagSet <- (JATSEnv m -> JATSTagSet)
    -> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks JATSEnv m -> JATSTagSet
    forall (m :: * -> *). JATSEnv m -> JATSTagSet
    jatsTagSet
      let listType =
            -- The Article Authoring tag set doesn't allow a more specific
            -- @list-type@ attribute than "order".
            if JATSTagSet
    tagSet JATSTagSet -> JATSTagSet -> Bool
    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 = Int
    start Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 Bool -> Bool -> Bool
    && (ListNumberDelim
    delimstyle ListNumberDelim -> ListNumberDelim -> Bool
    forall a. Eq a => a -> a -> Bool
    == ListNumberDelim
    DefaultDelim Bool -> Bool -> Bool
    ||
                                      ListNumberDelim
    delimstyle ListNumberDelim -> ListNumberDelim -> Bool
    forall a. Eq a => a -> a -> Bool
    == ListNumberDelim
    Period)
      let markers = if Bool
    simpleList
                       then Maybe [Text]
    forall a. Maybe a
    Nothing
                       else [Text] -> Maybe [Text]
    forall a. a -> Maybe a
    Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
    forall a b. (a -> b) -> a -> b
    $
                              ListAttributes -> [Text]
    orderedListMarkers (Int
    start, ListNumberStyle
    numstyle, ListNumberDelim
    delimstyle)
      inTags True "list" [("list-type", listType)] <$>
        listItemsToJATS opts markers items
    blockToJATS WriterOptions
    opts (DefinitionList [([Inline], [[Block]])]
    lst) =
      Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    True Text
    "def-list" [] (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
    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 Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Format
    "jats"    = Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (String -> Doc Text) -> String -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    str -- raw XML block
      | Bool
    otherwise      = do
          LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ())
    -> LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
    forall a b. (a -> b) -> a -> b
    $ Block -> LogMessage
    BlockNotRendered Block
    b
          Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToJATS WriterOptions
    _ Block
    HorizontalRule = Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    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) =
      WriterOptions -> Table -> JATS m (Doc Text)
    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
              | [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    alt Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Block] -> Text
    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
      capt <- if [Block] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Block]
    longcapt
              then Doc Text -> JATS m (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Doc Text
    forall a. Doc a
    empty
              else Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "caption" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS WriterOptions
    opts [Block]
    longcapt
      figbod <- blocksToJATS opts $ walk unsetAltIfDupl body
      let figattr = [(Text
    "id", Text -> Text
    escapeNCName Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                    [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs
                           , Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ Text
    "fig-type", Text
    "orientation"
                                      , Text
    "position", Text
    "specific-use"]]
      return $ inTags True "fig" figattr $ capt $$ 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 = [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    hcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Inline -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (WriterOptions
    -> Inline -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    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 Inline -> [Inline] -> [Inline]
    forall a. a -> [a] -> [a]
    : Text -> Inline
    Str ([Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    ys) Inline -> [Inline] -> [Inline]
    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)                 = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Inline -> Bool
    isRawInline [Inline]
    xs
       fixCitations (Inline
    x:[Inline]
    xs) = Inline
    x Inline -> [Inline] -> [Inline]
    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) = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (String -> Doc Text) -> String -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    escapeStringForXML Text
    str
    inlineToJATS WriterOptions
    opts (Emph [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "italic" (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS WriterOptions
    opts (Underline [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "underline" (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS WriterOptions
    opts (Strong [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "bold" (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS WriterOptions
    opts (Strikeout [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "strike" (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS WriterOptions
    opts (Superscript [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "sup" (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS WriterOptions
    opts (Subscript [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "sub" (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS WriterOptions
    opts (SmallCaps [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "sc" (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS WriterOptions
    opts (Quoted QuoteType
    SingleQuote [Inline]
    lst) = do
      contents <- WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
      return $ char '‘' <> contents <> char '’'
    inlineToJATS WriterOptions
    opts (Quoted QuoteType
    DoubleQuote [Inline]
    lst) = do
      contents <- WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
      return $ char '“' <> contents <> char '”'
    inlineToJATS WriterOptions
    opts (Code (Text, [Text], [(Text, Text)])
    a Text
    str) =
      Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
    inTags Bool
    False Text
    "monospace" [(Text, Text)]
    attr (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc Text
    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 Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == Format
    "jats" = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc Text
    forall a. HasChars a => a -> Doc a
    literal Text
    x
      | Bool
    otherwise   = do
          LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ())
    -> LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
    forall a b. (a -> b) -> a -> b
    $ Inline -> LogMessage
    InlineNotRendered Inline
    il
          Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    inlineToJATS WriterOptions
    _ Inline
    LineBreak = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    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 = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    space
    inlineToJATS WriterOptions
    opts Inline
    SoftBreak
      | WriterOptions -> WrapOption
    writerWrapText WriterOptions
    opts WrapOption -> WrapOption -> Bool
    forall a. Eq a => a -> a -> Bool
    == WrapOption
    WrapPreserve = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    cr
      | Bool
    otherwise = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    space
    inlineToJATS WriterOptions
    opts (Note [Block]
    contents) = do
      tagSet <- (JATSEnv m -> JATSTagSet)
    -> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks JATSEnv m -> JATSTagSet
    forall (m :: * -> *). JATSEnv m -> JATSTagSet
    jatsTagSet
      -- Footnotes must occur inline when using the Article Authoring tag set.
      if tagSet == TagSetArticleAuthoring
        then inTagsIndented "fn" <$> wrappedBlocksToJATS (not . isPara) opts contents
        else do
          notes <- gets jatsNotes
          let notenum = case [(Int, Doc Text)]
    notes of
                          (Int
    n, Doc Text
    _):[(Int, Doc Text)]
    _ -> Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                          []       -> Int
    1
          thenote <- inTags True "fn" [("id", "fn" <> tshow notenum)]
                         . (inTagsSimple "label" (literal $ tshow notenum) <>)
                        <$> wrappedBlocksToJATS (not . isPara) opts
                             (walk demoteHeaderAndRefs contents)
          modify $ \JATSState
    st -> JATSState
    st{ jatsNotes = (notenum, thenote) : notes }
          return $ inTags False "xref" [("ref-type", "fn"),
                                        ("rid", "fn" <> tshow notenum)]
                 $ text (show notenum)
    inlineToJATS WriterOptions
    opts (Cite [Citation]
    _ [Inline]
    lst) =
      WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    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
      contents <- WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    ils
      let commonAttr = [(Text
    "id", Text -> Text
    escapeNCName Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                       [(Text
    "xml:lang",Text
    l) | (Text
    "lang",Text
    l) <- [(Text, Text)]
    kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                       [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs,  Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 (tag, specificAttr) =
            case lookup "content-type" kvs <|> listToMaybe classes of
              Just Text
    ct -> ( Text
    "named-content"
                         , (Text
    "content-type", Text
    ct) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall a. a -> [a] -> [a]
    :
                           [(Text
    k, Text
    v) | (Text
    k, Text
    v) <- [(Text, Text)]
    kvs
                           , Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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)]
    commonAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++ [(Text, Text)]
    specificAttr
      -- unwrap if wrapping element would have no attributes
      return $
        if null attr
        then contents
        else inTags False tag attr 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 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "xmlns" = QName -> String -> Attr
    Xml.Attr QName
    q{ Xml.qName = "xmlns:mml" } String
    v
             | Bool
    otherwise = QName -> String -> Attr
    Xml.Attr QName
    q String
    v
      let fixNS' :: Element -> Element
    fixNS' Element
    e = Element
    e{ Xml.elName =
                             (Xml.elName e){ Xml.qPrefix = Just "mml" } }
      let fixNS :: Element -> Element
    fixNS = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere ((Element -> Element) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT Element -> Element
    fixNS') (Element -> Element) -> (Element -> Element) -> Element -> Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                  (\Element
    e -> Element
    e{ Xml.elAttribs = map addPref (Xml.elAttribs e) })
      let conf :: ConfigPP
    conf = (QName -> Bool) -> ConfigPP -> ConfigPP
    Xml.useShortEmptyTags (Bool -> QName -> Bool
    forall a b. a -> b -> a
    const Bool
    False) ConfigPP
    Xml.defaultConfigPP
      res <- (DisplayType -> [Exp] -> Element)
    -> MathType
    -> Text
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Either Inline Element)
    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 = case MathType
    t of
                         MathType
    DisplayMath -> Text
    "disp-formula"
                         MathType
    InlineMath  -> Text
    "inline-formula"

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

      tagSet <- asks jatsTagSet
      return . inTagsSimple tagtype $
        case res of
          Right Element
    r  -> let mathMl :: Doc Text
    mathMl = String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (ConfigPP -> Element -> String
    Xml.ppcElement ConfigPP
    conf (Element -> String) -> Element -> String
    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 JATSTagSet -> JATSTagSet -> Bool
    forall a. Eq a => a -> a -> Bool
    == JATSTagSet
    TagSetArticleAuthoring
                         then Doc Text
    mathMl
                         else Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "alternatives" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $
                              Doc Text
    forall a. Doc a
    cr Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    texMath Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    mathMl
          Left Inline
    _   -> if JATSTagSet
    tagSet JATSTagSet -> JATSTagSet -> Bool
    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 Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    email =
      Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "email" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Doc Text
    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 = [[(Text, Text)]] -> [(Text, Text)]
    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", [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    txt) | Bool -> Bool
    not ([Inline] -> Bool
    forall a. [a] -> Bool
    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 Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 [Inline] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    txt
         then Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> [(Text, Text)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag Text
    "xref" [(Text, Text)]
    attr
         else do
            contents <- WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    txt
            return $ inTags False "xref" attr 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)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    "ext-link-type", Text
    "uri"),
                  (Text
    "xlink:href", Text
    src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    "xlink:title", Text
    tit) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    tit)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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"]]
      contents <- WriterOptions
    -> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    txt
      return $ inTags False "ext-link" attr 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
      Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ case [Inline] -> Maybe (Doc Text)
    altToJATS [Inline]
    alt of
                 Maybe (Doc Text)
    Nothing -> Text -> [(Text, Text)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag Text
    "inline-graphic" [(Text, Text)]
    elattr
                 Just Doc Text
    altTag -> Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
    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 -> Text -> [(Text, Text)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag Text
    "graphic" [(Text, Text)]
    elattr
           Just Doc Text
    altTag -> Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
    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)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
         [ (Text
    "mimetype", Text
    maintype)
         , (Text
    "mime-subtype", Text
    subtype)
         , (Text
    "xlink:href", Text
    src)
         ] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
         [(Text
    "xlink:title", Text
    tit) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    tit)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
         [(Text
    k,Text
    v) | (Text
    k,Text
    v) <- [(Text, Text)]
    kvs
                , Text
    k Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    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 [Inline] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    alt
      then Maybe (Doc Text)
    forall a. Maybe a
    Nothing
      else Doc Text -> Maybe (Doc Text)
    forall a. a -> Maybe a
    Just (Doc Text -> Maybe (Doc Text))
    -> (Text -> Doc Text) -> Text -> Maybe (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple Text
    "alt-text" (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
           [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    hsep ([Doc Text] -> Doc Text)
    -> (Text -> [Doc Text]) -> Text -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Doc Text) -> [Text] -> [Doc Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Doc Text
    forall a. HasChars a => a -> Doc a
    literal ([Text] -> [Doc Text]) -> (Text -> [Text]) -> Text -> [Doc Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    T.words (Text -> Maybe (Doc Text)) -> Text -> Maybe (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ [Inline] -> Text
    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 = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "image" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $
                      Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "mimetype" [(Text, Text)]
    kvs Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                      ((Char -> Bool) -> Text -> Text
    T.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '/') (Text -> Text) -> Maybe Text -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Text
    mbMT)
          subtype :: Text
    subtype = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $
                      Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "mime-subtype" [(Text, Text)]
    kvs Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                      (Int -> Text -> Text
    T.drop Int
    1 (Text -> Text) -> (Text -> Text) -> Text -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> Text -> Text
    T.dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '/') (Text -> Text) -> Maybe Text -> Maybe Text
    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 = [Maybe Day] -> Maybe Day
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum ((String -> Maybe Day) -> [String] -> [Maybe Day]
    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 = Bool -> TimeLocale -> String -> String -> Maybe Day
    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"]