pandoc-3.4: src/Text/Pandoc/Writers/LaTeX/Table.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Writers.LaTeX.Table
Copyright : Copyright (C) 2006-2024 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Output LaTeX formatted tables.
-}
module Text.Pandoc.Writers.LaTeX.Table
( tableToLaTeX
) where
import Control.Monad.State.Strict ( gets, modify )
import Control.Monad (when)
import Data.List (intersperse)
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.DocLayout
( Doc, braces, cr, empty, hcat, hsep, isEmpty, literal, nest
, text, vcat, ($$) )
import Text.Pandoc.Shared (splitBy, tshow)
import Text.Pandoc.Walk (walk, query)
import Data.Monoid (Any(..))
import Text.Pandoc.Writers.LaTeX.Caption (getCaption)
import Text.Pandoc.Writers.LaTeX.Notes (notesToLaTeX)
import Text.Pandoc.Writers.LaTeX.Types
( LW, WriterState (stBeamer, stExternalNotes, stInMinipage, stMultiRow
, stNotes, stTable, stOptions) )
import Text.Pandoc.Writers.LaTeX.Util (labelFor)
import Text.Printf (printf)
import qualified Text.Pandoc.Builder as B
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import Text.Pandoc.Options (CaptionPosition(..), WriterOptions(..))
tableToLaTeX :: PandocMonad m
=> ([Inline] -> LW m (Doc Text))
-> ([Block] -> LW m (Doc Text))
-> Ann.Table
-> LW m (Doc Text)
tableToLaTeX inlnsToLaTeX blksToLaTeX tbl = do
opts <- gets stOptions
let (Ann.Table (ident, _, _) caption specs thead tbodies tfoot) = tbl
CaptionDocs capt captNotes <- captionToLaTeX inlnsToLaTeX caption ident
let hasTopCaption = not (isEmpty capt) &&
writerTableCaptionPosition opts == CaptionAbove
let hasBottomCaption = not (isEmpty capt) &&
writerTableCaptionPosition opts == CaptionBelow
let isSimpleTable =
all ((== ColWidthDefault) . snd) specs &&
all (all isSimpleCell)
(mconcat [ headRows thead
, concatMap bodyRows tbodies
, footRows tfoot
])
let removeNote (Note _) = Span ("", [], []) []
removeNote x = x
let colCount = ColumnCount $ length specs
-- The first head is not repeated on the following pages. If we were to just
-- use a single head, without a separate first head, then the caption would be
-- repeated on all pages that contain a part of the table. We avoid this by
-- making the caption part of the first head. The downside is that we must
-- duplicate the header rows for this.
head' <- do
let mkHead = headToLaTeX blksToLaTeX isSimpleTable colCount
case (hasTopCaption, isEmptyHead thead) of
(False, True) -> return "\\toprule\\noalign{}"
(False, False) -> mkHead thead
(True, True) -> return (capt <> "\\tabularnewline"
$$ "\\toprule\\noalign{}"
$$ "\\endfirsthead")
(True, False) -> do
-- avoid duplicate notes in head and firsthead:
firsthead <- mkHead thead
repeated <- mkHead (walk removeNote thead)
return $ capt <> "\\tabularnewline"
$$ firsthead
$$ "\\endfirsthead"
$$ repeated
rows' <- mapM (rowToLaTeX blksToLaTeX isSimpleTable colCount BodyCell) $
mconcat (map bodyRows tbodies)
lastfoot <- mapM (rowToLaTeX blksToLaTeX isSimpleTable colCount BodyCell) $
footRows tfoot
let foot' = (if isEmptyFoot tfoot
then mempty
else "\\midrule\\noalign{}" $$ vcat lastfoot)
$$ "\\bottomrule\\noalign{}"
$$ (if hasBottomCaption
then "\\tabularnewline" $$ capt
else mempty)
modify $ \s -> s{ stTable = True }
notes <- notesToLaTeX <$> gets stNotes
beamer <- gets stBeamer
return
$ "\\begin{longtable}[]" <>
braces ("@{}" <> colDescriptors isSimpleTable tbl <> "@{}")
-- the @{} removes extra space at beginning and end
$$ head'
$$ "\\endhead"
$$ vcat
-- Longtable is not able to detect pagebreaks in Beamer; this
-- causes problems with the placement of the footer, so make
-- footer and bottom rule part of the body when targeting Beamer.
-- See issue #8638.
(if beamer
then [ vcat rows'
, foot'
]
else [ foot'
, "\\endlastfoot"
, vcat rows'
])
$$ "\\end{longtable}"
$$ captNotes
$$ notes
isSimpleCell :: Ann.Cell -> Bool
isSimpleCell (Ann.Cell _ _ (Cell _attr _align _rowspan _colspan blocks)) =
case blocks of
[Para _] -> not (hasLineBreak blocks)
[Plain _] -> not (hasLineBreak blocks)
[] -> True
_ -> False
where
hasLineBreak = getAny . query isLineBreak
isLineBreak LineBreak = Any True
isLineBreak _ = Any False
-- | Total number of columns in a table.
newtype ColumnCount = ColumnCount Int
-- | Creates column descriptors for the table.
colDescriptors :: Bool -> Ann.Table -> Doc Text
colDescriptors isSimpleTable
(Ann.Table _attr _caption specs _thead _tbodies _tfoot) =
let (aligns, widths) = unzip specs
defaultWidthsOnly = all (== ColWidthDefault) widths
relativeWidths = if defaultWidthsOnly
then replicate (length specs)
(1 / fromIntegral (length specs))
else map toRelWidth widths
in if null aligns
then "l" -- #9350, table needs at least one column spec
else if defaultWidthsOnly && isSimpleTable
then hcat $ map (literal . colAlign) aligns
else (cr <>) . nest 2 . vcat . map literal $
zipWith (toColDescriptor (length specs))
aligns
relativeWidths
where
toColDescriptor :: Int -> Alignment -> Double -> Text
toColDescriptor numcols align width =
T.pack $ printf
">{%s\\arraybackslash}p{(\\linewidth - %d\\tabcolsep) * \\real{%0.4f}}"
(T.unpack (alignCommand align))
((numcols - 1) * 2)
width
toRelWidth ColWidthDefault = 0
toRelWidth (ColWidth w) = w
alignCommand :: Alignment -> Text
alignCommand = \case
AlignLeft -> "\\raggedright"
AlignRight -> "\\raggedleft"
AlignCenter -> "\\centering"
AlignDefault -> "\\raggedright"
colAlign :: Alignment -> Text
colAlign = \case
AlignLeft -> "l"
AlignRight -> "r"
AlignCenter -> "c"
AlignDefault -> "l"
data CaptionDocs =
CaptionDocs
{ captionCommand :: Doc Text
, captionNotes :: Doc Text
}
captionToLaTeX :: PandocMonad m
=> ([Inline] -> LW m (Doc Text))
-> Caption
-> Text -- ^ table identifier (label)
-> LW m CaptionDocs
captionToLaTeX inlnsToLaTeX caption ident = do
(captionText, captForLot, captNotes) <- getCaption inlnsToLaTeX False caption
label <- labelFor ident
return $ CaptionDocs
{ captionNotes = captNotes
, captionCommand = if isEmpty captionText && isEmpty label
then empty
else "\\caption" <> captForLot <>
braces captionText
<> label
}
type BlocksWriter m = [Block] -> LW m (Doc Text)
headToLaTeX :: PandocMonad m
=> BlocksWriter m
-> Bool
-> ColumnCount
-> Ann.TableHead
-> LW m (Doc Text)
headToLaTeX blocksWriter isSimpleTable
colCount (Ann.TableHead _attr headerRows) = do
rowsContents <-
mapM (rowToLaTeX blocksWriter isSimpleTable
colCount HeaderCell . headerRowCells)
headerRows
return ("\\toprule\\noalign{}" $$ vcat rowsContents $$ "\\midrule\\noalign{}")
-- | Converts a row of table cells into a LaTeX row.
rowToLaTeX :: PandocMonad m
=> BlocksWriter m
-> Bool
-> ColumnCount
-> CellType
-> [Ann.Cell]
-> LW m (Doc Text)
rowToLaTeX blocksWriter isSimpleTable colCount celltype row = do
cellsDocs <- mapM (cellToLaTeX blocksWriter isSimpleTable
colCount celltype) (fillRow row)
return $ hsep (intersperse "&" cellsDocs) <> " \\\\"
-- | Pads row with empty cells to adjust for rowspans above this row.
fillRow :: [Ann.Cell] -> [Ann.Cell]
fillRow = go 0
where
go _ [] = []
go n (acell@(Ann.Cell _spec (Ann.ColNumber colnum) cell):cells) =
let (Cell _ _ _ (ColSpan colspan) _) = cell
in map mkEmptyCell [n .. colnum - 1] ++
acell : go (colnum + colspan) cells
mkEmptyCell :: Int -> Ann.Cell
mkEmptyCell colnum =
Ann.Cell ((AlignDefault, ColWidthDefault):|[])
(Ann.ColNumber colnum)
B.emptyCell
isEmptyHead :: Ann.TableHead -> Bool
isEmptyHead (Ann.TableHead _attr []) = True
isEmptyHead (Ann.TableHead _attr rows) = all (null . headerRowCells) rows
isEmptyFoot :: Ann.TableFoot -> Bool
isEmptyFoot (Ann.TableFoot _attr []) = True
isEmptyFoot (Ann.TableFoot _attr rows) = all (null . headerRowCells) rows
-- | Gets all cells in a header row.
headerRowCells :: Ann.HeaderRow -> [Ann.Cell]
headerRowCells (Ann.HeaderRow _attr _rownum cells) = cells
-- | Gets all cells in a body row.
bodyRowCells :: Ann.BodyRow -> [Ann.Cell]
bodyRowCells (Ann.BodyRow _attr _rownum rowhead cells) = rowhead <> cells
-- | Gets a list of rows of the table body, where a row is a simple
-- list of cells.
bodyRows :: Ann.TableBody -> [[Ann.Cell]]
bodyRows (Ann.TableBody _attr _rowheads headerRows rows) =
map headerRowCells headerRows <> map bodyRowCells rows
-- | Gets a list of rows of the table head, where a row is a simple
-- list of cells.
headRows :: Ann.TableHead -> [[Ann.Cell]]
headRows (Ann.TableHead _attr rows) = map headerRowCells rows
-- | Gets a list of rows from the foot, where a row is a simple list
-- of cells.
footRows :: Ann.TableFoot -> [[Ann.Cell]]
footRows (Ann.TableFoot _attr rows) = map headerRowCells rows
-- For simple latex tables (without minipages or parboxes),
-- we need to go to some lengths to get line breaks working:
-- as LineBreak bs = \vtop{\hbox{\strut as}\hbox{\strut bs}}.
fixLineBreaks :: Block -> Block
fixLineBreaks = walk fixLineBreaks'
fixLineBreaks' :: [Inline] -> [Inline]
fixLineBreaks' ils = case splitBy (== LineBreak) ils of
[] -> []
[xs] -> xs
chunks -> RawInline "tex" "\\vtop{" :
concatMap tohbox chunks <>
[RawInline "tex" "}"]
where tohbox ys = RawInline "tex" "\\hbox{\\strut " : ys <>
[RawInline "tex" "}"]
-- We also change display math to inline math, since display
-- math breaks in simple tables.
displayMathToInline :: Inline -> Inline
displayMathToInline (Math DisplayMath x) = Math InlineMath x
displayMathToInline x = x
cellToLaTeX :: PandocMonad m
=> BlocksWriter m
-> Bool
-> ColumnCount
-> CellType
-> Ann.Cell
-> LW m (Doc Text)
cellToLaTeX blockListToLaTeX isSimpleTable colCount celltype annotatedCell = do
let (Ann.Cell specs colnum cell) = annotatedCell
let colWidths = NonEmpty.map snd specs
let hasWidths = NonEmpty.head colWidths /= ColWidthDefault
let specAlign = fst (NonEmpty.head specs)
let (Cell _attr align' rowspan colspan blocks) = cell
let align = case align' of
AlignDefault -> specAlign
_ -> align'
beamer <- gets stBeamer
externalNotes <- gets stExternalNotes
-- See #5367 -- footnotehyper/footnote don't work in beamer,
-- so we need to produce the notes outside the table...
modify $ \st -> st{ stExternalNotes = beamer }
let isPlainOrPara = \case
Para{} -> True
Plain{} -> True
_ -> False
let hasLineBreak LineBreak = Any True
hasLineBreak _ = Any False
let hasLineBreaks = getAny $ query hasLineBreak blocks
result <-
if not hasWidths || (celltype /= HeaderCell
&& all isPlainOrPara blocks
&& not hasLineBreaks)
then
blockListToLaTeX $ walk fixLineBreaks $ walk displayMathToInline blocks
else do
cellContents <- inMinipage $ blockListToLaTeX blocks
let valign = text $ case celltype of
HeaderCell -> "[b]"
BodyCell -> "[t]"
let halign = literal $ alignCommand align
return $ "\\begin{minipage}" <> valign <>
braces "\\linewidth" <> halign <> cr <>
cellContents <>
(if hasLineBreaks then "\\strut" else mempty)
<> cr <>
"\\end{minipage}"
modify $ \st -> st{ stExternalNotes = externalNotes }
when (rowspan /= RowSpan 1) $
modify (\st -> st{ stMultiRow = True })
let inMultiColumn x = case colspan of
(ColSpan 1) -> x
(ColSpan n) ->
let colDescr = multicolumnDescriptor isSimpleTable
align
colWidths
colCount
colnum
in "\\multicolumn"
<> braces (literal (tshow n))
<> braces (literal colDescr)
<> braces ("%\n" <> x)
-- linebreak for readability
let inMultiRow x = case rowspan of
(RowSpan 1) -> x
(RowSpan n) -> let nrows = literal (tshow n)
in "\\multirow" <> braces nrows
<> braces "=" -- width of column
<> braces x
return . inMultiColumn . inMultiRow $ result
-- | Returns the width of a cell spanning @n@ columns.
multicolumnDescriptor :: Bool
-> Alignment
-> NonEmpty ColWidth
-> ColumnCount
-> Ann.ColNumber
-> Text
multicolumnDescriptor isSimpleTable
align
colWidths
(ColumnCount numcols)
(Ann.ColNumber colnum) =
let toWidth = \case
ColWidthDefault -> (1 / fromIntegral numcols)
ColWidth x -> x
colspan = length colWidths
width = sum $ NonEmpty.map toWidth colWidths
-- no column separators at beginning of first and end of last column.
skipColSep = "@{}" :: String
in T.pack $
if isSimpleTable
then printf "%s%s%s"
(if colnum == 0 then skipColSep else "")
(T.unpack (colAlign align))
(if colnum + colspan >= numcols then skipColSep else "")
else printf "%s>{%s\\arraybackslash}p{(\\linewidth - %d\\tabcolsep) * \\real{%0.4f} + %d\\tabcolsep}%s"
(if colnum == 0 then skipColSep else "")
(T.unpack (alignCommand align))
(2 * (numcols - 1))
width
(2 * (colspan - 1))
(if colnum + colspan >= numcols then skipColSep else "")
-- | Perform a conversion, assuming that the context is a minipage.
inMinipage :: Monad m => LW m a -> LW m a
inMinipage action = do
isInMinipage <- gets stInMinipage
modify $ \st -> st{ stInMinipage = True }
result <- action
modify $ \st -> st{ stInMinipage = isInMinipage }
return result
data CellType
= HeaderCell
| BodyCell
deriving Eq