{-# LANGUAGE CPP #-}
module Text.Pandoc.Builder.Monadic
(
Builder
, module Text.Pandoc.Definition
, doc
, setTitle
, setAuthors
, setDate
, setMeta
, text
, str
, strshow
, emph
, underline
, strong
, strikeout
, superscript
, subscript
, smallcaps
, singleQuoted
, doubleQuoted
, cite
, code
, codeWith
, space
, softbreak
, linebreak
, math
, displayMath
, rawInline
, link
, linkWith
, image
, imageWith
, note
, spanWith
, trimInlines
, h1
, h2
, h3
, h4
, h5
, para
, plain
, div'
, span'
, lineBlock
, codeBlockWith
, codeBlock
, rawBlock
, blockQuote
, bulletList
, orderedListWith
, orderedList
, definitionList
, header
, headerWith
, horizontalRule
, cell
, cell'
, emptyCell
, cellWith
, table
, table'
, tableWithColspec
, tableWith
, tableWith'
#if MIN_VERSION_pandoc_types(1,23,0)
, figure
, figureWith
#endif
, caption
, caption'
, emptyCaption
#if MIN_VERSION_pandoc_types(1,22,1)
, imgFigure
, imgFigureWith
#endif
, divWith
, normalizeTableHead
, normalizeTableBody
, normalizeTableFoot
, placeRowSection
, clipRows
) where
import Text.Pandoc.Definition
import Data.Text (Text)
import Text.Pandoc.Builder.Monadic.Verbatim hiding
( simpleCell, cell, table, simpleTable
, caption, simpleCaption
#if MIN_VERSION_pandoc_types(1,22,1)
, simpleFigure
, simpleFigureWith
#endif
, tableWith
)
import Text.Pandoc.Builder.Monadic.Internal (tellOne, runToList)
import Text.Pandoc.Builder.Monadic.Veneer
import qualified Text.Pandoc.Builder.Monadic.Verbatim as V
cell :: Builder Block -> Cell
cell :: Builder Block -> Cell
cell = Builder Block -> Cell
V.simpleCell
cell' :: Alignment -> RowSpan -> ColSpan -> Builder Block -> Cell
cell' :: Alignment -> RowSpan -> ColSpan -> Builder Block -> Cell
cell' = Alignment -> RowSpan -> ColSpan -> Builder Block -> Cell
V.cell
table :: [Builder Block] -> [[Builder Block]] -> Builder Block
table :: [Builder Block] -> [[Builder Block]] -> Builder Block
table = [Builder Block] -> [[Builder Block]] -> Builder Block
V.simpleTable
tableWith :: Attr -> [Builder Block] -> [[Builder Block]] -> Builder Block
tableWith :: Attr -> [Builder Block] -> [[Builder Block]] -> Builder Block
tableWith Attr
attr [Builder Block]
headings [[Builder Block]]
body =
case Builder Block -> [Block]
forall el. Builder el -> [el]
runToList (Builder Block -> [Block]) -> Builder Block -> [Block]
forall a b. (a -> b) -> a -> b
$ [Builder Block] -> [[Builder Block]] -> Builder Block
table [Builder Block]
headings [[Builder Block]]
body of
[Table Attr
_ Caption
a [ColSpec]
b TableHead
c [TableBody]
d TableFoot
e] -> Block -> Builder Block
forall a. a -> Builder a
tellOne (Block -> Builder Block) -> Block -> Builder Block
forall a b. (a -> b) -> a -> b
$ Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
a [ColSpec]
b TableHead
c [TableBody]
d TableFoot
e
[Block]
_ -> [Char] -> Builder Block
forall a. HasCallStack => [Char] -> a
error [Char]
"Invariant broken. Table builder didn't return one element."
table'
:: Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
table' :: Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
table' = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
V.table
tableWith'
:: Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
tableWith' :: Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
tableWith' = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
V.tableWith
caption :: Builder Block -> Caption
caption :: Builder Block -> Caption
caption = Builder Block -> Caption
V.simpleCaption
caption' :: Maybe ShortCaption -> Builder Block -> Caption
caption' :: Maybe ShortCaption -> Builder Block -> Caption
caption' = Maybe ShortCaption -> Builder Block -> Caption
V.caption
#if MIN_VERSION_pandoc_types(1,22,1)
imgFigure :: Builder Inline -> Text -> Text
-> Builder Block
imgFigure :: Builder Inline -> Text -> Text -> Builder Block
imgFigure = Builder Inline -> Text -> Text -> Builder Block
V.simpleFigure
imgFigureWith :: Attr -> Builder Inline -> Text -> Text -> Builder Block
imgFigureWith :: Attr -> Builder Inline -> Text -> Text -> Builder Block
imgFigureWith = Attr -> Builder Inline -> Text -> Text -> Builder Block
V.simpleFigureWith
#endif