pandoc-types-1.23.1: Types for representing a structured document
CopyrightCopyright (C) 2010-2023 John MacFarlane
LicenseBSD3
MaintainerJohn MacFarlane <jgm@berkeley.edu>
Stabilityalpha
Portabilityportable
Safe HaskellSafe-Inferred
LanguageHaskell2010

Text.Pandoc.Builder

Description

Convenience functions for building pandoc documents programmatically.

Example of use (with OverloadedStrings pragma):

import Text.Pandoc.Builder

myDoc :: Pandoc
myDoc = setTitle "My title" $ doc $
  para "This is the first paragraph" <>
  para ("And " <> emph "another" <> ".") <>
  bulletList [ para "item one" <> para "continuation"
             , plain ("item two and a " <>
                 link "/url" "go to url" "link")
             ]

Isn't that nicer than writing the following?

import Text.Pandoc.Definition
import Data.Map (fromList)

myDoc :: Pandoc
myDoc = Pandoc (Meta {unMeta = fromList [("title",
          MetaInlines [Str "My",Space,Str "title"])]})
        [Para [Str "This",Space,Str "is",Space,Str "the",Space,Str "first",
         Space,Str "paragraph"],Para [Str "And",Space,Emph [Str "another"],
         Str "."]
        ,BulletList [
          [Para [Str "item",Space,Str "one"]
          ,Para [Str "continuation"]]
         ,[Plain [Str "item",Space,Str "two",Space,Str "and",Space,
                  Str "a",Space,Link nullAttr [Str "link"] ("/url","go to url")]]]]

And of course, you can use Haskell to define your own builders:

import Text.Pandoc.Builder
import Text.JSON
import Control.Arrow ((***))
import Data.Monoid (mempty)

-- | Converts a JSON document into 'Blocks'.
json :: String -> Blocks
json x =
  case decode x of
       Ok y    -> jsValueToBlocks y
       Error y -> error y
   where jsValueToBlocks x =
          case x of
           JSNull         -> mempty
           JSBool x       -> plain $ text $ show x
           JSRational _ x -> plain $ text $ show x
           JSString x     -> plain $ text $ fromJSString x
           JSArray xs     -> bulletList $ map jsValueToBlocks xs
           JSObject x     -> definitionList $
                              map (text *** (:[]) . jsValueToBlocks) $
                              fromJSObject x
Synopsis

Documentation

newtype Many a #

Constructors

Many 

Fields

Instances

Instances details
Arbitrary Blocks # 
Instance details

Defined in Text.Pandoc.Arbitrary

Arbitrary Inlines # 
Instance details

Defined in Text.Pandoc.Arbitrary

Foldable Many # 
Instance details

Defined in Text.Pandoc.Builder

Methods

fold :: Monoid m => Many m -> m

foldMap :: Monoid m => (a -> m) -> Many a -> m

foldMap' :: Monoid m => (a -> m) -> Many a -> m

foldr :: (a -> b -> b) -> b -> Many a -> b

foldr' :: (a -> b -> b) -> b -> Many a -> b

foldl :: (b -> a -> b) -> b -> Many a -> b

foldl' :: (b -> a -> b) -> b -> Many a -> b

foldr1 :: (a -> a -> a) -> Many a -> a

foldl1 :: (a -> a -> a) -> Many a -> a

toList :: Many a -> [a]

null :: Many a -> Bool

length :: Many a -> Int

elem :: Eq a => a -> Many a -> Bool

maximum :: Ord a => Many a -> a

minimum :: Ord a => Many a -> a

sum :: Num a => Many a -> a

product :: Num a => Many a -> a

IsString Inlines # 
Instance details

Defined in Text.Pandoc.Builder

Methods

fromString :: String -> Inlines

Traversable Many # 
Instance details

Defined in Text.Pandoc.Builder

Methods

traverse :: Applicative f => (a -> f b) -> Many a -> f (Many b)

sequenceA :: Applicative f => Many (f a) -> f (Many a)

mapM :: Monad m => (a -> m b) -> Many a -> m (Many b)

sequence :: Monad m => Many (m a) -> m (Many a)

Functor Many # 
Instance details

Defined in Text.Pandoc.Builder

Methods

fmap :: (a -> b) -> Many a -> Many b #

(<$) :: a -> Many b -> Many a #

Monoid Blocks # 
Instance details

Defined in Text.Pandoc.Builder

Monoid Inlines # 
Instance details

Defined in Text.Pandoc.Builder

Semigroup Blocks # 
Instance details

Defined in Text.Pandoc.Builder

Methods

(<>) :: Blocks -> Blocks -> Blocks #

sconcat :: NonEmpty Blocks -> Blocks

stimes :: Integral b => b -> Blocks -> Blocks

Semigroup Inlines # 
Instance details

Defined in Text.Pandoc.Builder

Methods

(<>) :: Inlines -> Inlines -> Inlines #

sconcat :: NonEmpty Inlines -> Inlines

stimes :: Integral b => b -> Inlines -> Inlines

ToMetaValue Blocks # 
Instance details

Defined in Text.Pandoc.Builder

ToMetaValue Inlines # 
Instance details

Defined in Text.Pandoc.Builder

Data a => Data (Many a) # 
Instance details

Defined in Text.Pandoc.Builder

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Many a -> c (Many a)

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Many a)

toConstr :: Many a -> Constr

dataTypeOf :: Many a -> DataType

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Many a))

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Many a))

gmapT :: (forall b. Data b => b -> b) -> Many a -> Many a

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Many a -> r

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Many a -> r

gmapQ :: (forall d. Data d => d -> u) -> Many a -> [u]

gmapQi :: Int -> (forall d. Data d => d -> u) -> Many a -> u

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Many a -> m (Many a)

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Many a -> m (Many a)

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Many a -> m (Many a)

Generic (Many a) # 
Instance details

Defined in Text.Pandoc.Builder

Associated Types

type Rep (Many a) :: Type -> Type

Methods

from :: Many a -> Rep (Many a) x

to :: Rep (Many a) x -> Many a

Read a => Read (Many a) # 
Instance details

Defined in Text.Pandoc.Builder

Methods

readsPrec :: Int -> ReadS (Many a)

readList :: ReadS [Many a]

readPrec :: ReadPrec (Many a)

readListPrec :: ReadPrec [Many a]

Show a => Show (Many a) # 
Instance details

Defined in Text.Pandoc.Builder

Methods

showsPrec :: Int -> Many a -> ShowS

show :: Many a -> String

showList :: [Many a] -> ShowS

Eq a => Eq (Many a) # 
Instance details

Defined in Text.Pandoc.Builder

Methods

(==) :: Many a -> Many a -> Bool

(/=) :: Many a -> Many a -> Bool

Ord a => Ord (Many a) # 
Instance details

Defined in Text.Pandoc.Builder

Methods

compare :: Many a -> Many a -> Ordering

(<) :: Many a -> Many a -> Bool

(<=) :: Many a -> Many a -> Bool

(>) :: Many a -> Many a -> Bool

(>=) :: Many a -> Many a -> Bool

max :: Many a -> Many a -> Many a

min :: Many a -> Many a -> Many a

type Rep (Many a) # 
Instance details

Defined in Text.Pandoc.Builder

type Rep (Many a) = D1 ('MetaData "Many" "Text.Pandoc.Builder" "pandoc-types-1.23.1-45sXE9u6ZETDNYo8x4tU2U" 'True) (C1 ('MetaCons "Many" 'PrefixI 'True) (S1 ('MetaSel ('Just "unMany") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Seq a))))

(<>) :: Semigroup a => a -> a -> a #

singleton :: a -> Many a #

toList :: Many a -> [a] #

fromList :: [a] -> Many a #

isNull :: Many a -> Bool #

Deprecated: Use null instead

Document builders

class ToMetaValue a where #

Methods

toMetaValue :: a -> MetaValue #

Instances

Instances details
ToMetaValue Blocks # 
Instance details

Defined in Text.Pandoc.Builder

ToMetaValue Inlines # 
Instance details

Defined in Text.Pandoc.Builder

ToMetaValue MetaValue # 
Instance details

Defined in Text.Pandoc.Builder

ToMetaValue Text # 
Instance details

Defined in Text.Pandoc.Builder

Methods

toMetaValue :: Text -> MetaValue #

ToMetaValue String # 
Instance details

Defined in Text.Pandoc.Builder

Methods

toMetaValue :: String -> MetaValue #

ToMetaValue Bool # 
Instance details

Defined in Text.Pandoc.Builder

Methods

toMetaValue :: Bool -> MetaValue #

ToMetaValue a => ToMetaValue [a] # 
Instance details

Defined in Text.Pandoc.Builder

Methods

toMetaValue :: [a] -> MetaValue #

ToMetaValue a => ToMetaValue (Map Text a) # 
Instance details

Defined in Text.Pandoc.Builder

Methods

toMetaValue :: Map Text a -> MetaValue #

ToMetaValue a => ToMetaValue (Map String a) # 
Instance details

Defined in Text.Pandoc.Builder

Methods

toMetaValue :: Map String a -> MetaValue #

class HasMeta a where #

Methods

setMeta :: ToMetaValue b => Text -> b -> a -> a #

deleteMeta :: Text -> a -> a #

Instances

Instances details
HasMeta Meta # 
Instance details

Defined in Text.Pandoc.Builder

Methods

setMeta :: ToMetaValue b => Text -> b -> Meta -> Meta #

deleteMeta :: Text -> Meta -> Meta #

HasMeta Pandoc # 
Instance details

Defined in Text.Pandoc.Builder

Methods

setMeta :: ToMetaValue b => Text -> b -> Pandoc -> Pandoc #

deleteMeta :: Text -> Pandoc -> Pandoc #

Inline list builders

text :: Text -> Inlines #

Convert a Text to Inlines, treating interword spaces as Spaces or SoftBreaks. If you want a Str with literal spaces, use str.

str :: Text -> Inlines #

codeWith :: Attr -> Text -> Inlines #

Inline code with attributes.

code :: Text -> Inlines #

Plain inline code.

math :: Text -> Inlines #

Inline math

displayMath :: Text -> Inlines #

Display math

rawInline :: Text -> Text -> Inlines #

link #

Arguments

:: Text

URL

-> Text

Title

-> Inlines

Label

-> Inlines 

linkWith #

Arguments

:: Attr

Attributes

-> Text

URL

-> Text

Title

-> Inlines

Label

-> Inlines 

image #

Arguments

:: Text

URL

-> Text

Title

-> Inlines

Alt text

-> Inlines 

imageWith #

Arguments

:: Attr

Attributes

-> Text

URL

-> Text

Title

-> Inlines

Alt text

-> Inlines 

trimInlines :: Inlines -> Inlines #

Trim leading and trailing spaces and softbreaks from an Inlines.

Block list builders

codeBlockWith :: Attr -> Text -> Blocks #

A code block with attributes.

codeBlock :: Text -> Blocks #

A plain code block.

rawBlock :: Text -> Text -> Blocks #

orderedListWith :: ListAttributes -> [Blocks] -> Blocks #

Ordered list with attributes.

orderedList :: [Blocks] -> Blocks #

Ordered list with default attributes.

header #

Arguments

:: Int

Level

-> Inlines 
-> Blocks 

headerWith :: Attr -> Int -> Inlines -> Blocks #

simpleCell :: Blocks -> Cell #

A 1×1 cell with default alignment.

emptyCell :: Cell #

A 1×1 empty cell.

table :: Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks #

Table builder. Performs normalization with normalizeTableHead, normalizeTableBody, and normalizeTableFoot. The number of table columns is given by the length of [ColSpec].

simpleTable #

Arguments

:: [Blocks]

Headers

-> [[Blocks]]

Rows

-> Blocks 

A simple table without a caption.

simpleFigureWith :: Attr -> Inlines -> Text -> Text -> Blocks #

Creates a simple figure from attributes, a figure caption, an image path and image title. The attributes are used as the image attributes.

simpleFigure :: Inlines -> Text -> Text -> Blocks #

Table processing

normalizeTableHead :: Int -> TableHead -> TableHead #

Normalize the TableHead with clipRows and placeRowSection so that when placed on a grid with the given width and a height equal to the number of rows in the initial TableHead, there will be no empty spaces or overlapping cells, and the cells will not protrude beyond the grid.

normalizeTableBody :: Int -> TableBody -> TableBody #

Normalize the intermediate head and body section of a TableBody, as in normalizeTableHead, but additionally ensure that row head cells do not go beyond the row head inside the intermediate body.

placeRowSection #

Arguments

:: [RowSpan]

The overhang of the previous grid row

-> [Cell]

The cells to lay on the grid row

-> ([RowSpan], [Cell], [Cell])

The overhang of the current grid row, the normalized cells that fit on the current row, and the remaining unmodified cells

Normalize the given list of cells so that they fit on a single grid row. The RowSpan values of the cells are assumed to be valid (clamped to lie between 1 and the remaining grid height). The cells in the list are also assumed to be able to fill the entire grid row. These conditions can be met by appending repeat emptyCell to the [Cell] list and using clipRows on the entire table section beforehand.

Normalization follows the principle that cells are placed on a grid row in order, each at the first available grid position from the left, having their ColSpan reduced if they would overlap with a previous cell, stopping once the row is filled. Only the dimensions of cells are changed, and only of those cells that fit on the row.

Possible overlap is detected using the given [RowSpan], which is the "overhang" of the previous grid row, a list of the heights of cells that descend through the previous row, reckoned only from the previous row. Its length should be the width (number of columns) of the current grid row.

For example, the numbers in the following headerless grid table represent the overhang at each grid position for that table:

    1   1   1   1
  +---+---+---+---+
  | 1 | 2   2 | 3 |
  +---+       +   +
  | 1 | 1   1 | 2 |
  +---+---+---+   +
  | 1   1 | 1 | 1 |
  +---+---+---+---+

In any table, the row before the first has an overhang of replicate tableWidth 1, since there are no cells to descend into the table from there. The overhang of the first row in the example is [1, 2, 2, 3].

So if after clipRows the unnormalized second row of that example table were

r = [("a", 1, 2),("b", 2, 3)] -- the cells displayed as (label, RowSpan, ColSpan) only

a correct invocation of placeRowSection to normalize it would be

>>> placeRowSection [1, 2, 2, 3] $ r ++ repeat emptyCell
([1, 1, 1, 2], [("a", 1, 1)], [("b", 2, 3)] ++ repeat emptyCell) -- wouldn't stop printing, of course

and if the third row were only [("c", 1, 2)], then the expression would be

>>> placeRowSection [1, 1, 1, 2] $ [("c", 1, 2)] ++ repeat emptyCell
([1, 1, 1, 1], [("c", 1, 2), emptyCell], repeat emptyCell)

clipRows :: [Row] -> [Row] #

Ensure that the height of each cell in a table section lies between 1 and the distance from its row to the end of the section. So if there were four rows in the input list, the cells in the second row would have their height clamped between 1 and 3.