{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
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 :: forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text))
-> ([Block] -> LW m (Doc Text)) -> Table -> LW m (Doc Text)
tableToLaTeX [Inline] -> LW m (Doc Text)
inlnsToLaTeX [Block] -> LW m (Doc Text)
blksToLaTeX Table
tbl = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let (Ann.Table (ident, _, _) caption specs thead tbodies tfoot) = tbl
CaptionDocs capt captNotes <- captionToLaTeX inlnsToLaTeX caption ident
let hasTopCaption = Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
capt) Bool -> Bool -> Bool
&&
WriterOptions -> CaptionPosition
writerTableCaptionPosition WriterOptions
opts CaptionPosition -> CaptionPosition -> Bool
forall a. Eq a => a -> a -> Bool
== CaptionPosition
CaptionAbove
let hasBottomCaption = Bool -> Bool
not (Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
capt) Bool -> Bool -> Bool
&&
WriterOptions -> CaptionPosition
writerTableCaptionPosition WriterOptions
opts CaptionPosition -> CaptionPosition -> Bool
forall a. Eq a => a -> a -> Bool
== CaptionPosition
CaptionBelow
let isSimpleTable =
(ColSpec -> Bool) -> [ColSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((ColWidth -> ColWidth -> Bool
forall a. Eq a => a -> a -> Bool
== ColWidth
ColWidthDefault) (ColWidth -> Bool) -> (ColSpec -> ColWidth) -> ColSpec -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColSpec -> ColWidth
forall a b. (a, b) -> b
snd) [ColSpec]
specs Bool -> Bool -> Bool
&&
([Cell] -> Bool) -> [[Cell]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Cell -> Bool) -> [Cell] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Cell -> Bool
isSimpleCell)
([[[Cell]]] -> [[Cell]]
forall a. Monoid a => [a] -> a
mconcat [ TableHead -> [[Cell]]
headRows TableHead
thead
, (TableBody -> [[Cell]]) -> [TableBody] -> [[Cell]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableBody -> [[Cell]]
bodyRows [TableBody]
tbodies
, TableFoot -> [[Cell]]
footRows TableFoot
tfoot
])
let removeNote (Note [Block]
_) = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
"", [], []) []
removeNote Inline
x = Inline
x
let colCount = Int -> ColumnCount
ColumnCount (Int -> ColumnCount) -> Int -> ColumnCount
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
specs
head' <- do
let mkHead = ([Block] -> LW m (Doc Text))
-> Bool -> ColumnCount -> TableHead -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
BlocksWriter m
-> Bool -> ColumnCount -> TableHead -> LW m (Doc Text)
headToLaTeX [Block] -> LW m (Doc Text)
blksToLaTeX Bool
isSimpleTable ColumnCount
colCount
case (hasTopCaption, isEmptyHead thead) of
(Bool
False, Bool
True) -> Doc Text -> LW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
"\\toprule\\noalign{}"
(Bool
False, Bool
False) -> TableHead -> LW m (Doc Text)
mkHead TableHead
thead
(Bool
True, Bool
True) -> Doc Text -> LW m (Doc Text)
forall a. a -> StateT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"\\tabularnewline"
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\toprule\\noalign{}"
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\endfirsthead")
(Bool
True, Bool
False) -> do
firsthead <- TableHead -> LW m (Doc Text)
mkHead TableHead
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 TableFoot -> Bool
isEmptyFoot TableFoot
tfoot
then Doc Text
forall a. Monoid a => a
mempty
else Doc Text
"\\midrule\\noalign{}" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
lastfoot)
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"\\bottomrule\\noalign{}"
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ (if Bool
hasBottomCaption
then Doc Text
"\\tabularnewline" Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
capt
else Doc Text
forall a. Monoid a => a
mempty)
modify $ \WriterState
s -> WriterState
s{ stTable = True }
notes <- notesToLaTeX <$> gets stNotes
beamer <- gets stBeamer
return
$ "\\begin{longtable}[]" <>
braces ("@{}" <> colDescriptors isSimpleTable tbl <> "@{}")
$$ head'
$$ "\\endhead"
$$ vcat
(if beamer
then [ vcat rows'
, foot'
]
else [ foot'
, "\\endlastfoot"
, vcat rows'
])
$$ "\\end{longtable}"
$$ captNotes
$$ notes
isSimpleCell :: Ann.Cell -> Bool
isSimpleCell :: Cell -> Bool
isSimpleCell (Ann.Cell NonEmpty ColSpec
_ ColNumber
_ (Cell (Text, [Text], [(Text, Text)])
_attr Alignment
_align RowSpan
_rowspan ColSpan
_colspan [Block]
blocks)) =
case [Block]
blocks of
[Para [Inline]
_] -> Bool -> Bool
not ([Block] -> Bool
hasLineBreak [Block]
blocks)
[Plain [Inline]
_] -> Bool -> Bool
not ([Block] -> Bool
hasLineBreak [Block]
blocks)
[] -> Bool
True
[Block]
_ -> Bool
False
where
hasLineBreak :: [Block] -> Bool
hasLineBreak = Any -> Bool
getAny (Any -> Bool) -> ([Block] -> Any) -> [Block] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Block] -> Any
forall c. Monoid c => (Inline -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak
isLineBreak :: Inline -> Any
isLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
isLineBreak Inline
_ = Bool -> Any
Any Bool
False
newtype ColumnCount = ColumnCount Int
colDescriptors :: Bool -> Ann.Table -> Doc Text
colDescriptors :: Bool -> Table -> Doc Text
colDescriptors Bool
isSimpleTable
(Ann.Table (Text, [Text], [(Text, Text)])
_attr Caption
_caption [ColSpec]
specs TableHead
_thead [TableBody]
_tbodies TableFoot
_tfoot) =
let ([Alignment]
aligns, [ColWidth]
widths) = [ColSpec] -> ([Alignment], [ColWidth])
forall a b. [(a, b)] -> ([a], [b])
unzip [ColSpec]
specs
defaultWidthsOnly :: Bool
defaultWidthsOnly = (ColWidth -> Bool) -> [ColWidth] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ColWidth -> ColWidth -> Bool
forall a. Eq a => a -> a -> Bool
== ColWidth
ColWidthDefault) [ColWidth]
widths
relativeWidths :: [Double]
relativeWidths = if Bool
defaultWidthsOnly
then Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
specs)
(Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
specs))
else (ColWidth -> Double) -> [ColWidth] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ColWidth -> Double
toRelWidth [ColWidth]
widths
in if [Alignment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alignment]
aligns
then Doc Text
"l"
else if Bool
defaultWidthsOnly Bool -> Bool -> Bool
&& Bool
isSimpleTable
then [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Alignment -> Doc Text) -> [Alignment] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Alignment -> Text) -> Alignment -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Text
colAlign) [Alignment]
aligns
else (Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text)
-> ([Text] -> Doc Text) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc Text -> Doc Text
forall a. IsString a => Int -> Doc a -> Doc a
nest Int
2 (Doc Text -> Doc Text)
-> ([Text] -> Doc Text) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ([Text] -> [Doc Text]) -> [Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> Doc Text) -> [Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$
(Alignment -> Double -> Text) -> [Alignment] -> [Double] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Alignment -> Double -> Text
toColDescriptor ([ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
specs))
[Alignment]
aligns
[Double]
relativeWidths
where
toColDescriptor :: Int -> Alignment -> Double -> Text
toColDescriptor :: Int -> Alignment -> Double -> Text
toColDescriptor Int
numcols Alignment
align Double
width =
String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> Double -> String
forall r. PrintfType r => String -> r
printf
String
">{%s\\arraybackslash}p{(\\linewidth - %d\\tabcolsep) * \\real{%0.4f}}"
(Text -> String
T.unpack (Alignment -> Text
alignCommand Alignment
align))
((Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
Double
width
toRelWidth :: ColWidth -> Double
toRelWidth ColWidth
ColWidthDefault = Double
0
toRelWidth (ColWidth Double
w) = Double
w
alignCommand :: Alignment -> Text
alignCommand :: Alignment -> Text
alignCommand = \case
Alignment
AlignLeft -> Text
"\\raggedright"
Alignment
AlignRight -> Text
"\\raggedleft"
Alignment
AlignCenter -> Text
"\\centering"
Alignment
AlignDefault -> Text
"\\raggedright"
colAlign :: Alignment -> Text
colAlign :: Alignment -> Text
colAlign = \case
Alignment
AlignLeft -> Text
"l"
Alignment
AlignRight -> Text
"r"
Alignment
AlignCenter -> Text
"c"
Alignment
AlignDefault -> Text
"l"
data CaptionDocs =
CaptionDocs
{ CaptionDocs -> Doc Text
captionCommand :: Doc Text
, CaptionDocs -> Doc Text
captionNotes :: Doc Text
}
captionToLaTeX :: PandocMonad m
=> ([Inline] -> LW m (Doc Text))
-> Caption
-> Text
-> LW m CaptionDocs
captionToLaTeX :: forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text))
-> Caption -> Text -> LW m CaptionDocs
captionToLaTeX [Inline] -> LW m (Doc Text)
inlnsToLaTeX Caption
caption Text
ident = do
(captionText, captForLot, captNotes) <- ([Inline] -> LW m (Doc Text))
-> Bool -> Caption -> LW m (Doc Text, Doc Text, Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text))
-> Bool -> Caption -> LW m (Doc Text, Doc Text, Doc Text)
getCaption [Inline] -> LW m (Doc Text)
inlnsToLaTeX Bool
False Caption
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 :: forall (m :: * -> *).
PandocMonad m =>
BlocksWriter m
-> Bool -> ColumnCount -> TableHead -> LW m (Doc Text)
headToLaTeX BlocksWriter m
blocksWriter Bool
isSimpleTable
ColumnCount
colCount (Ann.TableHead (Text, [Text], [(Text, Text)])
_attr [HeaderRow]
headerRows) = do
rowsContents <-
(HeaderRow -> StateT WriterState m (Doc Text))
-> [HeaderRow] -> StateT WriterState 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 (BlocksWriter m
-> Bool
-> ColumnCount
-> CellType
-> [Cell]
-> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
BlocksWriter m
-> Bool -> ColumnCount -> CellType -> [Cell] -> LW m (Doc Text)
rowToLaTeX BlocksWriter m
blocksWriter Bool
isSimpleTable
ColumnCount
colCount CellType
HeaderCell ([Cell] -> StateT WriterState m (Doc Text))
-> (HeaderRow -> [Cell])
-> HeaderRow
-> StateT WriterState m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderRow -> [Cell]
headerRowCells)
[HeaderRow]
headerRows
return ("\\toprule\\noalign{}" $$ vcat rowsContents $$ "\\midrule\\noalign{}")
rowToLaTeX :: PandocMonad m
=> BlocksWriter m
-> Bool
-> ColumnCount
-> CellType
-> [Ann.Cell]
-> LW m (Doc Text)
rowToLaTeX :: forall (m :: * -> *).
PandocMonad m =>
BlocksWriter m
-> Bool -> ColumnCount -> CellType -> [Cell] -> LW m (Doc Text)
rowToLaTeX BlocksWriter m
blocksWriter Bool
isSimpleTable ColumnCount
colCount CellType
celltype [Cell]
row = do
cellsDocs <- (Cell -> StateT WriterState m (Doc Text))
-> [Cell] -> StateT WriterState 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 (BlocksWriter m
-> Bool
-> ColumnCount
-> CellType
-> Cell
-> StateT WriterState m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
BlocksWriter m
-> Bool -> ColumnCount -> CellType -> Cell -> LW m (Doc Text)
cellToLaTeX BlocksWriter m
blocksWriter Bool
isSimpleTable
ColumnCount
colCount CellType
celltype) ([Cell] -> [Cell]
fillRow [Cell]
row)
return $ hsep (intersperse "&" cellsDocs) <> " \\\\"
fillRow :: [Ann.Cell] -> [Ann.Cell]
fillRow :: [Cell] -> [Cell]
fillRow = Int -> [Cell] -> [Cell]
go Int
0
where
go :: Int -> [Cell] -> [Cell]
go Int
_ [] = []
go Int
n (acell :: Cell
acell@(Ann.Cell NonEmpty ColSpec
_spec (Ann.ColNumber Int
colnum) Cell
cell):[Cell]
cells) =
let (Cell (Text, [Text], [(Text, Text)])
_ Alignment
_ RowSpan
_ (ColSpan Int
colspan) [Block]
_) = Cell
cell
in (Int -> Cell) -> [Int] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Cell
mkEmptyCell [Int
n .. Int
colnum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] [Cell] -> [Cell] -> [Cell]
forall a. [a] -> [a] -> [a]
++
Cell
acell Cell -> [Cell] -> [Cell]
forall a. a -> [a] -> [a]
: Int -> [Cell] -> [Cell]
go (Int
colnum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colspan) [Cell]
cells
mkEmptyCell :: Int -> Ann.Cell
mkEmptyCell :: Int -> Cell
mkEmptyCell Int
colnum =
NonEmpty ColSpec -> ColNumber -> Cell -> Cell
Ann.Cell ((Alignment
AlignDefault, ColWidth
ColWidthDefault)ColSpec -> [ColSpec] -> NonEmpty ColSpec
forall a. a -> [a] -> NonEmpty a
:|[])
(Int -> ColNumber
Ann.ColNumber Int
colnum)
Cell
B.emptyCell
isEmptyHead :: Ann.TableHead -> Bool
isEmptyHead :: TableHead -> Bool
isEmptyHead (Ann.TableHead (Text, [Text], [(Text, Text)])
_attr []) = Bool
True
isEmptyHead (Ann.TableHead (Text, [Text], [(Text, Text)])
_attr [HeaderRow]
rows) = (HeaderRow -> Bool) -> [HeaderRow] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Cell] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cell] -> Bool) -> (HeaderRow -> [Cell]) -> HeaderRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderRow -> [Cell]
headerRowCells) [HeaderRow]
rows
isEmptyFoot :: Ann.TableFoot -> Bool
(Ann.TableFoot (Text, [Text], [(Text, Text)])
_attr []) = Bool
True
isEmptyFoot (Ann.TableFoot (Text, [Text], [(Text, Text)])
_attr [HeaderRow]
rows) = (HeaderRow -> Bool) -> [HeaderRow] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Cell] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Cell] -> Bool) -> (HeaderRow -> [Cell]) -> HeaderRow -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderRow -> [Cell]
headerRowCells) [HeaderRow]
rows
headerRowCells :: Ann.HeaderRow -> [Ann.Cell]
(Ann.HeaderRow (Text, [Text], [(Text, Text)])
_attr RowNumber
_rownum [Cell]
cells) = [Cell]
cells
bodyRowCells :: Ann.BodyRow -> [Ann.Cell]
bodyRowCells :: BodyRow -> [Cell]
bodyRowCells (Ann.BodyRow (Text, [Text], [(Text, Text)])
_attr RowNumber
_rownum [Cell]
rowhead [Cell]
cells) = [Cell]
rowhead [Cell] -> [Cell] -> [Cell]
forall a. Semigroup a => a -> a -> a
<> [Cell]
cells
bodyRows :: Ann.TableBody -> [[Ann.Cell]]
bodyRows :: TableBody -> [[Cell]]
bodyRows (Ann.TableBody (Text, [Text], [(Text, Text)])
_attr RowHeadColumns
_rowheads [HeaderRow]
headerRows [BodyRow]
rows) =
(HeaderRow -> [Cell]) -> [HeaderRow] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map HeaderRow -> [Cell]
headerRowCells [HeaderRow]
headerRows [[Cell]] -> [[Cell]] -> [[Cell]]
forall a. Semigroup a => a -> a -> a
<> (BodyRow -> [Cell]) -> [BodyRow] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map BodyRow -> [Cell]
bodyRowCells [BodyRow]
rows
headRows :: Ann.TableHead -> [[Ann.Cell]]
headRows :: TableHead -> [[Cell]]
headRows (Ann.TableHead (Text, [Text], [(Text, Text)])
_attr [HeaderRow]
rows) = (HeaderRow -> [Cell]) -> [HeaderRow] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map HeaderRow -> [Cell]
headerRowCells [HeaderRow]
rows
footRows :: Ann.TableFoot -> [[Ann.Cell]]
(Ann.TableFoot (Text, [Text], [(Text, Text)])
_attr [HeaderRow]
rows) = (HeaderRow -> [Cell]) -> [HeaderRow] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map HeaderRow -> [Cell]
headerRowCells [HeaderRow]
rows
fixLineBreaks :: Block -> Block
fixLineBreaks :: Block -> Block
fixLineBreaks = ([Inline] -> [Inline]) -> Block -> Block
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
fixLineBreaks'
fixLineBreaks' :: [Inline] -> [Inline]
fixLineBreaks' :: [Inline] -> [Inline]
fixLineBreaks' [Inline]
ils = case (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitBy (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Inline
LineBreak) [Inline]
ils of
[] -> []
[[Inline]
xs] -> [Inline]
xs
[[Inline]]
chunks -> Format -> Text -> Inline
RawInline Format
"tex" Text
"\\vtop{" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:
([Inline] -> [Inline]) -> [[Inline]] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Inline] -> [Inline]
tohbox [[Inline]]
chunks [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<>
[Format -> Text -> Inline
RawInline Format
"tex" Text
"}"]
where tohbox :: [Inline] -> [Inline]
tohbox [Inline]
ys = Format -> Text -> Inline
RawInline Format
"tex" Text
"\\hbox{\\strut " Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
ys [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<>
[Format -> Text -> Inline
RawInline Format
"tex" Text
"}"]
displayMathToInline :: Inline -> Inline
displayMathToInline :: Inline -> Inline
displayMathToInline (Math MathType
DisplayMath Text
x) = MathType -> Text -> Inline
Math MathType
InlineMath Text
x
displayMathToInline Inline
x = Inline
x
cellToLaTeX :: PandocMonad m
=> BlocksWriter m
-> Bool
-> ColumnCount
-> CellType
-> Ann.Cell
-> LW m (Doc Text)
cellToLaTeX :: forall (m :: * -> *).
PandocMonad m =>
BlocksWriter m
-> Bool -> ColumnCount -> CellType -> Cell -> LW m (Doc Text)
cellToLaTeX BlocksWriter m
blockListToLaTeX Bool
isSimpleTable ColumnCount
colCount CellType
celltype Cell
annotatedCell = do
let (Ann.Cell NonEmpty ColSpec
specs ColNumber
colnum Cell
cell) = Cell
annotatedCell
let colWidths :: NonEmpty ColWidth
colWidths = (ColSpec -> ColWidth) -> NonEmpty ColSpec -> NonEmpty ColWidth
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ColSpec -> ColWidth
forall a b. (a, b) -> b
snd NonEmpty ColSpec
specs
let hasWidths :: Bool
hasWidths = NonEmpty ColWidth -> ColWidth
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty ColWidth
colWidths ColWidth -> ColWidth -> Bool
forall a. Eq a => a -> a -> Bool
/= ColWidth
ColWidthDefault
let specAlign :: Alignment
specAlign = ColSpec -> Alignment
forall a b. (a, b) -> a
fst (NonEmpty ColSpec -> ColSpec
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty ColSpec
specs)
let (Cell (Text, [Text], [(Text, Text)])
_attr Alignment
align' RowSpan
rowspan ColSpan
colspan [Block]
blocks) = Cell
cell
let align :: Alignment
align = case Alignment
align' of
Alignment
AlignDefault -> Alignment
specAlign
Alignment
_ -> Alignment
align'
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
externalNotes <- gets stExternalNotes
modify $ \WriterState
st -> WriterState
st{ stExternalNotes = beamer }
let isPlainOrPara = \case
Para{} -> Bool
True
Plain{} -> Bool
True
Block
_ -> Bool
False
let hasLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
hasLineBreak Inline
_ = Bool -> Any
Any Bool
False
let hasLineBreaks = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (Inline -> Any) -> [Block] -> Any
forall c. Monoid c => (Inline -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
hasLineBreak [Block]
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 = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ case CellType
celltype of
CellType
HeaderCell -> String
"[b]"
CellType
BodyCell -> String
"[t]"
let halign = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Alignment -> Text
alignCommand Alignment
align
return $ "\\begin{minipage}" <> valign <>
braces "\\linewidth" <> halign <> cr <>
cellContents <>
(if hasLineBreaks then "\\strut" else mempty)
<> cr <>
"\\end{minipage}"
modify $ \WriterState
st -> WriterState
st{ stExternalNotes = externalNotes }
when (rowspan /= RowSpan 1) $
modify (\WriterState
st -> WriterState
st{ stMultiRow = True })
let inMultiColumn Doc Text
x = case ColSpan
colspan of
(ColSpan Int
1) -> Doc Text
x
(ColSpan Int
n) ->
let colDescr :: Text
colDescr = Bool
-> Alignment
-> NonEmpty ColWidth
-> ColumnCount
-> ColNumber
-> Text
multicolumnDescriptor Bool
isSimpleTable
Alignment
align
NonEmpty ColWidth
colWidths
ColumnCount
colCount
ColNumber
colnum
in Doc Text
"\\multicolumn"
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
n))
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
colDescr)
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces (Doc Text
"%\n" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
x)
let inMultiRow Doc Text
x = case RowSpan
rowspan of
(RowSpan Int
1) -> Doc Text
x
(RowSpan Int
n) -> let nrows :: Doc Text
nrows = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Int -> Text
forall a. Show a => a -> Text
tshow Int
n)
in Doc Text
"\\multirow" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
nrows
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
"="
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
braces Doc Text
x
return . inMultiColumn . inMultiRow $ result
multicolumnDescriptor :: Bool
-> Alignment
-> NonEmpty ColWidth
-> ColumnCount
-> Ann.ColNumber
-> Text
multicolumnDescriptor :: Bool
-> Alignment
-> NonEmpty ColWidth
-> ColumnCount
-> ColNumber
-> Text
multicolumnDescriptor Bool
isSimpleTable
Alignment
align
NonEmpty ColWidth
colWidths
(ColumnCount Int
numcols)
(Ann.ColNumber Int
colnum) =
let toWidth :: ColWidth -> Double
toWidth = \case
ColWidth
ColWidthDefault -> (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numcols)
ColWidth Double
x -> Double
x
colspan :: Int
colspan = NonEmpty ColWidth -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty ColWidth
colWidths
width :: Double
width = NonEmpty Double -> Double
forall a. Num a => NonEmpty a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (NonEmpty Double -> Double) -> NonEmpty Double -> Double
forall a b. (a -> b) -> a -> b
$ (ColWidth -> Double) -> NonEmpty ColWidth -> NonEmpty Double
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ColWidth -> Double
toWidth NonEmpty ColWidth
colWidths
skipColSep :: String
skipColSep = String
"@{}" :: String
in String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
if Bool
isSimpleTable
then String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s%s%s"
(if Int
colnum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then String
skipColSep else String
"")
(Text -> String
T.unpack (Alignment -> Text
colAlign Alignment
align))
(if Int
colnum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colspan Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
numcols then String
skipColSep else String
"")
else String
-> String -> String -> Int -> Double -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s>{%s\\arraybackslash}p{(\\linewidth - %d\\tabcolsep) * \\real{%0.4f} + %d\\tabcolsep}%s"
(if Int
colnum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then String
skipColSep else String
"")
(Text -> String
T.unpack (Alignment -> Text
alignCommand Alignment
align))
(Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
numcols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
Double
width
(Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
colspan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
(if Int
colnum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
colspan Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
numcols then String
skipColSep else String
"")
inMinipage :: Monad m => LW m a -> LW m a
inMinipage :: forall (m :: * -> *) a. Monad m => LW m a -> LW m a
inMinipage LW m a
action = do
isInMinipage <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stInMinipage
modify $ \WriterState
st -> WriterState
st{ stInMinipage = True }
result <- action
modify $ \WriterState
st -> WriterState
st{ stInMinipage = isInMinipage }
return result
data CellType
=
| BodyCell
deriving CellType -> CellType -> Bool
(CellType -> CellType -> Bool)
-> (CellType -> CellType -> Bool) -> Eq CellType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CellType -> CellType -> Bool
== :: CellType -> CellType -> Bool
$c/= :: CellType -> CellType -> Bool
/= :: CellType -> CellType -> Bool
Eq