Copyright | Copyright (C) 2010-2019 John MacFarlane |
---|---|
License | BSD3 |
Maintainer | John MacFarlane <jgm@berkeley.edu> |
Stability | alpha |
Portability | portable |
Safe Haskell | None |
Language | Haskell98 |
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 => String -> b -> a -> a
- deleteMeta :: String -> a -> a
- setTitle :: Inlines -> Pandoc -> Pandoc
- setAuthors :: [Inlines] -> Pandoc -> Pandoc
- setDate :: Inlines -> Pandoc -> Pandoc
- text :: String -> Inlines
- str :: String -> Inlines
- emph :: 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 -> String -> Inlines
- code :: String -> Inlines
- space :: Inlines
- softbreak :: Inlines
- linebreak :: Inlines
- math :: String -> Inlines
- displayMath :: String -> Inlines
- rawInline :: String -> String -> Inlines
- link :: String -> String -> Inlines -> Inlines
- linkWith :: Attr -> String -> String -> Inlines -> Inlines
- image :: String -> String -> Inlines -> Inlines
- imageWith :: Attr -> String -> String -> Inlines -> Inlines
- note :: Blocks -> Inlines
- spanWith :: Attr -> Inlines -> Inlines
- trimInlines :: Inlines -> Inlines
- para :: Inlines -> Blocks
- plain :: Inlines -> Blocks
- lineBlock :: [Inlines] -> Blocks
- codeBlockWith :: Attr -> String -> Blocks
- codeBlock :: String -> Blocks
- rawBlock :: String -> String -> 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
- table :: Inlines -> [(Alignment, Double)] -> [Blocks] -> [[Blocks]] -> Blocks
- simpleTable :: [Blocks] -> [[Blocks]] -> Blocks
- divWith :: Attr -> Blocks -> Blocks
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 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 |
class HasMeta a where Source #
setMeta :: ToMetaValue b => String -> b -> a -> a Source #
deleteMeta :: String -> 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 :: String -> 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.