pandoc-types-1.17.2: Types for representing a structured document

CopyrightCopyright (C) 2010-2016 John MacFarlane
LicenseBSD3
MaintainerJohn MacFarlane <jgm@berkeley.edu>
Stabilityalpha
Portabilityportable
Safe HaskellNone
LanguageHaskell98

Text.Pandoc.Builder

Contents

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 Source #

Constructors

Many 

Fields

Instances

Functor Many Source # 

Methods

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

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

IsString Inlines Source # 

Methods

fromString :: String -> Inlines #

Foldable Many Source # 

Methods

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 #

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 #

Traversable Many Source # 

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) #

Monoid Inlines Source # 
ToMetaValue Blocks Source # 
ToMetaValue Inlines Source # 
Eq a => Eq (Many a) Source # 

Methods

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

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

Data a => Data (Many a) Source # 

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 :: (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 # 

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 #

Read a => Read (Many a) Source # 
Show a => Show (Many a) Source # 

Methods

showsPrec :: Int -> Many a -> ShowS #

show :: Many a -> String #

showList :: [Many a] -> ShowS #

Generic (Many a) Source # 

Associated Types

type Rep (Many a) :: * -> * #

Methods

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

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

Monoid (Many Block) Source # 
type Rep (Many a) Source # 
type Rep (Many a) = D1 (MetaData "Many" "Text.Pandoc.Builder" "pandoc-types-1.17.2-Ghy4DucDgvl71lAVfVeTg1" True) (C1 (MetaCons "Many" PrefixI True) (S1 (MetaSel (Just Symbol "unMany") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Seq a))))

(<>) :: Monoid m => m -> m -> m infixr 6 #

An infix synonym for mappend.

Since: 4.5.0.0

toList :: Many a -> [a] Source #

fromList :: [a] -> Many a Source #

Document builders

class HasMeta a where Source #

Minimal complete definition

setMeta, deleteMeta

Methods

setMeta :: ToMetaValue b => String -> b -> a -> a Source #

deleteMeta :: String -> a -> a Source #

Inline list builders

text :: String -> Inlines Source #

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

codeWith :: Attr -> String -> Inlines Source #

Inline code with attributes.

code :: String -> Inlines Source #

Plain inline code.

math :: String -> Inlines Source #

Inline math

displayMath :: String -> Inlines Source #

Display math

link Source #

Arguments

:: String

URL

-> String

Title

-> Inlines

Label

-> Inlines 

linkWith Source #

Arguments

:: Attr

Attributes

-> String

URL

-> String

Title

-> Inlines

Label

-> Inlines 

image Source #

Arguments

:: String

URL

-> String

Title

-> Inlines

Alt text

-> Inlines 

imageWith Source #

Arguments

:: Attr

Attributes

-> String

URL

-> String

Title

-> Inlines

Alt text

-> Inlines 

trimInlines :: Inlines -> Inlines Source #

Trim leading and trailing spaces and softbreaks from an Inlines.

Block list builders

codeBlockWith :: Attr -> String -> Blocks Source #

A code block with attributes.

codeBlock :: String -> Blocks Source #

A plain code block.

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

Ordered list with attributes.

orderedList :: [Blocks] -> Blocks Source #

Ordered list with default attributes.

header Source #

Arguments

:: Int

Level

-> Inlines 
-> Blocks 

table Source #

Arguments

:: Inlines

Caption

-> [(Alignment, Double)]

Column alignments and fractional widths

-> [Blocks]

Headers

-> [[Blocks]]

Rows

-> Blocks 

simpleTable Source #

Arguments

:: [Blocks]

Headers

-> [[Blocks]]

Rows

-> Blocks 

A simple table without a caption.