{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}

-- We define some instances for Builder here, because this is where we
-- have functions to implement them.
{-# OPTIONS_GHC -Wno-orphans #-}

-- We use named parameters as a form of documentation.
{- HLINT ignore "Eta reduce" -}

-- | This module exports a 1:1 monadic version of pandoc-types' 'Text.Pandoc.Builder'.

module Text.Pandoc.Builder.Monadic.Verbatim
  ( module Text.Pandoc.Definition
  , Builder
  , URL
  , Title
  , Raw

  -- * Top-level
  , doc
  , setTitle
  , setAuthors
  , setDate
  , setMeta

  -- * Inline builders
  , text
  , str
  , 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

  -- * Block builders
  , para
  , plain
  , lineBlock
  , codeBlockWith
  , codeBlock
  , rawBlock
  , blockQuote
  , bulletList
  , orderedListWith
  , orderedList
  , definitionList
  , header
  , headerWith
  , horizontalRule
  , cell
  , simpleCell
  , emptyCell
  , cellWith
  , table
  , simpleTable
  , tableWith
#if MIN_VERSION_pandoc_types(1,23,0)
  , figure
  , figureWith
#endif
  , caption
  , simpleCaption
  , emptyCaption
#if MIN_VERSION_pandoc_types(1,22,1)
  , simpleFigureWith
  , simpleFigure
#endif
  , divWith

  -- * Table processing
  , B.normalizeTableHead
  , B.normalizeTableBody
  , B.normalizeTableFoot
  , B.placeRowSection
  , B.clipRows
  ) where

import Control.Arrow               ((***))
import Data.Text                   (Text)

import Text.Pandoc.Definition
import Data.String (IsString(..))

import Text.Pandoc.Builder.Monadic.Internal
  ( Builder
  , buildMany
  , runToMany
  , runToList
  , tellOne
  )

import qualified Data.Text           as Text
import qualified Text.Pandoc.Builder as B

-- | Type alias for raw output.
type Raw = Text

-- | Type alias for URLs.
type URL = Text

-- | Type alias for Titles.
type Title = Text

instance IsString (Builder Inline) where
  fromString :: String -> Builder Inline
fromString = Text -> Builder Inline
str (Text -> Builder Inline)
-> (String -> Text) -> String -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance IsString (Builder Block) where
  fromString :: String -> Builder Block
fromString = Builder Inline -> Builder Block
plain (Builder Inline -> Builder Block)
-> (String -> Builder Inline) -> String -> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder Inline
str (Text -> Builder Inline)
-> (String -> Text) -> String -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Lifts something (usually a Pandoc data constructor), into
-- a builder which takes a builder.
liftWrapper :: ([a] -> b) -> Builder a -> Builder b
liftWrapper :: forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [a] -> b
f = b -> Builder b
forall a. a -> Builder a
tellOne (b -> Builder b) -> (Builder a -> b) -> Builder a -> Builder b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> b
f ([a] -> b) -> (Builder a -> [a]) -> Builder a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder a -> [a]
forall el. Builder el -> [el]
runToList

liftWrapper' :: (B.Many a -> B.Many b) -> Builder a -> Builder b
liftWrapper' :: forall a b. (Many a -> Many b) -> Builder a -> Builder b
liftWrapper' Many a -> Many b
f = Many b -> Builder b
forall a. Many a -> Builder a
buildMany (Many b -> Builder b)
-> (Builder a -> Many b) -> Builder a -> Builder b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many a -> Many b
f (Many a -> Many b) -> (Builder a -> Many a) -> Builder a -> Many b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder a -> Many a
forall a. Builder a -> Many a
runToMany

-- | Build a pandoc document from a 'Builder' of top-level elements.
doc :: Builder Block -> Pandoc
doc :: Builder Block -> Pandoc
doc = Meta -> [Block] -> Pandoc
B.Pandoc Meta
forall a. Monoid a => a
mempty ([Block] -> Pandoc)
-> (Builder Block -> [Block]) -> Builder Block -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder Block -> [Block]
forall el. Builder el -> [el]
runToList

-- | Set the document's title in the metadata.
setTitle :: Builder Inline -> Pandoc -> Pandoc
setTitle :: Builder Inline -> Pandoc -> Pandoc
setTitle = Inlines -> Pandoc -> Pandoc
B.setTitle (Inlines -> Pandoc -> Pandoc)
-> (Builder Inline -> Inlines)
-> Builder Inline
-> Pandoc
-> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder Inline -> Inlines
forall a. Builder a -> Many a
runToMany

-- | Set the document's authors in the metadata.
setAuthors :: [Builder Inline] -> Pandoc -> Pandoc
setAuthors :: [Builder Inline] -> Pandoc -> Pandoc
setAuthors = [Inlines] -> Pandoc -> Pandoc
B.setAuthors ([Inlines] -> Pandoc -> Pandoc)
-> ([Builder Inline] -> [Inlines])
-> [Builder Inline]
-> Pandoc
-> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder Inline -> Inlines) -> [Builder Inline] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder Inline -> Inlines
forall a. Builder a -> Many a
runToMany

-- | Set the document's date in the metadata.
setDate :: Builder Inline -> Pandoc -> Pandoc
setDate :: Builder Inline -> Pandoc -> Pandoc
setDate = Inlines -> Pandoc -> Pandoc
B.setDate (Inlines -> Pandoc -> Pandoc)
-> (Builder Inline -> Inlines)
-> Builder Inline
-> Pandoc
-> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder Inline -> Inlines
forall a. Builder a -> Many a
runToMany

-- | Set a value in the document's metadata.
setMeta :: (B.HasMeta a, B.ToMetaValue b) => Text -> b -> a -> a 
setMeta :: forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta = Text -> b -> a -> a
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> a -> a
B.setMeta

-- | Convert a 'Text' to a 'Builder' 'Inline', treating interword spaces as 'B.Space's
-- or 'B.SoftBreak's. If you want a 'B.Str' with literal spaces, use 'str'.
text :: Text -> Builder Inline
text :: Text -> Builder Inline
text = Inlines -> Builder Inline
forall a. Many a -> Builder a
buildMany (Inlines -> Builder Inline)
-> (Text -> Inlines) -> Text -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
B.text

-- | Build a string.
str :: Text -> Builder Inline
str :: Text -> Builder Inline
str = Inline -> Builder Inline
forall a. a -> Builder a
tellOne (Inline -> Builder Inline)
-> (Text -> Inline) -> Text -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inline
B.Str

-- | Build an emphasized (usually italicized) inline.
emph :: Builder Inline -> Builder Inline
emph :: Builder Inline -> Builder Inline
emph = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Inline
B.Emph

-- | Build an underlined inline.
underline :: Builder Inline -> Builder Inline
underline :: Builder Inline -> Builder Inline
underline = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Inline
B.Underline

-- | Build a strong (bold) inline.
strong :: Builder Inline -> Builder Inline
strong :: Builder Inline -> Builder Inline
strong = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Inline
B.Strong

-- | Build a strikeout (crossed out) inline.
strikeout :: Builder Inline -> Builder Inline
strikeout :: Builder Inline -> Builder Inline
strikeout = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Inline
B.Strikeout

-- | Build a superscripted inline.
superscript :: Builder Inline -> Builder Inline
superscript :: Builder Inline -> Builder Inline
superscript = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Inline
B.Superscript

-- | Build a subscripted inline.
subscript :: Builder Inline -> Builder Inline
subscript :: Builder Inline -> Builder Inline
subscript = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Inline
B.Subscript

-- | Build a smallcaps inline. See the example in the font-family [MDN page](https://developer.mozilla.org/en-US/docs/Web/CSS/font-variant#examples).
smallcaps :: Builder Inline -> Builder Inline
smallcaps :: Builder Inline -> Builder Inline
smallcaps = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Inline
B.SmallCaps

-- | Build a single-quoted inline.
singleQuoted :: Builder Inline -> Builder Inline
singleQuoted :: Builder Inline -> Builder Inline
singleQuoted = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper (([Inline] -> Inline) -> Builder Inline -> Builder Inline)
-> ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. (a -> b) -> a -> b
$ QuoteType -> [Inline] -> Inline
B.Quoted QuoteType
B.SingleQuote

-- | Build a double-quoted inline.
doubleQuoted :: Builder Inline -> Builder Inline
doubleQuoted :: Builder Inline -> Builder Inline
doubleQuoted = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper (([Inline] -> Inline) -> Builder Inline -> Builder Inline)
-> ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. (a -> b) -> a -> b
$ QuoteType -> [Inline] -> Inline
B.Quoted QuoteType
B.DoubleQuote

-- | Build a citation. See
-- [Citations in note style](https://pandoc.org/chunkedhtml-demo/9.3-citations-in-note-styles.html)
-- and [Specifying a citation style](https://pandoc.org/chunkedhtml-demo/9.2-specifying-a-citation-style.html).
cite :: [B.Citation] -> Builder Inline -> Builder Inline
cite :: [Citation] -> Builder Inline -> Builder Inline
cite [Citation]
citations = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper (([Inline] -> Inline) -> Builder Inline -> Builder Inline)
-> ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. (a -> b) -> a -> b
$ [Citation] -> [Inline] -> Inline
B.Cite [Citation]
citations

-- | Build some inline code.
code :: Text -> Builder Inline
code :: Text -> Builder Inline
code = Attr -> Text -> Builder Inline
codeWith Attr
B.nullAttr

-- | Build some inline code with attributes.
codeWith :: B.Attr -> Text -> Builder Inline
codeWith :: Attr -> Text -> Builder Inline
codeWith = (Inline -> Builder Inline
forall a. a -> Builder a
tellOne (Inline -> Builder Inline)
-> (Text -> Inline) -> Text -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Text -> Inline) -> Text -> Builder Inline)
-> (Attr -> Text -> Inline) -> Attr -> Text -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Inline
B.Code

-- | Build an inter-word space.
space :: Builder Inline
space :: Builder Inline
space = Inline -> Builder Inline
forall a. a -> Builder a
tellOne Inline
B.Space

-- | Build a soft line-break.
softbreak :: Builder Inline
softbreak :: Builder Inline
softbreak = Inline -> Builder Inline
forall a. a -> Builder a
tellOne Inline
B.SoftBreak

-- | Build a hard line-break.
linebreak :: Builder Inline
linebreak :: Builder Inline
linebreak = Inline -> Builder Inline
forall a. a -> Builder a
tellOne Inline
B.LineBreak

-- | Build some inline TeX math.
math :: Text -> Builder Inline
math :: Text -> Builder Inline
math = Inline -> Builder Inline
forall a. a -> Builder a
tellOne (Inline -> Builder Inline)
-> (Text -> Inline) -> Text -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> Text -> Inline
B.Math MathType
B.InlineMath

-- | Build some display-mode TeX math.
-- Display mode is for math that is set apart from the main text.
displayMath :: Text -> Builder Inline
displayMath :: Text -> Builder Inline
displayMath = Inline -> Builder Inline
forall a. a -> Builder a
tellOne (Inline -> Builder Inline)
-> (Text -> Inline) -> Text -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MathType -> Text -> Inline
B.Math MathType
B.DisplayMath

-- | Embed some of the output directly.
-- This is useful to gain access to features of the underlying
-- output which aren't supported by pandoc directly.
rawInline :: Format -> Raw -> Builder Inline
rawInline :: Format -> Text -> Builder Inline
rawInline Format
format = Inline -> Builder Inline
forall a. a -> Builder a
tellOne (Inline -> Builder Inline)
-> (Text -> Inline) -> Text -> Builder Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Inline
B.RawInline Format
format

-- | Build a link from a URL, a title, and some inline pandoc.
link :: URL -> Title -> Builder Inline -> Builder Inline
link :: Text -> Text -> Builder Inline -> Builder Inline
link Text
url Text
title = Attr -> Text -> Text -> Builder Inline -> Builder Inline
linkWith Attr
B.nullAttr Text
url Text
title

-- | Build a link from some attributes, a URL, a title, and some inline pandoc.
linkWith :: B.Attr -> URL -> Title -> Builder Inline -> Builder Inline
linkWith :: Attr -> Text -> Text -> Builder Inline -> Builder Inline
linkWith Attr
attr Text
url Text
title Builder Inline
x = Inline -> Builder Inline
forall a. a -> Builder a
tellOne (Inline -> Builder Inline) -> Inline -> Builder Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Target -> Inline
B.Link Attr
attr (Builder Inline -> [Inline]
forall el. Builder el -> [el]
runToList Builder Inline
x) (Text
url, Text
title)

-- | Build an image from a URL, a title, and some inline pandoc.
image :: URL -> Title -> Builder Inline -> Builder Inline
image :: Text -> Text -> Builder Inline -> Builder Inline
image Text
url Text
title = Attr -> Text -> Text -> Builder Inline -> Builder Inline
imageWith Attr
B.nullAttr Text
url Text
title

-- | Build an image from some attributes, a URL, a title, and some inline pandoc.
imageWith :: B.Attr -> Text -> Text -> Builder Inline -> Builder Inline
imageWith :: Attr -> Text -> Text -> Builder Inline -> Builder Inline
imageWith Attr
attr Text
url Text
title Builder Inline
x = Inline -> Builder Inline
forall a. a -> Builder a
tellOne (Inline -> Builder Inline) -> Inline -> Builder Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Target -> Inline
B.Image Attr
attr (Builder Inline -> [Inline]
forall el. Builder el -> [el]
runToList Builder Inline
x) (Text
url, Text
title)

-- | Build a footnote or endnote from some pandoc blocks.
note :: Builder B.Block -> Builder Inline
note :: Builder Block -> Builder Inline
note = ([Block] -> Inline) -> Builder Block -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Block] -> Inline
B.Note

-- | Build a generic inline container from attributes and more inline pandoc.
spanWith :: B.Attr -> Builder Inline -> Builder Inline
spanWith :: Attr -> Builder Inline -> Builder Inline
spanWith Attr
attr = ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper (([Inline] -> Inline) -> Builder Inline -> Builder Inline)
-> ([Inline] -> Inline) -> Builder Inline -> Builder Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
B.Span Attr
attr

-- | Trim leading and trailing spaces and softbreaks from some inline pandoc.
trimInlines :: Builder Inline -> Builder Inline
trimInlines :: Builder Inline -> Builder Inline
trimInlines = (Inlines -> Inlines) -> Builder Inline -> Builder Inline
forall a b. (Many a -> Many b) -> Builder a -> Builder b
liftWrapper' Inlines -> Inlines
B.trimInlines

-- Block list builders

-- | Build a paragraph.
para :: Builder Inline -> Builder Block
para :: Builder Inline -> Builder Block
para = ([Inline] -> Block) -> Builder Inline -> Builder Block
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Inline] -> Block
B.Para

-- | Build some plain text (not a paragraph).
plain :: Builder Inline -> Builder Block
plain :: Builder Inline -> Builder Block
plain = (Inlines -> Many Block) -> Builder Inline -> Builder Block
forall a b. (Many a -> Many b) -> Builder a -> Builder b
liftWrapper' Inlines -> Many Block
B.plain

-- | Build multiple non-breaking lines.
lineBlock :: [Builder Inline] -> Builder Block
lineBlock :: [Builder Inline] -> Builder Block
lineBlock = Block -> Builder Block
forall a. a -> Builder a
tellOne (Block -> Builder Block)
-> ([Builder Inline] -> Block) -> [Builder Inline] -> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> Block
B.LineBlock ([[Inline]] -> Block)
-> ([Builder Inline] -> [[Inline]]) -> [Builder Inline] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder Inline -> [Inline]) -> [Builder Inline] -> [[Inline]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder Inline -> [Inline]
forall el. Builder el -> [el]
runToList

-- | Build a code block.
codeBlock :: Text -> Builder Block
codeBlock :: Text -> Builder Block
codeBlock = Attr -> Text -> Builder Block
codeBlockWith Attr
B.nullAttr

-- | Build a code block with attributes.
codeBlockWith :: B.Attr -> Text -> Builder Block
codeBlockWith :: Attr -> Text -> Builder Block
codeBlockWith Attr
attrs = Block -> Builder Block
forall a. a -> Builder a
tellOne (Block -> Builder Block)
-> (Text -> Block) -> Text -> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> Text -> Block
B.CodeBlock Attr
attrs

-- | Embed some of the output directly.
-- This is useful to gain access to features of the underlying
-- output which aren't supported by pandoc directly.
rawBlock :: Format -> Raw -> Builder Block
rawBlock :: Format -> Text -> Builder Block
rawBlock Format
format = Block -> Builder Block
forall a. a -> Builder a
tellOne (Block -> Builder Block)
-> (Text -> Block) -> Text -> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> Block
B.RawBlock Format
format

-- | Build a block quote.
blockQuote :: Builder Block -> Builder Block
blockQuote :: Builder Block -> Builder Block
blockQuote = ([Block] -> Block) -> Builder Block -> Builder Block
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper [Block] -> Block
B.BlockQuote

-- | Build an ordered list.
orderedList :: [Builder Block] -> Builder Block
orderedList :: [Builder Block] -> Builder Block
orderedList = ListAttributes -> [Builder Block] -> Builder Block
orderedListWith (Int
1, ListNumberStyle
B.DefaultStyle, ListNumberDelim
B.DefaultDelim)

-- | Build an ordered list with attributes.
orderedListWith :: B.ListAttributes -> [Builder Block] -> Builder Block
orderedListWith :: ListAttributes -> [Builder Block] -> Builder Block
orderedListWith ListAttributes
attrs = Block -> Builder Block
forall a. a -> Builder a
tellOne (Block -> Builder Block)
-> ([Builder Block] -> Block) -> [Builder Block] -> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListAttributes -> [[Block]] -> Block
B.OrderedList ListAttributes
attrs ([[Block]] -> Block)
-> ([Builder Block] -> [[Block]]) -> [Builder Block] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder Block -> [Block]) -> [Builder Block] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder Block -> [Block]
forall el. Builder el -> [el]
runToList

-- | Build a bullet list.
bulletList :: [Builder Block] -> Builder Block
bulletList :: [Builder Block] -> Builder Block
bulletList = Block -> Builder Block
forall a. a -> Builder a
tellOne (Block -> Builder Block)
-> ([Builder Block] -> Block) -> [Builder Block] -> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Block]] -> Block
B.BulletList ([[Block]] -> Block)
-> ([Builder Block] -> [[Block]]) -> [Builder Block] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder Block -> [Block]) -> [Builder Block] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder Block -> [Block]
forall el. Builder el -> [el]
runToList

-- | Build an definition list given a list of tuples, where the first element
-- of each tuple is a term, and the second element is the definition.
definitionList :: [(Builder Inline, [Builder Block])] -> Builder Block
definitionList :: [(Builder Inline, [Builder Block])] -> Builder Block
definitionList = Block -> Builder Block
forall a. a -> Builder a
tellOne (Block -> Builder Block)
-> ([(Builder Inline, [Builder Block])] -> Block)
-> [(Builder Inline, [Builder Block])]
-> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Inline], [[Block]])] -> Block
B.DefinitionList ([([Inline], [[Block]])] -> Block)
-> ([(Builder Inline, [Builder Block])] -> [([Inline], [[Block]])])
-> [(Builder Inline, [Builder Block])]
-> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Builder Inline, [Builder Block]) -> ([Inline], [[Block]]))
-> [(Builder Inline, [Builder Block])] -> [([Inline], [[Block]])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Builder Inline -> [Inline]
forall el. Builder el -> [el]
runToList (Builder Inline -> [Inline])
-> ([Builder Block] -> [[Block]])
-> (Builder Inline, [Builder Block])
-> ([Inline], [[Block]])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Builder Block -> [Block]) -> [Builder Block] -> [[Block]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder Block -> [Block]
forall el. Builder el -> [el]
runToList)

-- | Build a header, given a level and some inline pandoc.
-- You may consider using 'Text.Pandoc.Builder.Monadic.h1' and friends,
-- for a more concise API.
header :: Int -> Builder Inline -> Builder Block
header :: Int -> Builder Inline -> Builder Block
header Int
level Builder Inline
x = Attr -> Int -> Builder Inline -> Builder Block
headerWith Attr
B.nullAttr Int
level Builder Inline
x

-- | Build a header from some attributes, a level and some inline pandoc.
headerWith :: B.Attr -> Int -> Builder Inline -> Builder Block
headerWith :: Attr -> Int -> Builder Inline -> Builder Block
headerWith Attr
attr Int
level = ([Inline] -> Block) -> Builder Inline -> Builder Block
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper (([Inline] -> Block) -> Builder Inline -> Builder Block)
-> ([Inline] -> Block) -> Builder Inline -> Builder Block
forall a b. (a -> b) -> a -> b
$ Int -> Attr -> [Inline] -> Block
B.Header Int
level Attr
attr

-- | Build a horizontal rule.
horizontalRule :: Builder Block
horizontalRule :: Builder Block
horizontalRule = Block -> Builder Block
forall a. a -> Builder a
tellOne Block
B.HorizontalRule

-- | Build a 1x1 cell with default alignment, given some pandoc.
simpleCell :: Builder Block -> B.Cell
simpleCell :: Builder Block -> Cell
simpleCell = Alignment -> RowSpan -> ColSpan -> Builder Block -> Cell
cell Alignment
B.AlignDefault RowSpan
1 ColSpan
1

-- | Build a cell of a table, full API excluding attributes.
cell
  :: B.Alignment
  -> B.RowSpan
  -> B.ColSpan
  -> Builder Block
  -> B.Cell
cell :: Alignment -> RowSpan -> ColSpan -> Builder Block -> Cell
cell = Attr -> Alignment -> RowSpan -> ColSpan -> Builder Block -> Cell
cellWith Attr
B.nullAttr

-- | Build a cell of a table, full API including attributes.
cellWith
  :: B.Attr
  -> B.Alignment
  -> B.RowSpan
  -> B.ColSpan
  -> Builder Block
  -> B.Cell
cellWith :: Attr -> Alignment -> RowSpan -> ColSpan -> Builder Block -> Cell
cellWith Attr
attrs Alignment
align RowSpan
rowspan ColSpan
colspan = Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
B.Cell Attr
attrs Alignment
align RowSpan
rowspan ColSpan
colspan ([Block] -> Cell)
-> (Builder Block -> [Block]) -> Builder Block -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder Block -> [Block]
forall el. Builder el -> [el]
runToList

-- | Build a 1x1 empty cell.
emptyCell :: B.Cell
emptyCell :: Cell
emptyCell = Builder Block -> Cell
simpleCell (Builder Block -> Cell) -> Builder Block -> Cell
forall a b. (a -> b) -> a -> b
$ () -> Builder Block
forall a. a -> BuilderM Block a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Build a table, full API excluding attributes.
table :: B.Caption
      -> [B.ColSpec]
      -> B.TableHead
      -> [B.TableBody]
      -> B.TableFoot
      -> Builder Block
table :: Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
table = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
tableWith Attr
B.nullAttr

-- | Build a table, full API including attributes.
tableWith :: B.Attr
          -> B.Caption
          -> [B.ColSpec]
          -> B.TableHead
          -> [B.TableBody]
          -> B.TableFoot
          -> Builder Block
tableWith :: Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
tableWith = (((((Many Block -> Builder Block
forall a. Many a -> Builder a
buildMany (Many Block -> Builder Block)
-> (TableFoot -> Many Block) -> TableFoot -> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((TableFoot -> Many Block) -> TableFoot -> Builder Block)
-> ([TableBody] -> TableFoot -> Many Block)
-> [TableBody]
-> TableFoot
-> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([TableBody] -> TableFoot -> Many Block)
 -> [TableBody] -> TableFoot -> Builder Block)
-> (TableHead -> [TableBody] -> TableFoot -> Many Block)
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((TableHead -> [TableBody] -> TableFoot -> Many Block)
 -> TableHead -> [TableBody] -> TableFoot -> Builder Block)
-> ([ColSpec]
    -> TableHead -> [TableBody] -> TableFoot -> Many Block)
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Many Block)
 -> [ColSpec]
 -> TableHead
 -> [TableBody]
 -> TableFoot
 -> Builder Block)
-> (Caption
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> Many Block)
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Caption
  -> [ColSpec]
  -> TableHead
  -> [TableBody]
  -> TableFoot
  -> Many Block)
 -> Caption
 -> [ColSpec]
 -> TableHead
 -> [TableBody]
 -> TableFoot
 -> Builder Block)
-> (Attr
    -> Caption
    -> [ColSpec]
    -> TableHead
    -> [TableBody]
    -> TableFoot
    -> Many Block)
-> Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Builder Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Many Block
B.tableWith

-- | Build a table, given a list of header cells, and a list of rows.
simpleTable :: [Builder Block] -> [[Builder Block]] -> Builder Block
simpleTable :: [Builder Block] -> [[Builder Block]] -> Builder Block
simpleTable [Builder Block]
headers [[Builder Block]]
rows = Many Block -> Builder Block
forall a. Many a -> Builder a
buildMany (Many Block -> Builder Block) -> Many Block -> Builder Block
forall a b. (a -> b) -> a -> b
$ [Many Block] -> [[Many Block]] -> Many Block
B.simpleTable ((Builder Block -> Many Block) -> [Builder Block] -> [Many Block]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder Block -> Many Block
forall a. Builder a -> Many a
runToMany [Builder Block]
headers) ((Builder Block -> Many Block) -> [Builder Block] -> [Many Block]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder Block -> Many Block
forall a. Builder a -> Many a
runToMany ([Builder Block] -> [Many Block])
-> [[Builder Block]] -> [[Many Block]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Builder Block]]
rows)

#if MIN_VERSION_pandoc_types(1,23,0)
-- | Build a captioned figure.
-- This is available in pandoc-types >= 1.23, which corresponds to pandoc >= 3.0.
figure :: B.Caption -> Builder Block -> Builder Block
figure :: Caption -> Builder Block -> Builder Block
figure = Attr -> Caption -> Builder Block -> Builder Block
figureWith Attr
B.nullAttr

-- | Build a captioned figure, with attributes.
-- This is available in pandoc-types >= 1.23, which corresponds to pandoc >= 3.0.
figureWith :: B.Attr -> B.Caption -> Builder Block -> Builder Block
figureWith :: Attr -> Caption -> Builder Block -> Builder Block
figureWith Attr
attr Caption
capt = ([Block] -> Block) -> Builder Block -> Builder Block
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper (([Block] -> Block) -> Builder Block -> Builder Block)
-> ([Block] -> Block) -> Builder Block -> Builder Block
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
B.Figure Attr
attr Caption
capt
#endif

-- | Make a caption, with an optional short version.
caption :: Maybe B.ShortCaption -> Builder Block -> B.Caption
caption :: Maybe [Inline] -> Builder Block -> Caption
caption Maybe [Inline]
x = Maybe [Inline] -> [Block] -> Caption
B.Caption Maybe [Inline]
x ([Block] -> Caption)
-> (Builder Block -> [Block]) -> Builder Block -> Caption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder Block -> [Block]
forall el. Builder el -> [el]
runToList

-- | Make a caption, without a short version.
simpleCaption :: Builder Block -> B.Caption
simpleCaption :: Builder Block -> Caption
simpleCaption = Maybe [Inline] -> Builder Block -> Caption
caption Maybe [Inline]
forall a. Maybe a
Nothing

-- | Make an empty caption
emptyCaption :: B.Caption
emptyCaption :: Caption
emptyCaption = Builder Block -> Caption
simpleCaption Builder Block
forall a. Monoid a => a
mempty

#if MIN_VERSION_pandoc_types(1,22,1)
-- | Build a captioned figure, containing an image.
-- This is available in pandoc-types >= 1.22.1, which corresponds to pandoc >= 2.15.
simpleFigure :: Builder Inline -> Text -> Text -> Builder Block
simpleFigure :: Builder Inline -> Text -> Text -> Builder Block
simpleFigure Builder Inline
figureCaption Text
url Text
title = Attr -> Builder Inline -> Text -> Text -> Builder Block
simpleFigureWith Attr
B.nullAttr Builder Inline
figureCaption Text
url Text
title

-- | Build a captioned figure containing an image, with attributes.
-- This is available in pandoc-types >= 1.22.1, which corresponds to pandoc >= 2.15.
simpleFigureWith :: B.Attr -> Builder Inline -> URL -> Title-> Builder Block
simpleFigureWith :: Attr -> Builder Inline -> Text -> Text -> Builder Block
simpleFigureWith Attr
attr Builder Inline
figureCaption Text
url Text
title
  = Many Block -> Builder Block
forall a. Many a -> Builder a
buildMany (Many Block -> Builder Block) -> Many Block -> Builder Block
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Text -> Text -> Many Block
B.simpleFigureWith Attr
attr (Builder Inline -> Inlines
forall a. Builder a -> Many a
runToMany Builder Inline
figureCaption) Text
url Text
title
#endif

-- | Build a generic block container with attributes.
divWith :: B.Attr -> Builder Block -> Builder Block
divWith :: Attr -> Builder Block -> Builder Block
divWith Attr
attr = ([Block] -> Block) -> Builder Block -> Builder Block
forall a b. ([a] -> b) -> Builder a -> Builder b
liftWrapper (([Block] -> Block) -> Builder Block -> Builder Block)
-> ([Block] -> Block) -> Builder Block -> Builder Block
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
B.Div Attr
attr