{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
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, brackets, 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.Types
( LW, WriterState (stBeamer, stInMinipage, stMultiRow
, stTable, stOptions) )
import Text.Pandoc.Writers.LaTeX.Util (labelFor, withExternalNotes,
getAccumulatedNotes)
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
let (Ann.Table (Text
ident, [Text]
classes, [(Text, Text)]
kvs) Caption
caption [ColSpec]
specs TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = Table
tbl
let placement :: Doc Text
placement = Doc Text -> Doc Text
forall a. HasChars a => Doc a -> Doc a
brackets (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. Monoid a => a
mempty (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> (Text -> String) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
(Maybe Text -> Doc Text) -> Maybe Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"latex-placement" [(Text, Text)]
kvs
beamer <- (WriterState -> Bool) -> StateT WriterState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Bool
stBeamer
let float = Text
"float" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes
let renderTable = do
capt <- ([Inline] -> LW m (Doc Text)) -> Caption -> Text -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text)) -> Caption -> Text -> LW m (Doc Text)
captionToLaTeX [Inline] -> LW m (Doc Text)
inlnsToLaTeX Caption
caption Text
ident
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 colDesc' = Bool -> Table -> Doc Text
colDescriptors Bool
isSimpleTable Table
tbl
let colDesc = 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
colDesc' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"@{}")
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
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
let mkRow = ([Block] -> LW m (Doc Text))
-> Bool -> ColumnCount -> CellType -> [Cell] -> LW m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
BlocksWriter m
-> Bool -> ColumnCount -> CellType -> [Cell] -> LW m (Doc Text)
rowToLaTeX [Block] -> LW m (Doc Text)
blksToLaTeX Bool
isSimpleTable ColumnCount
colCount CellType
BodyCell
if float
then tableToLaTeXTable placement colDesc mkHead mkRow capt thead tbodies tfoot
else tableToLaTeXLongtable colDesc mkHead mkRow capt thead tbodies tfoot
if float || beamer
then ($$) <$> withExternalNotes renderTable <*> getAccumulatedNotes
else renderTable
tableToLaTeXTable :: PandocMonad m
=> Doc Text
-> Doc Text
-> (Ann.TableHead -> LW m (Doc Text))
-> ([Ann.Cell] -> LW m (Doc Text))
-> Doc Text
-> Ann.TableHead
-> [Ann.TableBody]
-> Ann.TableFoot
-> LW m (Doc Text)
tableToLaTeXTable :: forall (m :: * -> *).
PandocMonad m =>
Doc Text
-> Doc Text
-> (TableHead -> LW m (Doc Text))
-> ([Cell] -> LW m (Doc Text))
-> Doc Text
-> TableHead
-> [TableBody]
-> TableFoot
-> LW m (Doc Text)
tableToLaTeXTable Doc Text
placement Doc Text
colDesc TableHead -> LW m (Doc Text)
mkHead [Cell] -> LW m (Doc Text)
mkRow Doc Text
capt TableHead
thead [TableBody]
tbodies TableFoot
tfoot = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
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
head' <- if isEmptyHead thead
then return "\\toprule\\noalign{}"
else mkHead thead
rows' <- mapM mkRow $ mconcat (map bodyRows tbodies)
lastfoot <- mapM mkRow $ 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{}"
modify $ \WriterState
s -> WriterState
s{ stTable = True }
let makeUnnumbered Doc a
x = Doc a
"{\\def\\LTcaptype{none} % do not increment counter" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ Doc a
"}"
return
$ (if null capt then makeUnnumbered else id)
$ "\\begin{table}" <> placement
$$ "\\centering"
$$ (if hasTopCaption
then capt <> "\\tabularnewline"
else mempty)
$$ "\\begin{tabular}" <> colDesc
$$ head'
$$ vcat rows'
$$ foot'
$$ "\\end{tabular}"
$$ (if hasBottomCaption
then capt <> "\\tabularnewline"
else mempty)
$$ "\\end{table}"
tableToLaTeXLongtable :: PandocMonad m
=> Doc Text
-> (Ann.TableHead -> LW m (Doc Text))
-> ([Ann.Cell] -> LW m (Doc Text))
-> Doc Text
-> Ann.TableHead
-> [Ann.TableBody]
-> Ann.TableFoot
-> LW m (Doc Text)
tableToLaTeXLongtable :: forall (m :: * -> *).
PandocMonad m =>
Doc Text
-> (TableHead -> LW m (Doc Text))
-> ([Cell] -> LW m (Doc Text))
-> Doc Text
-> TableHead
-> [TableBody]
-> TableFoot
-> LW m (Doc Text)
tableToLaTeXLongtable Doc Text
colDesc TableHead -> LW m (Doc Text)
mkHead [Cell] -> LW m (Doc Text)
mkRow Doc Text
capt TableHead
thead [TableBody]
tbodies TableFoot
tfoot = do
opts <- (WriterState -> WriterOptions)
-> StateT WriterState m WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
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
head' <- do
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
let removeNote (Note [Block]
_) = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
"", [], []) []
removeNote Inline
x = Inline
x
repeated <- mkHead (walk removeNote thead)
return $ capt <> "\\tabularnewline"
$$ firsthead
$$ "\\endfirsthead"
$$ repeated
rows' <- mapM mkRow $ mconcat (map bodyRows tbodies)
lastfoot <- mapM mkRow $ 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 }
beamer <- gets stBeamer
let makeUnnumbered Doc a
x = Doc a
"{\\def\\LTcaptype{none} % do not increment counter" Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ Doc a
x Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
$$ Doc a
"}"
return
$ (if null capt then makeUnnumbered else id)
$ "\\begin{longtable}[]" <> colDesc
$$ head'
$$ "\\endhead"
$$ vcat
(if beamer
then [ vcat rows'
, foot'
]
else [ foot'
, "\\endlastfoot"
, vcat rows'
])
$$ "\\end{longtable}"
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"
captionToLaTeX :: PandocMonad m
=> ([Inline] -> LW m (Doc Text))
-> Caption
-> Text
-> LW m (Doc Text)
captionToLaTeX :: forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text)) -> Caption -> Text -> LW m (Doc Text)
captionToLaTeX [Inline] -> LW m (Doc Text)
inlnsToLaTeX Caption
caption Text
ident = do
(captionText, captForLot) <- ([Inline] -> LW m (Doc Text))
-> Caption -> LW m (Doc Text, Doc Text)
forall (m :: * -> *).
PandocMonad m =>
([Inline] -> LW m (Doc Text))
-> Caption -> LW m (Doc Text, Doc Text)
getCaption [Inline] -> LW m (Doc Text)
inlnsToLaTeX Caption
caption
label <- labelFor ident
return $ 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'
let isPlainOrPara :: Block -> Bool
isPlainOrPara = \case
Para{} -> Bool
True
Plain{} -> Bool
True
Block
_ -> Bool
False
let hasLineBreak :: Inline -> Any
hasLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
hasLineBreak Inline
_ = Bool -> Any
Any Bool
False
let hasLineBreaks :: Bool
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 Bool -> Bool
not Bool
hasWidths Bool -> Bool -> Bool
|| (CellType
celltype CellType -> CellType -> Bool
forall a. Eq a => a -> a -> Bool
/= CellType
HeaderCell
Bool -> Bool -> Bool
&& (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Block -> Bool
isPlainOrPara [Block]
blocks
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasLineBreaks)
then
BlocksWriter m
blockListToLaTeX BlocksWriter m -> BlocksWriter m
forall a b. (a -> b) -> a -> b
$ (Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
fixLineBreaks ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
displayMathToInline [Block]
blocks
else do
cellContents <- LW m (Doc Text) -> LW m (Doc Text)
forall (m :: * -> *) a. Monad m => LW m a -> LW m a
inMinipage (LW m (Doc Text) -> LW m (Doc Text))
-> LW m (Doc Text) -> LW m (Doc Text)
forall a b. (a -> b) -> a -> b
$ BlocksWriter m
blockListToLaTeX [Block]
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}"
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 hasColWidths = Bool -> Bool
not ((ColWidth -> Bool) -> NonEmpty 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) NonEmpty ColWidth
colWidths)
let aligncmd = case Alignment
specAlign of
Alignment
AlignCenter -> Doc Text
"\\centering\\arraybackslash "
Alignment
AlignRight -> Doc Text
"\\raggedright\\arraybackslash "
Alignment
_ -> Doc Text
forall a. Monoid a => a
mempty
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
(if Bool
hasColWidths
then Doc Text
"="
else 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
aligncmd Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> 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