Copyright | Copyright (C) 2010-2019 John MacFarlane |
---|---|
License | BSD3 |
Maintainer | John MacFarlane <jgm@berkeley.edu> |
Stability | alpha |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
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
- module Text.Pandoc.Definition
- newtype Many a = Many {}
- type Inlines = Many Inline
- type Blocks = Many Block
- (<>) :: Semigroup a => a -> a -> a
- singleton :: a -> Many a
- toList :: Many a -> [a]
- fromList :: [a] -> Many a
- isNull :: Many a -> Bool
- doc :: Blocks -> Pandoc
- class ToMetaValue a where
- toMetaValue :: a -> MetaValue
- class HasMeta a where
- setMeta :: ToMetaValue b => Text -> b -> a -> a
- deleteMeta :: Text -> a -> a
- setTitle :: Inlines -> Pandoc -> Pandoc
- setAuthors :: [Inlines] -> Pandoc -> Pandoc
- setDate :: Inlines -> Pandoc -> Pandoc
- text :: Text -> Inlines
- str :: Text -> Inlines
- emph :: Inlines -> Inlines
- underline :: Inlines -> Inlines
- strong :: Inlines -> Inlines
- strikeout :: Inlines -> Inlines
- superscript :: Inlines -> Inlines
- subscript :: Inlines -> Inlines
- smallcaps :: Inlines -> Inlines
- singleQuoted :: Inlines -> Inlines
- doubleQuoted :: Inlines -> Inlines
- cite :: [Citation] -> Inlines -> Inlines
- codeWith :: Attr -> Text -> Inlines
- code :: Text -> Inlines
- space :: Inlines
- softbreak :: Inlines
- linebreak :: Inlines
- math :: Text -> Inlines
- displayMath :: Text -> Inlines
- rawInline :: Text -> Text -> Inlines
- link :: Text -> Text -> Inlines -> Inlines
- linkWith :: Attr -> Text -> Text -> Inlines -> Inlines
- image :: Text -> Text -> Inlines -> Inlines
- imageWith :: Attr -> Text -> Text -> Inlines -> Inlines
- note :: Blocks -> Inlines
- spanWith :: Attr -> Inlines -> Inlines
- trimInlines :: Inlines -> Inlines
- para :: Inlines -> Blocks
- plain :: Inlines -> Blocks
- lineBlock :: [Inlines] -> Blocks
- codeBlockWith :: Attr -> Text -> Blocks
- codeBlock :: Text -> Blocks
- rawBlock :: Text -> Text -> Blocks
- blockQuote :: Blocks -> Blocks
- bulletList :: [Blocks] -> Blocks
- orderedListWith :: ListAttributes -> [Blocks] -> Blocks
- orderedList :: [Blocks] -> Blocks
- definitionList :: [(Inlines, [Blocks])] -> Blocks
- header :: Int -> Inlines -> Blocks
- headerWith :: Attr -> Int -> Inlines -> Blocks
- horizontalRule :: Blocks
- cell :: Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
- simpleCell :: Blocks -> Cell
- emptyCell :: Cell
- cellWith :: Attr -> Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
- table :: Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
- simpleTable :: [Blocks] -> [[Blocks]] -> Blocks
- tableWith :: Attr -> Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
- caption :: Maybe ShortCaption -> Blocks -> Caption
- simpleCaption :: Blocks -> Caption
- emptyCaption :: Caption
- divWith :: Attr -> Blocks -> Blocks
- normalizeTableHead :: Int -> TableHead -> TableHead
- normalizeTableBody :: Int -> TableBody -> TableBody
- normalizeTableFoot :: Int -> TableFoot -> TableFoot
- placeRowSection :: [RowSpan] -> [Cell] -> ([RowSpan], [Cell], [Cell])
- clipRows :: [Row] -> [Row]
Documentation
module Text.Pandoc.Definition
Instances
Functor Many Source # | |
IsString Inlines Source # | |
Defined in Text.Pandoc.Builder fromString :: String -> Inlines # | |
Foldable Many Source # | |
Defined in Text.Pandoc.Builder fold :: Monoid m => Many m -> 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 # elem :: Eq a => a -> Many a -> Bool # maximum :: Ord a => Many a -> a # | |
Traversable Many Source # | |
Semigroup Inlines Source # | |
Monoid Inlines Source # | |
Arbitrary Blocks Source # | |
Arbitrary Inlines Source # | |
ToMetaValue Blocks Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: Blocks -> MetaValue Source # | |
ToMetaValue Inlines Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: Inlines -> MetaValue Source # | |
Eq a => Eq (Many a) Source # | |
Data a => Data (Many a) Source # | |
Defined in Text.Pandoc.Builder 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 :: (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) # | |
Ord a => Ord (Many a) Source # | |
Read a => Read (Many a) Source # | |
Show a => Show (Many a) Source # | |
Generic (Many a) Source # | |
Semigroup (Many Block) Source # | |
Monoid (Many Block) Source # | |
type Rep (Many a) Source # | |
Defined in Text.Pandoc.Builder |
Document builders
class ToMetaValue a where Source #
toMetaValue :: a -> MetaValue Source #
Instances
ToMetaValue Bool Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: Bool -> MetaValue Source # | |
ToMetaValue String Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: String -> MetaValue Source # | |
ToMetaValue Text Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: Text -> MetaValue Source # | |
ToMetaValue MetaValue Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: MetaValue -> MetaValue Source # | |
ToMetaValue Blocks Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: Blocks -> MetaValue Source # | |
ToMetaValue Inlines Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: Inlines -> MetaValue Source # | |
ToMetaValue a => ToMetaValue [a] Source # | |
Defined in Text.Pandoc.Builder toMetaValue :: [a] -> MetaValue Source # | |
ToMetaValue a => ToMetaValue (Map String a) Source # | |
Defined in Text.Pandoc.Builder | |
ToMetaValue a => ToMetaValue (Map Text a) Source # | |
Defined in Text.Pandoc.Builder |
class HasMeta a where Source #
setMeta :: ToMetaValue b => Text -> b -> a -> a Source #
deleteMeta :: Text -> a -> a Source #
Instances
HasMeta Meta Source # | |
Defined in Text.Pandoc.Builder | |
HasMeta Pandoc Source # | |
Defined in Text.Pandoc.Builder |
Inline list builders
superscript :: Inlines -> Inlines Source #
singleQuoted :: Inlines -> Inlines Source #
doubleQuoted :: Inlines -> Inlines Source #
displayMath :: Text -> Inlines Source #
Display math
trimInlines :: Inlines -> Inlines Source #
Trim leading and trailing spaces and softbreaks from an Inlines.
Block list builders
blockQuote :: Blocks -> Blocks Source #
bulletList :: [Blocks] -> Blocks Source #
orderedListWith :: ListAttributes -> [Blocks] -> Blocks Source #
Ordered list with attributes.
orderedList :: [Blocks] -> Blocks Source #
Ordered list with default attributes.
simpleCell :: Blocks -> Cell Source #
A 1×1 cell with default alignment.
table :: Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks Source #
Table builder. Performs normalization with normalizeTableHead
,
normalizeTableBody
, and normalizeTableFoot
. The number of table
columns is given by the length of [
.ColSpec
]
tableWith :: Attr -> Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks Source #
simpleCaption :: Blocks -> Caption Source #
Table processing
normalizeTableHead :: Int -> TableHead -> TableHead Source #
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 Source #
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.
normalizeTableFoot :: Int -> TableFoot -> TableFoot Source #
Normalize the TableFoot
, as in normalizeTableHead
.
:: [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
to the emptyCell
[
list and using Cell
]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 [
, 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.RowSpan
]
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)