    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TupleSections #-}
    {- |
       Module      : Text.Pandoc.Writers.JATS.Table
       Copyright   : © 2020-2024 Albert Krewinkel
       License     : GNU GPL, version 2 or above

       Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>
       Stability   : alpha
       Portability : portable

    Conversion of 'Pandoc' tables to JATS XML.
    -}
    module Text.Pandoc.Writers.JATS.Table
      ( tableToJATS
      ) where
    import Control.Monad.Reader (asks)
    import Data.List.NonEmpty (NonEmpty ((:|)))
    import Data.Text (Text)
    import Text.DocLayout (Doc, empty, vcat, ($$))
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import Text.Pandoc.Definition
    import Text.Pandoc.Options (WriterOptions)
    import Text.Pandoc.Shared (tshow)
    import Text.Pandoc.Writers.JATS.Types
    import Text.Pandoc.XML (escapeNCName, inTags, inTagsIndented, selfClosingTag)
    import qualified Data.Text as T
    import qualified Text.Pandoc.Writers.AnnotatedTable as Ann

    tableToJATS :: PandocMonad m
                => WriterOptions
                -> Ann.Table
                -> JATS m (Doc Text)
    tableToJATS :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Table -> JATS m (Doc Text)
    tableToJATS WriterOptions
    opts (Ann.Table Attr
    attr Caption
    caption [ColSpec]
    colspecs TableHead
    thead [TableBody]
    tbodies TableFoot
    tfoot) = do
      let (Caption Maybe ShortCaption
    _maybeShortCaption [Block]
    captionBlocks) = Caption
    caption
      -- Only paragraphs are allowed in captions, all other blocks must be
      -- wrapped in @<p>@ elements.
      let needsWrapping :: Block -> Bool
    needsWrapping = \case
            Plain{} -> Bool
    False
            Para{}  -> Bool
    False
            Block
    _       -> Bool
    True
      tbl <- WriterOptions
    -> Attr
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions
    -> Attr
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> JATS m (Doc Text)
    captionlessTable WriterOptions
    opts Attr
    attr [ColSpec]
    colspecs TableHead
    thead [TableBody]
    tbodies TableFoot
    tfoot
      captionDoc <- if null captionBlocks
                    then return empty
                    else do
                      blockToJATS <- asks jatsBlockWriter
                      inTagsIndented "caption" <$>
                        blockToJATS needsWrapping opts captionBlocks
      return $ inTags True "table-wrap" [] $ captionDoc $$ tbl

    captionlessTable :: PandocMonad m
                     => WriterOptions
                     -> Attr
                     -> [ColSpec]
                     -> Ann.TableHead
                     -> [Ann.TableBody]
                     -> Ann.TableFoot
                     -> JATS m (Doc Text)
    captionlessTable :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions
    -> Attr
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> JATS m (Doc Text)
    captionlessTable WriterOptions
    opts Attr
    attr [ColSpec]
    colspecs TableHead
    thead [TableBody]
    tbodies TableFoot
    tfoot = do
      head' <- WriterOptions -> TableHead -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TableHead -> JATS m (Doc Text)
    tableHeadToJats WriterOptions
    opts TableHead
    thead
      bodies <- mapM (tableBodyToJats opts) tbodies
      foot' <- tableFootToJats opts tfoot
      let validAttribs = [ Text
    "border", Text
    "cellpadding", Text
    "cellspacing", Text
    "content-type"
                         , Text
    "frame", Text
    "rules", Text
    "specific-use", Text
    "style", Text
    "summary"
                         , Text
    "width"
                         ]
      let attribs = Attr -> [Text] -> [(Text, Text)]
    toAttribs Attr
    attr [Text]
    validAttribs
      return $ inTags True "table" attribs $ vcat
        [ colSpecListToJATS colspecs
        , head'
        , foot'
        , vcat bodies
        ]

    validTablePartAttribs :: [Text]
    validTablePartAttribs :: [Text]
    validTablePartAttribs =
      [ Text
    "align", Text
    "char", Text
    "charoff", Text
    "content-type", Text
    "style", Text
    "valign" ]

    tableBodyToJats :: PandocMonad m
                    => WriterOptions
                    -> Ann.TableBody
                    -> JATS m (Doc Text)
    tableBodyToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TableBody -> JATS m (Doc Text)
    tableBodyToJats WriterOptions
    opts (Ann.TableBody Attr
    attr RowHeadColumns
    _rowHeadCols [HeaderRow]
    inthead [BodyRow]
    rows) = do
      let attribs :: [(Text, Text)]
    attribs = Attr -> [Text] -> [(Text, Text)]
    toAttribs Attr
    attr [Text]
    validTablePartAttribs
      intermediateHead <- if [HeaderRow] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HeaderRow]
    inthead
                          then Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Monoid a => a
    mempty
                          else WriterOptions
    -> TablePart
    -> [HeaderRow]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TablePart -> [HeaderRow] -> JATS m (Doc Text)
    headerRowsToJats WriterOptions
    opts TablePart
    Thead [HeaderRow]
    inthead
      bodyRows <- bodyRowsToJats opts rows
      return $ inTags True "tbody" attribs $ intermediateHead $$ bodyRows

    tableHeadToJats :: PandocMonad m
                    => WriterOptions
                    -> Ann.TableHead
                    -> JATS m (Doc Text)
    tableHeadToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TableHead -> JATS m (Doc Text)
    tableHeadToJats WriterOptions
    opts (Ann.TableHead Attr
    attr [HeaderRow]
    rows) =
      WriterOptions
    -> TablePart -> Attr -> [HeaderRow] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions
    -> TablePart -> Attr -> [HeaderRow] -> JATS m (Doc Text)
    tablePartToJats WriterOptions
    opts TablePart
    Thead Attr
    attr [HeaderRow]
    rows

    tableFootToJats :: PandocMonad m
                    => WriterOptions
                    -> Ann.TableFoot
                    -> JATS m (Doc Text)
    tableFootToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TableFoot -> JATS m (Doc Text)
    tableFootToJats WriterOptions
    opts (Ann.TableFoot Attr
    attr [HeaderRow]
    rows) =
      WriterOptions
    -> TablePart -> Attr -> [HeaderRow] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions
    -> TablePart -> Attr -> [HeaderRow] -> JATS m (Doc Text)
    tablePartToJats WriterOptions
    opts TablePart
    Tfoot Attr
    attr [HeaderRow]
    rows

    tablePartToJats :: PandocMonad m
                    => WriterOptions
                    -> TablePart
                    -> Attr
                    -> [Ann.HeaderRow]
                    -> JATS m (Doc Text)
    tablePartToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions
    -> TablePart -> Attr -> [HeaderRow] -> JATS m (Doc Text)
    tablePartToJats WriterOptions
    opts TablePart
    tblpart Attr
    attr [HeaderRow]
    rows =
      if [HeaderRow] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HeaderRow]
    rows Bool -> Bool -> Bool
    || (HeaderRow -> Bool) -> [HeaderRow] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all HeaderRow -> Bool
    isEmptyRow [HeaderRow]
    rows
      then Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Doc Text
    forall a. Monoid a => a
    mempty
      else do
        let tag' :: Text
    tag' = case TablePart
    tblpart of
                     TablePart
    Thead -> Text
    "thead"
                     TablePart
    Tfoot -> Text
    "tfoot"
                     TablePart
    Tbody -> Text
    "tbody" -- this would be unexpected
        let attribs :: [(Text, Text)]
    attribs = Attr -> [Text] -> [(Text, Text)]
    toAttribs Attr
    attr [Text]
    validTablePartAttribs
        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
    tag' [(Text, Text)]
    attribs (Doc Text -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterOptions
    -> TablePart
    -> [HeaderRow]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TablePart -> [HeaderRow] -> JATS m (Doc Text)
    headerRowsToJats WriterOptions
    opts TablePart
    tblpart [HeaderRow]
    rows
      where
        isEmptyRow :: HeaderRow -> Bool
    isEmptyRow (Ann.HeaderRow Attr
    _attr RowNumber
    _rownum [Cell]
    cells) = (Cell -> Bool) -> [Cell] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Cell -> Bool
    isEmptyCell [Cell]
    cells
        isEmptyCell :: Cell -> Bool
    isEmptyCell (Ann.Cell NonEmpty ColSpec
    _colspecs ColNumber
    _colnum Cell
    cell) =
          Cell
    cell Cell -> Cell -> Bool
    forall a. Eq a => a -> a -> Bool
    == Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
    Cell Attr
    nullAttr Alignment
    AlignDefault (Int -> RowSpan
    RowSpan Int
    1) (Int -> ColSpan
    ColSpan Int
    1) []

    -- | The part of a table; header, footer, or body.
    data TablePart = Thead | Tfoot | Tbody
      deriving (TablePart -> TablePart -> Bool
    (TablePart -> TablePart -> Bool)
    -> (TablePart -> TablePart -> Bool) -> Eq TablePart
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TablePart -> TablePart -> Bool
    == :: TablePart -> TablePart -> Bool
    $c/= :: TablePart -> TablePart -> Bool
    /= :: TablePart -> TablePart -> Bool
    Eq)

    data CellType = HeaderCell | BodyCell

    data TableRow = TableRow TablePart Attr Ann.RowNumber Ann.RowHead Ann.RowBody

    headerRowsToJats :: PandocMonad m
                     => WriterOptions
                     -> TablePart
                     -> [Ann.HeaderRow]
                     -> JATS m (Doc Text)
    headerRowsToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TablePart -> [HeaderRow] -> JATS m (Doc Text)
    headerRowsToJats WriterOptions
    opts TablePart
    tablepart =
      WriterOptions -> [TableRow] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [TableRow] -> JATS m (Doc Text)
    rowListToJats WriterOptions
    opts ([TableRow] -> JATS m (Doc Text))
    -> ([HeaderRow] -> [TableRow]) -> [HeaderRow] -> JATS m (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HeaderRow -> TableRow) -> [HeaderRow] -> [TableRow]
    forall a b. (a -> b) -> [a] -> [b]
    map HeaderRow -> TableRow
    toTableRow
      where
        toTableRow :: HeaderRow -> TableRow
    toTableRow (Ann.HeaderRow Attr
    attr RowNumber
    rownum [Cell]
    rowbody) =
          TablePart -> Attr -> RowNumber -> [Cell] -> [Cell] -> TableRow
    TableRow TablePart
    tablepart Attr
    attr RowNumber
    rownum [] [Cell]
    rowbody

    bodyRowsToJats :: PandocMonad m
                   => WriterOptions
                   -> [Ann.BodyRow]
                   -> JATS m (Doc Text)
    bodyRowsToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [BodyRow] -> JATS m (Doc Text)
    bodyRowsToJats WriterOptions
    opts =
      WriterOptions -> [TableRow] -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [TableRow] -> JATS m (Doc Text)
    rowListToJats WriterOptions
    opts ([TableRow] -> JATS m (Doc Text))
    -> ([BodyRow] -> [TableRow]) -> [BodyRow] -> JATS m (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RowNumber -> BodyRow -> TableRow)
    -> [RowNumber] -> [BodyRow] -> [TableRow]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith RowNumber -> BodyRow -> TableRow
    toTableRow [RowNumber
    1..]
      where
        toTableRow :: RowNumber -> BodyRow -> TableRow
    toTableRow RowNumber
    rownum (Ann.BodyRow Attr
    attr RowNumber
    _rownum [Cell]
    rowhead [Cell]
    rowbody) =
          TablePart -> Attr -> RowNumber -> [Cell] -> [Cell] -> TableRow
    TableRow TablePart
    Tbody Attr
    attr RowNumber
    rownum [Cell]
    rowhead [Cell]
    rowbody

    rowListToJats :: PandocMonad m
                  => WriterOptions
                  -> [TableRow]
                  -> JATS m (Doc Text)
    rowListToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> [TableRow] -> JATS m (Doc Text)
    rowListToJats WriterOptions
    opts = ([Doc Text] -> Doc Text)
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall a b.
    (a -> b)
    -> StateT JATSState (ReaderT (JATSEnv m) m) a
    -> StateT JATSState (ReaderT (JATSEnv m) m) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Doc Text] -> Doc Text
    forall a. [Doc a] -> Doc a
    vcat (StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
     -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> ([TableRow]
        -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text])
    -> [TableRow]
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TableRow -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> [TableRow]
    -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (WriterOptions
    -> TableRow -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TableRow -> JATS m (Doc Text)
    tableRowToJats WriterOptions
    opts)

    colSpecListToJATS :: [ColSpec] -> Doc Text
    colSpecListToJATS :: [ColSpec] -> Doc Text
    colSpecListToJATS [ColSpec]
    colspecs =
      let hasDefaultWidth :: (a, ColWidth) -> Bool
    hasDefaultWidth (a
    _, ColWidth
    ColWidthDefault) = Bool
    True
          hasDefaultWidth (a, ColWidth)
    _                    = Bool
    False

          percent :: a -> Text
    percent a
    w = Integer -> Text
    forall a. Show a => a -> Text
    tshow (a -> Integer
    forall b. Integral b => a -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (a
    100a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    w) :: Integer) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "%"

          col :: ColWidth -> Doc Text
          col :: ColWidth -> Doc Text
    col = Text -> [(Text, Text)] -> Doc Text
    forall a.
    (HasChars a, IsString a) =>
    Text -> [(Text, Text)] -> Doc a
    selfClosingTag Text
    "col" ([(Text, Text)] -> Doc Text)
    -> (ColWidth -> [(Text, Text)]) -> ColWidth -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . \case
            ColWidth
    ColWidthDefault -> [(Text, Text)]
    forall a. Monoid a => a
    mempty
            ColWidth Double
    w -> [(Text
    "width", Double -> Text
    forall {a}. RealFrac a => a -> Text
    percent Double
    w)]

       in if (ColSpec -> Bool) -> [ColSpec] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ColSpec -> Bool
    forall {a}. (a, ColWidth) -> Bool
    hasDefaultWidth [ColSpec]
    colspecs
          then Doc Text
    forall a. Monoid a => a
    mempty
          else 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
    "colgroup" [] (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] -> Doc Text) -> [Doc Text] -> Doc Text
    forall a b. (a -> b) -> a -> b
    $ (ColSpec -> Doc Text) -> [ColSpec] -> [Doc Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (ColWidth -> Doc Text
    col (ColWidth -> Doc Text)
    -> (ColSpec -> ColWidth) -> ColSpec -> Doc Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ColSpec -> ColWidth
    forall a b. (a, b) -> b
    snd) [ColSpec]
    colspecs

    tableRowToJats :: PandocMonad m
                   => WriterOptions
                   -> TableRow
                   -> JATS m (Doc Text)
    tableRowToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> TableRow -> JATS m (Doc Text)
    tableRowToJats WriterOptions
    opts (TableRow TablePart
    tblpart Attr
    attr RowNumber
    _rownum [Cell]
    rowhead [Cell]
    rowbody) = do
      let validAttribs :: [Text]
    validAttribs = [ Text
    "align", Text
    "char", Text
    "charoff", Text
    "content-type"
                         , Text
    "style", Text
    "valign"
                         ]
      let attr' :: [(Text, Text)]
    attr' = Attr -> [Text] -> [(Text, Text)]
    toAttribs Attr
    attr [Text]
    validAttribs
      let celltype :: CellType
    celltype = case TablePart
    tblpart of
                       TablePart
    Thead -> CellType
    HeaderCell
                       TablePart
    _     -> CellType
    BodyCell
      headcells <- (Cell -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
    -> [Cell] -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (WriterOptions
    -> CellType
    -> Cell
    -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> CellType -> Cell -> JATS m (Doc Text)
    cellToJats WriterOptions
    opts CellType
    HeaderCell) [Cell]
    rowhead
      bodycells <- mapM (cellToJats opts celltype) rowbody
      return $ inTags True "tr" attr' $ mconcat
        [ vcat headcells
        , vcat bodycells
        ]

    alignmentAttrib :: Alignment -> Maybe (Text, Text)
    alignmentAttrib :: Alignment -> Maybe (Text, Text)
    alignmentAttrib = (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text
    "align",) (Maybe Text -> Maybe (Text, Text))
    -> (Alignment -> Maybe Text) -> Alignment -> Maybe (Text, Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . \case
      Alignment
    AlignLeft    -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "left"
      Alignment
    AlignRight   -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "right"
      Alignment
    AlignCenter  -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "center"
      Alignment
    AlignDefault -> Maybe Text
    forall a. Maybe a
    Nothing

    colspanAttrib :: ColSpan -> Maybe (Text, Text)
    colspanAttrib :: ColSpan -> Maybe (Text, Text)
    colspanAttrib = \case
      ColSpan Int
    1 -> Maybe (Text, Text)
    forall a. Maybe a
    Nothing
      ColSpan Int
    n -> (Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    "colspan", Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n)

    rowspanAttrib :: RowSpan -> Maybe (Text, Text)
    rowspanAttrib :: RowSpan -> Maybe (Text, Text)
    rowspanAttrib = \case
      RowSpan Int
    1 -> Maybe (Text, Text)
    forall a. Maybe a
    Nothing
      RowSpan Int
    n -> (Text, Text) -> Maybe (Text, Text)
    forall a. a -> Maybe a
    Just (Text
    "rowspan", Int -> Text
    forall a. Show a => a -> Text
    tshow Int
    n)

    cellToJats :: PandocMonad m
               => WriterOptions
               -> CellType
               -> Ann.Cell
               -> JATS m (Doc Text)
    cellToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> CellType -> Cell -> JATS m (Doc Text)
    cellToJats WriterOptions
    opts CellType
    celltype (Ann.Cell (ColSpec
    colspec :| [ColSpec]
    _) ColNumber
    _colNum Cell
    cell) =
      let align :: Alignment
    align = ColSpec -> Alignment
    forall a b. (a, b) -> a
    fst ColSpec
    colspec
      in WriterOptions -> CellType -> Alignment -> Cell -> JATS m (Doc Text)
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> CellType -> Alignment -> Cell -> JATS m (Doc Text)
    tableCellToJats WriterOptions
    opts CellType
    celltype Alignment
    align Cell
    cell

    toAttribs :: Attr -> [Text] -> [(Text, Text)]
    toAttribs :: Attr -> [Text] -> [(Text, Text)]
    toAttribs (Text
    ident, [Text]
    _classes, [(Text, Text)]
    kvs) [Text]
    knownAttribs =
      (if Text -> Bool
    T.null Text
    ident then [(Text, Text)] -> [(Text, Text)]
    forall a. a -> a
    id else ((Text
    "id", Text -> Text
    escapeNCName Text
    ident) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall a. a -> [a] -> [a]
    :)) ([(Text, Text)] -> [(Text, Text)])
    -> [(Text, Text)] -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $
      ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    knownAttribs) (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, Text) -> Text
    forall a b. (a, b) -> a
    fst) [(Text, Text)]
    kvs

    tableCellToJats :: PandocMonad m
                    => WriterOptions
                    -> CellType
                    -> Alignment
                    -> Cell
                    -> JATS m (Doc Text)
    tableCellToJats :: forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> CellType -> Alignment -> Cell -> JATS m (Doc Text)
    tableCellToJats WriterOptions
    opts CellType
    ctype Alignment
    colAlign (Cell Attr
    attr Alignment
    align RowSpan
    rowspan ColSpan
    colspan [Block]
    item) = do
      blockToJats   <- (JATSEnv m
     -> (Block -> Bool)
     -> WriterOptions
     -> [Block]
     -> JATS m (Doc Text))
    -> StateT
         JATSState
         (ReaderT (JATSEnv m) m)
         ((Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text))
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks JATSEnv m
    -> (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    forall (m :: * -> *).
    JATSEnv m
    -> (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    jatsBlockWriter
      inlinesToJats <- asks jatsInlinesWriter
      let fixBreak Inline
    LineBreak = Format -> Text -> Inline
    RawInline (Text -> Format
    Format Text
    "jats") Text
    "<break/>"
          fixBreak Inline
    x         = Inline
    x
      let cellContents = \case
            [Plain ShortCaption
    inlines] -> WriterOptions -> ShortCaption -> JATS m (Doc Text)
    inlinesToJats WriterOptions
    opts
                                 ((Inline -> Inline) -> ShortCaption -> ShortCaption
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Inline
    fixBreak ShortCaption
    inlines)
                                 -- Note: <break/> is allowed only as a direct
                                 -- child of <td>, so we don't use walk.
            [Block]
    blocks          -> (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
    blockToJats Block -> Bool
    needsWrapInCell WriterOptions
    opts [Block]
    blocks
      let tag' = case CellType
    ctype of
            CellType
    BodyCell   -> Text
    "td"
            CellType
    HeaderCell -> Text
    "th"
      let align' = case Alignment
    align of
            Alignment
    AlignDefault -> Alignment
    colAlign
            Alignment
    _            -> Alignment
    align
      let maybeCons = ([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [a] -> [a]
    forall a. a -> a
    id (:)
      let validAttribs = [ Text
    "abbr", Text
    "align", Text
    "axis", Text
    "char", Text
    "charoff"
                         , Text
    "content-type", Text
    "headers", Text
    "scope", Text
    "style", Text
    "valign"
                         ]
      let attribs = Maybe (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall {a}. Maybe a -> [a] -> [a]
    maybeCons (Alignment -> Maybe (Text, Text)
    alignmentAttrib Alignment
    align')
                  ([(Text, Text)] -> [(Text, Text)])
    -> ([(Text, Text)] -> [(Text, Text)])
    -> [(Text, Text)]
    -> [(Text, Text)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall {a}. Maybe a -> [a] -> [a]
    maybeCons (RowSpan -> Maybe (Text, Text)
    rowspanAttrib RowSpan
    rowspan)
                  ([(Text, Text)] -> [(Text, Text)])
    -> ([(Text, Text)] -> [(Text, Text)])
    -> [(Text, Text)]
    -> [(Text, Text)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
    forall {a}. Maybe a -> [a] -> [a]
    maybeCons (ColSpan -> Maybe (Text, Text)
    colspanAttrib ColSpan
    colspan)
                  ([(Text, Text)] -> [(Text, Text)])
    -> [(Text, Text)] -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $ Attr -> [Text] -> [(Text, Text)]
    toAttribs Attr
    attr [Text]
    validAttribs
      inTags False tag' attribs <$> cellContents item

    -- | Whether the JATS produced from this block should be wrapped in a
    -- @<p>@ element when put directly below a @<td>@ element.
    needsWrapInCell :: Block -> Bool
    needsWrapInCell :: Block -> Bool
    needsWrapInCell = \case
      Plain{}          -> Bool
    False  -- should be unwrapped anyway
      Para{}           -> Bool
    False
      BulletList{}     -> Bool
    False
      OrderedList{}    -> Bool
    False
      DefinitionList{} -> Bool
    False
      Block
    HorizontalRule   -> Bool
    False
      CodeBlock{}      -> Bool
    False
      RawBlock{}       -> Bool
    False  -- responsibility of the user
      Block
    _                -> Bool
    True