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

   Maintainer  : Albert Krewinkel <tarleb@zeitkraut.de>
   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
  Doc Text
tbl <- 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
  Doc Text
captionDoc <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captionBlocks
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                else do
                  (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
blockToJATS <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *).
JATSEnv m
-> (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
jatsBlockWriter
                  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"caption" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
blockToJATS Block -> Bool
needsWrapping WriterOptions
opts [Block]
captionBlocks
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"table-wrap" [] forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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
  Doc Text
head' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableHead -> JATS m (Doc Text)
tableHeadToJats WriterOptions
opts TableHead
thead
  [Doc Text]
bodies <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableBody -> JATS m (Doc Text)
tableBodyToJats WriterOptions
opts) [TableBody]
tbodies
  Doc Text
foot' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TableFoot -> JATS m (Doc Text)
tableFootToJats WriterOptions
opts TableFoot
tfoot
  let validAttribs :: [Text]
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 :: [(Text, Text)]
attribs = Attr -> [Text] -> [(Text, Text)]
toAttribs Attr
attr [Text]
validAttribs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"table" [(Text, Text)]
attribs forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat
    [ [ColSpec] -> Doc Text
colSpecListToJATS [ColSpec]
colspecs
    , Doc Text
head'
    , Doc Text
foot'
    , forall a. [Doc a] -> Doc a
vcat [Doc Text]
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
  Doc Text
intermediateHead <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
inthead
                      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
                      else forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> TablePart -> [HeaderRow] -> JATS m (Doc Text)
headerRowsToJats WriterOptions
opts TablePart
Thead [HeaderRow]
inthead
  Doc Text
bodyRows <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [BodyRow] -> JATS m (Doc Text)
bodyRowsToJats WriterOptions
opts [BodyRow]
rows
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"tbody" [(Text, Text)]
attribs forall a b. (a -> b) -> a -> b
$ Doc Text
intermediateHead forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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) =
  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) =
  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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeaderRow]
rows Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all HeaderRow -> Bool
isEmptyRow [HeaderRow]
rows
  then forall (m :: * -> *) a. Monad m => a -> m a
return 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
    forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
tag' [(Text, Text)]
attribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = 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 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TablePart -> TablePart -> Bool
$c/= :: TablePart -> TablePart -> Bool
== :: TablePart -> TablePart -> Bool
$c== :: 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 =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [TableRow] -> JATS m (Doc Text)
rowListToJats WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [TableRow] -> JATS m (Doc Text)
rowListToJats WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
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 = forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
round (a
100forall a. Num a => a -> a -> a
*a
w) :: Integer) forall a. Semigroup a => a -> a -> a
<> Text
"%"

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

   in if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. (a, ColWidth) -> Bool
hasDefaultWidth [ColSpec]
colspecs
      then forall a. Monoid a => a
mempty
      else forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"colgroup" [] forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ColWidth -> Doc Text
col forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
  [Doc Text]
headcells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> CellType -> Cell -> JATS m (Doc Text)
cellToJats WriterOptions
opts CellType
HeaderCell) [Cell]
rowhead
  [Doc Text]
bodycells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> CellType -> Cell -> JATS m (Doc Text)
cellToJats WriterOptions
opts CellType
celltype) [Cell]
rowbody
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"tr" [(Text, Text)]
attr' forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
    [ forall a. [Doc a] -> Doc a
vcat [Doc Text]
headcells
    , forall a. [Doc a] -> Doc a
vcat [Doc Text]
bodycells
    ]

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

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

rowspanAttrib :: RowSpan -> Maybe (Text, Text)
rowspanAttrib :: RowSpan -> Maybe (Text, Text)
rowspanAttrib = \case
  RowSpan Int
1 -> forall a. Maybe a
Nothing
  RowSpan Int
n -> forall a. a -> Maybe a
Just (Text
"rowspan", 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 = forall a b. (a, b) -> a
fst ColSpec
colspec
  in 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 forall a. a -> a
id else ((Text
"id", Text -> Text
escapeNCName Text
ident) forall a. a -> [a] -> [a]
:)) forall a b. (a -> b) -> a -> b
$
  forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
knownAttribs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
  (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
blockToJats   <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *).
JATSEnv m
-> (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
jatsBlockWriter
  WriterOptions -> ShortCaption -> JATS m (Doc Text)
inlinesToJats <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *).
JATSEnv m -> WriterOptions -> ShortCaption -> JATS m (Doc Text)
jatsInlinesWriter
  let fixBreak :: Inline -> Inline
fixBreak Inline
LineBreak = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"jats") Text
"<break/>"
      fixBreak Inline
x         = Inline
x
  let cellContents :: [Block] -> JATS m (Doc Text)
cellContents = \case
        [Plain ShortCaption
inlines] -> WriterOptions -> ShortCaption -> JATS m (Doc Text)
inlinesToJats WriterOptions
opts
                             (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' :: Text
tag' = case CellType
ctype of
        CellType
BodyCell   -> Text
"td"
        CellType
HeaderCell -> Text
"th"
  let align' :: Alignment
align' = case Alignment
align of
        Alignment
AlignDefault -> Alignment
colAlign
        Alignment
_            -> Alignment
align
  let maybeCons :: Maybe a -> [a] -> [a]
maybeCons = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:)
  let validAttribs :: [Text]
validAttribs = [ Text
"abbr", Text
"align", Text
"axis", Text
"char", Text
"charoff"
                     , Text
"content-type", Text
"headers", Text
"scope", Text
"style", Text
"valign"
                     ]
  let attribs :: [(Text, Text)]
attribs = forall {a}. Maybe a -> [a] -> [a]
maybeCons (Alignment -> Maybe (Text, Text)
alignmentAttrib Alignment
align')
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Maybe a -> [a] -> [a]
maybeCons (RowSpan -> Maybe (Text, Text)
rowspanAttrib RowSpan
rowspan)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Maybe a -> [a] -> [a]
maybeCons (ColSpan -> Maybe (Text, Text)
colspanAttrib ColSpan
colspan)
              forall a b. (a -> b) -> a -> b
$ Attr -> [Text] -> [(Text, Text)]
toAttribs Attr
attr [Text]
validAttribs
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
tag' [(Text, Text)]
attribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> JATS m (Doc Text)
cellContents [Block]
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