    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns #-}
    {- |
       Module      : Text.Pandoc.Writers.JATS
       Copyright   : Copyright (C) 2017-2020 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.Monad.Reader
    import Control.Monad.State
    import Data.Generics (everywhere, mkT)
    import Data.List (partition)
    import qualified Data.Map as M
    import Data.Maybe (fromMaybe)
    import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
    import qualified Data.Text as T
    import Data.Text (Text)
    import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
    import Text.Pandoc.Definition
    import Text.Pandoc.Highlighting (languages, languagesByExtension)
    import Text.Pandoc.Logging
    import Text.Pandoc.MIME (getMimeType)
    import Text.Pandoc.Walk (walk)
    import Text.Pandoc.Options
    import Text.DocLayout
    import Text.Pandoc.Shared
    import Text.Pandoc.Templates (renderTemplate)
    import Text.DocTemplates (Context(..), Val(..))
    import Text.Pandoc.Writers.Math
    import Text.Pandoc.Writers.Shared
    import Text.Pandoc.XML
    import Text.TeXMath
    import qualified Text.XML.Light as Xml

    -- | JATS tag set variant
    data JATSTagSet
      = TagSetArchiving         -- ^ Archiving and Interchange Tag Set
      | TagSetPublishing        -- ^ Journal Publishing Tag Set
      | TagSetArticleAuthoring  -- ^ Article Authoring Tag Set
      deriving (JATSTagSet -> JATSTagSet -> Bool
    (JATSTagSet -> JATSTagSet -> Bool)
    -> (JATSTagSet -> JATSTagSet -> Bool) -> Eq JATSTagSet
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: JATSTagSet -> JATSTagSet -> Bool
    $c/= :: JATSTagSet -> JATSTagSet -> Bool
    == :: JATSTagSet -> JATSTagSet -> Bool
    $c== :: JATSTagSet -> JATSTagSet -> Bool
    Eq)

    -- | Internal state used by the writer.
    newtype JATSState = JATSState
      { JATSState -> [(Int, Doc Text)]
    jatsNotes :: [(Int, Doc Text)] }

    -- | JATS writer type
    type JATS a = StateT JATSState (ReaderT JATSTagSet a)

    -- | Convert a @'Pandoc'@ document to JATS (Archiving and Interchange
    -- Tag Set.)
    writeJatsArchiving :: PandocMonad m => WriterOptions -> Pandoc -> m Text
    writeJatsArchiving :: 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 :: 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 :: 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.
    writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text
    writeJATS :: 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 :: JATSTagSet -> WriterOptions -> Pandoc -> m Text
    writeJats tagSet :: JATSTagSet
    tagSet opts :: WriterOptions
    opts d :: Pandoc
    d =
      ReaderT JATSTagSet m Text -> JATSTagSet -> m Text
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (StateT JATSState (ReaderT JATSTagSet m) Text
    -> JATSState -> ReaderT JATSTagSet m Text
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (WriterOptions
    -> Pandoc -> StateT JATSState (ReaderT JATSTagSet m) Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> JATS m Text
    docToJATS WriterOptions
    opts Pandoc
    d)
                   (JATSState :: [(Int, Doc Text)] -> JATSState
    JATSState{ jatsNotes :: [(Int, Doc Text)]
    jatsNotes = [] }))
                 JATSTagSet
    tagSet

    -- | Convert Pandoc document to string in JATS format.
    docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text
    docToJATS :: WriterOptions -> Pandoc -> JATS m Text
    docToJATS opts :: WriterOptions
    opts (Pandoc meta :: Meta
    meta blocks :: [Block]
    blocks) = do
      let isBackBlock :: Block -> Bool
    isBackBlock (Div ("refs",_,_) _) = Bool
    True
          isBackBlock _                    = Bool
    False
      let (backblocks :: [Block]
    backblocks, bodyblocks :: [Block]
    bodyblocks) = (Block -> Bool) -> [Block] -> ([Block], [Block])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Block -> Bool
    isBackBlock [Block]
    blocks
      -- The numbering here follows LaTeX's internal numbering
      let startLvl :: Int
    startLvl = case WriterOptions -> TopLevelDivision
    writerTopLevelDivision WriterOptions
    opts of
                       TopLevelPart    -> -1
                       TopLevelChapter -> 0
                       TopLevelSection -> 1
                       TopLevelDefault -> 1
      let fromBlocks :: [Block] -> JATS m (Doc Text)
    fromBlocks = WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS WriterOptions
    opts ([Block] -> JATS m (Doc Text))
    -> ([Block] -> [Block]) -> [Block] -> JATS 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)
      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
      Context Text
    metadata <- WriterOptions
    -> ([Block] -> JATS m (Doc Text))
    -> ([Inline] -> JATS m (Doc Text))
    -> Meta
    -> StateT JATSState (ReaderT JATSTagSet 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
                     [Block] -> JATS m (Doc Text)
    fromBlocks
                     ((Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Doc Text -> Doc Text
    forall a. Doc a -> Doc a
    chomp (JATS m (Doc Text) -> JATS m (Doc Text))
    -> ([Inline] -> JATS m (Doc Text)) -> [Inline] -> JATS m (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts)
                     Meta
    meta
      Doc Text
    main <- [Block] -> JATS m (Doc Text)
    fromBlocks [Block]
    bodyblocks
      [Doc Text]
    notes <- [Doc Text] -> [Doc Text]
    forall a. [a] -> [a]
    reverse ([Doc Text] -> [Doc Text])
    -> ([(Int, Doc Text)] -> [Doc Text])
    -> [(Int, Doc Text)]
    -> [Doc Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, Doc Text) -> Doc Text) -> [(Int, Doc Text)] -> [Doc Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, Doc Text) -> Doc Text
    forall a b. (a, b) -> b
    snd ([(Int, Doc Text)] -> [Doc Text])
    -> StateT JATSState (ReaderT JATSTagSet m) [(Int, Doc Text)]
    -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (JATSState -> [(Int, Doc Text)])
    -> StateT JATSState (ReaderT JATSTagSet m) [(Int, Doc Text)]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets JATSState -> [(Int, Doc Text)]
    jatsNotes
      Doc Text
    backs <- [Block] -> JATS m (Doc Text)
    fromBlocks [Block]
    backblocks
      JATSTagSet
    tagSet <- StateT JATSState (ReaderT JATSTagSet m) JATSTagSet
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      -- In the "Article Authoring" tag set, occurrence of fn-group elements
      -- is restricted to table footers. Footnotes have to be placed inline.
      let fns :: Doc Text
    fns = if [Doc Text] -> 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 "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
    back = Doc Text
    backs Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    fns
      let date :: Val Text
    date =
            case Text -> Context Text -> Maybe (Val Text)
    forall a b. FromContext a b => Text -> Context a -> Maybe b
    getField "date" Context Text
    metadata of
              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
                   Nothing  -> Val Text
    forall a. Val a
    NullVal
                   Just day :: Day
    day ->
                     let (y :: Integer
    y,m :: Int
    m,d :: 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
                          [("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)
                          ,("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)
                          ,("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)
                          ,("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 "%F" Day
    day)
                          ]
              Just x :: Val Text
    x -> Val Text
    x
      let context :: Context Text
    context = Text -> Doc Text -> Context Text -> Context Text
    forall a b. ToContext a b => Text -> b -> Context a -> Context a
    defField "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 "back" Doc Text
    back
                  (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 "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 "mathml" (case WriterOptions -> HTMLMathMethod
    writerHTMLMathMethod WriterOptions
    opts of
                                            MathML -> Bool
    True
                                            _      -> Bool
    False) Context Text
    metadata
      Text -> JATS m Text
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> JATS m Text) -> Text -> JATS m Text
    forall a b. (a -> b) -> a -> b
    $ Maybe Int -> Doc Text -> Text
    forall a. HasChars a => Maybe Int -> Doc a -> a
    render Maybe Int
    colwidth (Doc Text -> Text) -> Doc Text -> Text
    forall a b. (a -> b) -> a -> b
    $
        (if WriterOptions -> Bool
    writerPreferAscii WriterOptions
    opts then (Text -> Text) -> Doc Text -> Doc Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> Text
    toEntities else Doc Text -> Doc Text
    forall a. a -> a
    id) (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $
        case WriterOptions -> Maybe (Template Text)
    writerTemplate WriterOptions
    opts of
           Nothing  -> Doc Text
    main
           Just tpl :: 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 :: 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 :: (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    wrappedBlocksToJATS needsWrap :: Block -> Bool
    needsWrap opts :: WriterOptions
    opts =
      ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text]
    -> JATS m (Doc Text)
    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 JATSTagSet m) [Doc Text]
     -> JATS m (Doc Text))
    -> ([Block] -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text])
    -> [Block]
    -> JATS m (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Block -> JATS m (Doc Text))
    -> [Block] -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Block -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    Block -> StateT JATSState (ReaderT JATSTagSet m) (Doc Text)
    wrappedBlockToJATS
      where
        wrappedBlockToJATS :: Block -> StateT JATSState (ReaderT JATSTagSet m) (Doc Text)
    wrappedBlockToJATS b :: Block
    b = do
          Doc Text
    inner <- WriterOptions
    -> Block -> StateT JATSState (ReaderT JATSTagSet m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS WriterOptions
    opts Block
    b
          Doc Text -> StateT JATSState (ReaderT JATSTagSet m) (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> StateT JATSState (ReaderT JATSTagSet m) (Doc Text))
    -> Doc Text -> StateT JATSState (ReaderT JATSTagSet m) (Doc Text)
    forall a b. (a -> b) -> a -> b
    $
            if Block -> Bool
    needsWrap Block
    b
               then 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 "p" [("specific-use","wrapper")] Doc Text
    inner
               else Doc Text
    inner

    -- | Auxiliary function to convert Plain block to Para.
    plainToPara :: Block -> Block
    plainToPara :: Block -> Block
    plainToPara (Plain x :: [Inline]
    x) = [Inline] -> Block
    Para [Inline]
    x
    plainToPara x :: 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 :: WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
    deflistItemsToJATS opts :: WriterOptions
    opts items :: [([Inline], [[Block]])]
    items =
      [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text]
    -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([Inline], [[Block]]) -> JATS m (Doc Text))
    -> [([Inline], [[Block]])]
    -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (([Inline] -> [[Block]] -> JATS m (Doc Text))
    -> ([Inline], [[Block]]) -> JATS m (Doc Text)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (WriterOptions -> [Inline] -> [[Block]] -> JATS 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 :: WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text)
    deflistItemToJATS opts :: WriterOptions
    opts term :: [Inline]
    term defs :: [[Block]]
    defs = do
      Doc Text
    term' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    term
      Doc Text
    def' <- (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
    isPara)
                  WriterOptions
    opts ([Block] -> JATS m (Doc Text)) -> [Block] -> JATS m (Doc Text)
    forall a b. (a -> b) -> a -> b
    $ ([Block] -> [Block]) -> [[Block]] -> [Block]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Block -> Block) -> [Block] -> [Block]
    forall a b. Walkable a b => (a -> a) -> b -> b
    walk Block -> Block
    demoteHeaderAndRefs ([Block] -> [Block]) -> ([Block] -> [Block]) -> [Block] -> [Block]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                    (Block -> Block) -> [Block] -> [Block]
    forall a b. (a -> b) -> [a] -> [b]
    map Block -> Block
    plainToPara) [[Block]]
    defs
      Doc Text -> JATS m (Doc Text)
    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 -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "def-item" (Doc Text -> Doc Text) -> Doc Text -> 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 "term" Doc Text
    term' Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$
          Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "def" Doc Text
    def'

    -- | Convert a list of lists of blocks to a list of JATS list items.
    listItemsToJATS :: PandocMonad m
                    => WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
    listItemsToJATS :: WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
    listItemsToJATS opts :: WriterOptions
    opts markers :: Maybe [Text]
    markers items :: [[Block]]
    items =
      case Maybe [Text]
    markers of
           Nothing -> [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet 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 JATSTagSet m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t 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 ms :: [Text]
    ms -> [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet 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 JATSTagSet 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 :: WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
    listItemToJATS opts :: WriterOptions
    opts mbmarker :: Maybe Text
    mbmarker item :: [Block]
    item = do
      Doc Text
    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)
      Doc Text -> JATS m (Doc Text)
    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 -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "list-item" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $
               Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc Text
    forall a. Doc a
    empty (\lbl :: Text
    lbl -> Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "label" (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
    lbl)) Maybe Text
    mbmarker
               Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    contents

    imageMimeType :: Text -> [(Text, Text)] -> (Text, Text)
    imageMimeType :: Text -> [(Text, Text)] -> (Text, Text)
    imageMimeType src :: Text
    src kvs :: [(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 "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 "mimetype" [(Text, Text)]
    kvs Maybe Text -> Maybe Text -> Maybe Text
    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
    /='/') (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 "" (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 "mime-subtype" [(Text, Text)]
    kvs Maybe Text -> Maybe Text -> Maybe Text
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                      ((Int -> Text -> Text
    T.drop 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
    /='/')) (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)

    languageFor :: [Text] -> Text
    languageFor :: [Text] -> Text
    languageFor classes :: [Text]
    classes =
      case [Text]
    langs of
         (l :: Text
    l:_) -> Text -> Text
    escapeStringForXML Text
    l
         []    -> ""
        where isLang :: Text -> Bool
    isLang l :: Text
    l    = Text -> Text
    T.toLower Text
    l Text -> [Text] -> 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 [Text]
    languages
              langsFrom :: Text -> [Text]
    langsFrom s :: Text
    s = if Text -> Bool
    isLang Text
    s
                               then [Text
    s]
                               else Text -> [Text]
    languagesByExtension (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 :: Attr -> (Text, [(Text, Text)])
    codeAttr :: Attr -> (Text, [(Text, Text)])
    codeAttr (ident :: Text
    ident,classes :: [Text]
    classes,kvs :: [(Text, Text)]
    kvs) = (Text
    lang, [(Text, Text)]
    attr)
        where
           attr :: [(Text, Text)]
    attr = [("id",Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                  [("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) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["code-type",
                    "code-version", "executable",
                    "language-version", "orientation",
                        "platforms", "position", "specific-use"]]
           lang :: Text
    lang  = [Text] -> Text
    languageFor [Text]
    classes

    -- | Convert a Pandoc block element to JATS.
    blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS :: WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS _ Null = Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToJATS opts :: WriterOptions
    opts (Div (id' :: Text
    id',"section":_,kvs :: [(Text, Text)]
    kvs) (Header _lvl :: Int
    _lvl _ ils :: [Inline]
    ils : xs :: [Block]
    xs)) = do
      let idAttr :: [(Text, Text)]
    idAttr = [("id", WriterOptions -> Text
    writerIdentifierPrefix WriterOptions
    opts Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    id') | Bool -> Bool
    not (Text -> Bool
    T.null Text
    id')]
      let otherAttrs :: [Text]
    otherAttrs = ["sec-type", "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) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    otherAttrs]
      Doc Text
    title' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    ils
      Doc Text
    contents <- WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS WriterOptions
    opts [Block]
    xs
      Doc Text -> JATS m (Doc Text)
    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
    True "sec" [(Text, Text)]
    attribs (Doc Text -> Doc Text) -> Doc Text -> 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 "title" Doc Text
    title' Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    contents
    -- Bibliography reference:
    blockToJATS opts :: WriterOptions
    opts (Div (Text -> Text -> Maybe Text
    T.stripPrefix "ref-" -> Just _,_,_) [Para lst :: [Inline]
    lst]) =
      WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    blockToJATS opts :: WriterOptions
    opts (Div ("refs",_,_) xs :: [Block]
    xs) = do
      Doc Text
    contents <- WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS WriterOptions
    opts [Block]
    xs
      Doc Text -> JATS m (Doc Text)
    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 -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "ref-list" Doc Text
    contents
    blockToJATS opts :: WriterOptions
    opts (Div (ident :: Text
    ident,[cls :: Text
    cls],kvs :: [(Text, Text)]
    kvs) bs :: [Block]
    bs) | Text
    cls Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["fig", "caption", "table-wrap"] = do
      Doc Text
    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, Text)]
    attr = [("id", Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("xml:lang",Text
    l) | ("lang",l :: Text
    l) <- [(Text, Text)]
    kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    k,Text
    v) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["specific-use",
                     "content-type", "orientation", "position"]]
      Doc Text -> JATS m (Doc Text)
    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
    True Text
    cls [(Text, Text)]
    attr Doc Text
    contents
    blockToJATS opts :: WriterOptions
    opts (Div (ident :: Text
    ident,_,kvs :: [(Text, Text)]
    kvs) bs :: [Block]
    bs) = do
      Doc Text
    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, Text)]
    attr = [("id", Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("xml:lang",Text
    l) | ("lang",l :: Text
    l) <- [(Text, Text)]
    kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    k,Text
    v) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["specific-use",
                     "content-type", "orientation", "position"]]
      Doc Text -> JATS m (Doc Text)
    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
    True "boxed-text" [(Text, Text)]
    attr Doc Text
    contents
    blockToJATS opts :: WriterOptions
    opts (Header _ _ title :: [Inline]
    title) = do
      Doc Text
    title' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    title
      Doc Text -> JATS m (Doc Text)
    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 -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "title" Doc Text
    title'
    -- No Plain, everything needs to be in a block-level tag
    blockToJATS opts :: WriterOptions
    opts (Plain lst :: [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)
    -- title beginning with fig: indicates that the image is a figure
    blockToJATS opts :: WriterOptions
    opts (Para [Image (ident :: Text
    ident,_,kvs :: [(Text, Text)]
    kvs) txt :: [Inline]
    txt
      (src :: Text
    src,Text -> Text -> Maybe Text
    T.stripPrefix "fig:" -> Just tit :: Text
    tit)]) = do
      Doc Text
    alt <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    txt
      let (maintype :: Text
    maintype, subtype :: Text
    subtype) = Text -> [(Text, Text)] -> (Text, Text)
    imageMimeType Text
    src [(Text, Text)]
    kvs
      let capt :: Doc Text
    capt = if [Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    txt
                    then 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 "caption" (Doc Text -> Doc Text) -> Doc Text -> 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 "p" Doc Text
    alt
      let attr :: [(Text, Text)]
    attr = [("id", 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) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["fig-type", "orientation",
                                                  "position", "specific-use"]]
      let graphicattr :: [(Text, Text)]
    graphicattr = [("mimetype",Text
    maintype),
                         ("mime-subtype",Text
    subtype),
                         ("xlink:href",Text
    src),  -- do we need to URL escape this?
                         ("xlink:title",Text
    tit)]
      Doc Text -> JATS m (Doc Text)
    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
    True "fig" [(Text, Text)]
    attr (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $
                  Doc Text
    capt Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Text -> [(Text, Text)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag "graphic" [(Text, Text)]
    graphicattr
    blockToJATS _ (Para [Image (ident :: Text
    ident,_,kvs :: [(Text, Text)]
    kvs) _ (src :: Text
    src, tit :: Text
    tit)]) = do
      let (maintype :: Text
    maintype, subtype :: Text
    subtype) = Text -> [(Text, Text)] -> (Text, Text)
    imageMimeType Text
    src [(Text, Text)]
    kvs
      let attr :: [(Text, Text)]
    attr = [("id", Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("mimetype", Text
    maintype),
                  ("mime-subtype", Text
    subtype),
                  ("xlink:href", Text
    src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("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) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["baseline-shift",
                            "content-type", "specific-use", "xlink:actuate",
                            "xlink:href", "xlink:role", "xlink:show",
                            "xlink:type"]]
      Doc Text -> JATS m (Doc Text)
    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)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag "graphic" [(Text, Text)]
    attr
    blockToJATS opts :: WriterOptions
    opts (Para lst :: [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "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 opts :: WriterOptions
    opts (LineBlock lns :: [[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 opts :: WriterOptions
    opts (BlockQuote blocks :: [Block]
    blocks) = do
      JATSTagSet
    tagSet <- StateT JATSState (ReaderT JATSTagSet m) JATSTagSet
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      let blocksToJats' :: WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJats' = if JATSTagSet
    tagSet JATSTagSet -> JATSTagSet -> Bool
    forall a. Eq a => a -> a -> Bool
    == JATSTagSet
    TagSetArticleAuthoring
                          then (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
    isPara)
                          else WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Block] -> JATS m (Doc Text)
    blocksToJATS
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "disp-quote" (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)
    blocksToJats' WriterOptions
    opts [Block]
    blocks
    blockToJATS _ (CodeBlock a :: Attr
    a str :: Text
    str) = Doc Text -> JATS m (Doc Text)
    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 (lang :: Text
    lang, attr :: [(Text, Text)]
    attr) = Attr -> (Text, [(Text, Text)])
    codeAttr Attr
    a
              tag :: Text
    tag          = if Text -> Bool
    T.null Text
    lang then "preformat" else "code"
    blockToJATS _ (BulletList []) = Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToJATS opts :: WriterOptions
    opts (BulletList lst :: [[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 "list" [("list-type", "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 _ (OrderedList _ []) = Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToJATS opts :: WriterOptions
    opts (OrderedList (start :: Int
    start, numstyle :: ListNumberStyle
    numstyle, delimstyle :: ListNumberDelim
    delimstyle) items :: [[Block]]
    items) = do
      JATSTagSet
    tagSet <- StateT JATSState (ReaderT JATSTagSet m) JATSTagSet
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      let listType :: Text
    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 "order"
            else case ListNumberStyle
    numstyle of
                   DefaultStyle -> "order"
                   Decimal      -> "order"
                   Example      -> "order"
                   UpperAlpha   -> "alpha-upper"
                   LowerAlpha   -> "alpha-lower"
                   UpperRoman   -> "roman-upper"
                   LowerRoman   -> "roman-lower"
      let simpleList :: Bool
    simpleList = Int
    start Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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 :: Maybe [Text]
    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
    $
                              (Int, ListNumberStyle, ListNumberDelim) -> [Text]
    orderedListMarkers (Int
    start, ListNumberStyle
    numstyle, ListNumberDelim
    delimstyle)
      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 "list" [("list-type", Text
    listType)] (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]
    markers [[Block]]
    items
    blockToJATS opts :: WriterOptions
    opts (DefinitionList lst :: [([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 "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 _ b :: Block
    b@(RawBlock f :: Format
    f str :: Text
    str)
      | Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == "jats"    = Doc Text -> JATS m (Doc Text)
    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 JATSTagSet m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT JATSState (ReaderT JATSTagSet m) ())
    -> LogMessage -> StateT JATSState (ReaderT JATSTagSet m) ()
    forall a b. (a -> b) -> a -> b
    $ Block -> LogMessage
    BlockNotRendered Block
    b
          Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    blockToJATS _ HorizontalRule = Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty -- not semantic
    blockToJATS opts :: WriterOptions
    opts (Table [] aligns :: [Alignment]
    aligns widths :: [Double]
    widths headers :: [[Block]]
    headers rows :: [[[Block]]]
    rows) = do
      let percent :: a -> Text
    percent w :: a
    w    = Integer -> Text
    forall a. Show a => a -> Text
    tshow (a -> Integer
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (100a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    w) :: Integer) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "*"
      let coltags :: Doc Text
    coltags = [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ (Double -> Alignment -> Doc Text)
    -> [Double] -> [Alignment] -> [Doc Text]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\w :: Double
    w al :: Alignment
    al -> Text -> [(Text, Text)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag "col"
                           ([("width", Double -> Text
    forall a. RealFrac a => a -> Text
    percent Double
    w) | Double
    w Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                            [("align", Alignment -> Text
    alignmentToText Alignment
    al)])) [Double]
    widths [Alignment]
    aligns
      Doc Text
    thead <- if ([Block] -> Bool) -> [[Block]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all [Block] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Block]]
    headers
                  then Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
                  else Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "thead" (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 -> Bool -> [[Block]] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
    tableRowToJATS WriterOptions
    opts Bool
    True [[Block]]
    headers
      Doc Text
    tbody <- (Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "tbody" (Doc Text -> Doc Text)
    -> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat) ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet 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 JATSTagSet m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
    tableRowToJATS WriterOptions
    opts Bool
    False) [[[Block]]]
    rows
      Doc Text -> JATS m (Doc Text)
    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
    True "table" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Doc Text
    coltags Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    thead Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    tbody
    blockToJATS opts :: WriterOptions
    opts (Table caption :: [Inline]
    caption aligns :: [Alignment]
    aligns widths :: [Double]
    widths headers :: [[Block]]
    headers rows :: [[[Block]]]
    rows) = do
      Doc Text
    captionDoc <- Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "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)
    blockToJATS WriterOptions
    opts ([Inline] -> Block
    Para [Inline]
    caption)
      Doc Text
    tbl <- WriterOptions -> Block -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS WriterOptions
    opts ([Inline]
    -> [Alignment] -> [Double] -> [[Block]] -> [[[Block]]] -> Block
    Table [] [Alignment]
    aligns [Double]
    widths [[Block]]
    headers [[[Block]]]
    rows)
      Doc Text -> JATS m (Doc Text)
    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
    True "table-wrap" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ Doc Text
    captionDoc Doc Text -> Doc Text -> Doc Text
    forall a. Doc a -> Doc a -> Doc a
    $$ Doc Text
    tbl

    alignmentToText :: Alignment -> Text
    alignmentToText :: Alignment -> Text
    alignmentToText alignment :: Alignment
    alignment = case Alignment
    alignment of
                                     AlignLeft    -> "left"
                                     AlignRight   -> "right"
                                     AlignCenter  -> "center"
                                     AlignDefault -> "left"

    tableRowToJATS :: PandocMonad m
                      => WriterOptions
                      -> Bool
                      -> [[Block]]
                      -> JATS m (Doc Text)
    tableRowToJATS :: WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
    tableRowToJATS opts :: WriterOptions
    opts isHeader :: Bool
    isHeader cols :: [[Block]]
    cols =
      (Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "tr" (Doc Text -> Doc Text)
    -> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat) ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet 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 JATSTagSet m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> Bool -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Bool -> [Block] -> JATS m (Doc Text)
    tableItemToJATS WriterOptions
    opts Bool
    isHeader) [[Block]]
    cols

    tableItemToJATS :: PandocMonad m
                       => WriterOptions
                       -> Bool
                       -> [Block]
                       -> JATS m (Doc Text)
    tableItemToJATS :: WriterOptions -> Bool -> [Block] -> JATS m (Doc Text)
    tableItemToJATS opts :: WriterOptions
    opts isHeader :: Bool
    isHeader [Plain item :: [Inline]
    item] =
      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 (if Bool
    isHeader then "th" else "td") [] (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]
    item
    tableItemToJATS opts :: WriterOptions
    opts isHeader :: Bool
    isHeader item :: [Block]
    item =
      (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 (if Bool
    isHeader then "th" else "td") [] (Doc Text -> Doc Text)
    -> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat) ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet 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 JATSTagSet m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> Block -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Block -> JATS m (Doc Text)
    blockToJATS WriterOptions
    opts) [Block]
    item

    -- | Convert a list of inline elements to JATS.
    inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS :: WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS opts :: WriterOptions
    opts lst :: [Inline]
    lst = [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    hcat ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text]
    -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Inline -> JATS m (Doc Text))
    -> [Inline] -> StateT JATSState (ReaderT JATSTagSet m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (WriterOptions -> Inline -> JATS 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 (x :: Inline
    x:xs :: [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 "jats") z :: Text
    z) =
               "<pub-id pub-id-type=" Text -> Text -> Bool
    `T.isPrefixOf` Text
    z
           needsFixing _           = Bool
    False
           isRawInline :: Inline -> Bool
    isRawInline RawInline{} = Bool
    True
           isRawInline _           = Bool
    False
           (ys :: [Inline]
    ys,zs :: [Inline]
    zs)                 = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Inline -> Bool
    isRawInline [Inline]
    xs
       fixCitations (x :: Inline
    x:xs :: [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 :: WriterOptions -> Inline -> JATS m (Doc Text)
    inlineToJATS _ (Str str :: Text
    str) = Doc Text -> JATS m (Doc Text)
    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 -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    escapeStringForXML Text
    str
    inlineToJATS opts :: WriterOptions
    opts (Emph lst :: [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "italic" (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
    inlineToJATS opts :: WriterOptions
    opts (Strong lst :: [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "bold" (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
    inlineToJATS opts :: WriterOptions
    opts (Strikeout lst :: [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "strike" (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
    inlineToJATS opts :: WriterOptions
    opts (Superscript lst :: [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "sup" (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
    inlineToJATS opts :: WriterOptions
    opts (Subscript lst :: [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "sub" (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
    inlineToJATS opts :: WriterOptions
    opts (SmallCaps lst :: [Inline]
    lst) =
      Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "sc" (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
    inlineToJATS opts :: WriterOptions
    opts (Quoted SingleQuote lst :: [Inline]
    lst) = do
      Doc Text
    contents <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
      Doc Text -> JATS m (Doc Text)
    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
    $ Char -> Doc Text
    forall a. HasChars a => Char -> Doc a
    char '‘' Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    contents Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Char -> Doc Text
    forall a. HasChars a => Char -> Doc a
    char '’'
    inlineToJATS opts :: WriterOptions
    opts (Quoted DoubleQuote lst :: [Inline]
    lst) = do
      Doc Text
    contents <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
      Doc Text -> JATS m (Doc Text)
    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
    $ Char -> Doc Text
    forall a. HasChars a => Char -> Doc a
    char '“' Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    contents Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Char -> Doc Text
    forall a. HasChars a => Char -> Doc a
    char '”'
    inlineToJATS _ (Code a :: Attr
    a str :: Text
    str) =
      Doc Text -> JATS m (Doc Text)
    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) -> 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 (lang :: Text
    lang, attr :: [(Text, Text)]
    attr) = Attr -> (Text, [(Text, Text)])
    codeAttr Attr
    a
              tag :: Text
    tag          = if Text -> Bool
    T.null Text
    lang then "monospace" else "code"
    inlineToJATS _ il :: Inline
    il@(RawInline f :: Format
    f x :: Text
    x)
      | Format
    f Format -> Format -> Bool
    forall a. Eq a => a -> a -> Bool
    == "jats" = Doc Text -> JATS m (Doc Text)
    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 -> Doc Text
    forall a. HasChars a => a -> Doc a
    literal Text
    x
      | Bool
    otherwise   = do
          LogMessage -> StateT JATSState (ReaderT JATSTagSet m) ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> StateT JATSState (ReaderT JATSTagSet m) ())
    -> LogMessage -> StateT JATSState (ReaderT JATSTagSet m) ()
    forall a b. (a -> b) -> a -> b
    $ Inline -> LogMessage
    InlineNotRendered Inline
    il
          Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    empty
    inlineToJATS _ LineBreak = Doc Text -> JATS m (Doc Text)
    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 _ Space = Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    space
    inlineToJATS opts :: WriterOptions
    opts SoftBreak
      | WriterOptions -> WrapOption
    writerWrapText WriterOptions
    opts WrapOption -> WrapOption -> Bool
    forall a. Eq a => a -> a -> Bool
    == WrapOption
    WrapPreserve = Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    cr
      | Bool
    otherwise = Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Doc a
    space
    inlineToJATS opts :: WriterOptions
    opts (Note contents :: [Block]
    contents) = do
      JATSTagSet
    tagSet <- StateT JATSState (ReaderT JATSTagSet m) JATSTagSet
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      -- Footnotes must occur inline when using the Article Authoring tag set.
      if JATSTagSet
    tagSet JATSTagSet -> JATSTagSet -> Bool
    forall a. Eq a => a -> a -> Bool
    == JATSTagSet
    TagSetArticleAuthoring
        then Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsIndented "fn" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (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
    isPara) WriterOptions
    opts [Block]
    contents
        else do
          [(Int, Doc Text)]
    notes <- (JATSState -> [(Int, Doc Text)])
    -> StateT JATSState (ReaderT JATSTagSet m) [(Int, Doc Text)]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets JATSState -> [(Int, Doc Text)]
    jatsNotes
          let notenum :: Int
    notenum = case [(Int, Doc Text)]
    notes of
                          (n :: Int
    n, _):_ -> Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1
                          []       -> 1
          Doc Text
    thenote <- 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 "fn" [("id","fn" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    notenum)]
                        (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (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
    isPara) WriterOptions
    opts
                             ((Block -> Block) -> [Block] -> [Block]
    forall a b. Walkable a b => (a -> a) -> b -> b
    walk Block -> Block
    demoteHeaderAndRefs [Block]
    contents)
          (JATSState -> JATSState)
    -> StateT JATSState (ReaderT JATSTagSet m) ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((JATSState -> JATSState)
     -> StateT JATSState (ReaderT JATSTagSet m) ())
    -> (JATSState -> JATSState)
    -> StateT JATSState (ReaderT JATSTagSet m) ()
    forall a b. (a -> b) -> a -> b
    $ \st :: JATSState
    st -> JATSState
    st{ jatsNotes :: [(Int, Doc Text)]
    jatsNotes = (Int
    notenum, Doc Text
    thenote) (Int, Doc Text) -> [(Int, Doc Text)] -> [(Int, Doc Text)]
    forall a. a -> [a] -> [a]
    : [(Int, Doc Text)]
    notes }
          Doc Text -> JATS m (Doc Text)
    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 "xref" [("ref-type", "fn"),
                                        ("rid", "fn" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    notenum)]
                 (Doc Text -> Doc Text) -> Doc Text -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text (Int -> String
    forall a. Show a => a -> String
    show Int
    notenum)
    inlineToJATS opts :: WriterOptions
    opts (Cite _ lst :: [Inline]
    lst) =
      -- TODO revisit this after examining the jats.csl pipeline
      WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    lst
    inlineToJATS opts :: WriterOptions
    opts (Span ("",_,[]) ils :: [Inline]
    ils) = WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    ils
    inlineToJATS opts :: WriterOptions
    opts (Span (ident :: Text
    ident,_,kvs :: [(Text, Text)]
    kvs) ils :: [Inline]
    ils) = do
      Doc Text
    contents <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    ils
      let attr :: [(Text, Text)]
    attr = [("id",Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("xml:lang",Text
    l) | ("lang",l :: Text
    l) <- [(Text, Text)]
    kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    k,Text
    v) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs
                        ,  Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["content-type", "rationale",
                                     "rid", "specific-use"]]
      Doc Text -> JATS m (Doc Text)
    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)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag "milestone-start" [(Text, Text)]
    attr Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <> Doc Text
    contents Doc Text -> Doc Text -> Doc Text
    forall a. Semigroup a => a -> a -> a
    <>
               Text -> [(Text, Text)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag "milestone-end" []
    inlineToJATS _ (Math t :: MathType
    t str :: Text
    str) = do
      let addPref :: Attr -> Attr
    addPref (Xml.Attr q :: QName
    q v :: String
    v)
             | QName -> String
    Xml.qName QName
    q String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "xmlns" = QName -> String -> Attr
    Xml.Attr QName
    q{ qName :: String
    Xml.qName = "xmlns:mml" } String
    v
             | Bool
    otherwise = QName -> String -> Attr
    Xml.Attr QName
    q String
    v
      let fixNS' :: Element -> Element
    fixNS' e :: Element
    e = Element
    e{ elName :: QName
    Xml.elName =
                             (Element -> QName
    Xml.elName Element
    e){ qPrefix :: Maybe String
    Xml.qPrefix = String -> Maybe String
    forall a. a -> Maybe a
    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
    .
                  (\e :: Element
    e -> Element
    e{ elAttribs :: [Attr]
    Xml.elAttribs = (Attr -> Attr) -> [Attr] -> [Attr]
    forall a b. (a -> b) -> [a] -> [b]
    map Attr -> Attr
    addPref (Element -> [Attr]
    Xml.elAttribs Element
    e) })
      let conf :: ConfigPP
    conf = (QName -> Bool) -> ConfigPP -> ConfigPP
    Xml.useShortEmptyTags (Bool -> QName -> Bool
    forall a b. a -> b -> a
    const Bool
    False) ConfigPP
    Xml.defaultConfigPP
      Either Inline Element
    res <- (DisplayType -> [Exp] -> Element)
    -> MathType
    -> Text
    -> StateT JATSState (ReaderT JATSTagSet 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 :: Text
    tagtype = case MathType
    t of
                         DisplayMath -> "disp-formula"
                         InlineMath  -> "inline-formula"

      let rawtex :: Doc Text
    rawtex = String -> Doc Text
    forall a. HasChars a => String -> Doc a
    text "<![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 "]]>"
      let texMath :: Doc Text
    texMath = Text -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "tex-math" Doc Text
    rawtex

      JATSTagSet
    tagSet <- StateT JATSState (ReaderT JATSTagSet m) JATSTagSet
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      Doc Text -> JATS m (Doc Text)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Doc Text -> JATS m (Doc Text))
    -> (Doc Text -> Doc Text) -> Doc Text -> JATS m (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
    tagtype (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
    forall a b. (a -> b) -> a -> b
    $
        case Either Inline Element
    res of
          Right r :: 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 "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 _   -> if JATSTagSet
    tagSet JATSTagSet -> JATSTagSet -> Bool
    forall a. Eq a => a -> a -> Bool
    /= JATSTagSet
    TagSetArticleAuthoring
                      then Doc Text
    texMath
                      else Doc Text
    rawtex
    inlineToJATS _ (Link _attr :: Attr
    _attr [Str t :: Text
    t] (Text -> Text -> Maybe Text
    T.stripPrefix "mailto:" -> Just email :: Text
    email, _))
      | Text -> Text
    escapeURI Text
    t Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    email =
      Doc Text -> JATS m (Doc Text)
    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 -> Doc Text -> Doc Text
    forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
    inTagsSimple "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 opts :: WriterOptions
    opts (Link (ident :: Text
    ident,_,kvs :: [(Text, Text)]
    kvs) txt :: [Inline]
    txt (Text -> Maybe (Char, Text)
    T.uncons -> Just ('#', src :: Text
    src), _)) = do
      let attr :: [(Text, Text)]
    attr = [("id", Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("alt", [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Inline]
    txt) | Bool -> Bool
    not ([Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    txt)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("rid", Text
    src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [(Text
    k,Text
    v) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["ref-type", "specific-use"]]
      if [Inline] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Inline]
    txt
         then Doc Text -> JATS m (Doc Text)
    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)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag "xref" [(Text, Text)]
    attr
         else do
            Doc Text
    contents <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    txt
            Doc Text -> JATS m (Doc Text)
    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 "xref" [(Text, Text)]
    attr Doc Text
    contents
    inlineToJATS opts :: WriterOptions
    opts (Link (ident :: Text
    ident,_,kvs :: [(Text, Text)]
    kvs) txt :: [Inline]
    txt (src :: Text
    src, tit :: Text
    tit)) = do
      let attr :: [(Text, Text)]
    attr = [("id", Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("ext-link-type", "uri"),
                  ("xlink:href", Text
    src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("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) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["assigning-authority",
                                                  "specific-use", "xlink:actuate",
                                                  "xlink:role", "xlink:show",
                                                  "xlink:type"]]
      Doc Text
    contents <- WriterOptions -> [Inline] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [Inline] -> JATS m (Doc Text)
    inlinesToJATS WriterOptions
    opts [Inline]
    txt
      Doc Text -> JATS m (Doc Text)
    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 "ext-link" [(Text, Text)]
    attr Doc Text
    contents
    inlineToJATS _ (Image (ident :: Text
    ident,_,kvs :: [(Text, Text)]
    kvs) _ (src :: Text
    src, tit :: Text
    tit)) = do
      let mbMT :: Maybe Text
    mbMT = String -> Maybe Text
    getMimeType (Text -> String
    T.unpack Text
    src)
      let maintype :: Text
    maintype = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe "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 "mimetype" [(Text, Text)]
    kvs Maybe Text -> Maybe Text -> Maybe Text
    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
    /='/') (Text -> Text) -> Maybe Text -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Text
    mbMT)
      let subtype :: Text
    subtype = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe "" (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 "mime-subtype" [(Text, Text)]
    kvs Maybe Text -> Maybe Text -> Maybe Text
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                      ((Int -> Text -> Text
    T.drop 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
    /='/')) (Text -> Text) -> Maybe Text -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Text
    mbMT)
      let attr :: [(Text, Text)]
    attr = [("id", Text
    ident) | Bool -> Bool
    not (Text -> Bool
    T.null Text
    ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("mimetype", Text
    maintype),
                  ("mime-subtype", Text
    subtype),
                  ("xlink:href", Text
    src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
    forall a. [a] -> [a] -> [a]
    ++
                 [("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) | (k :: Text
    k,v :: Text
    v) <- [(Text, Text)]
    kvs, Text
    k Text -> [Text] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["baseline-shift",
                            "content-type", "specific-use", "xlink:actuate",
                            "xlink:href", "xlink:role", "xlink:show",
                            "xlink:type"]]
      Doc Text -> JATS m (Doc Text)
    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)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag "inline-graphic" [(Text, Text)]
    attr

    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 _                = Bool
    False

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

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

    parseDate :: Text -> Maybe Day
    parseDate :: Text -> Maybe Day
    parseDate s :: 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 (\fs :: String
    fs -> String -> String -> Maybe Day
    parsetimeWith String
    fs (String -> Maybe Day) -> String -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack Text
    s) [String]
    formats) :: Maybe Day
      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 = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y",
                        "%e %B %Y", "%b. %e, %Y", "%B %e, %Y",
                        "%Y%m%d", "%Y%m", "%Y"]