summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <fiddlosopher@gmail.com>2013-05-10 22:53:35 -0700
committerJohn MacFarlane <fiddlosopher@gmail.com>2013-06-24 20:29:41 -0700
commitf869f7e08dad315945d52be3fcacf6ff0c05c5c1 (patch)
tree4c426ebf5a30b51499859f9d41a890534b6a18a6
parente32a8f5981969bb6d0a11bd945188c35817e4d96 (diff)
Use new flexible metadata type.
* Depend on pandoc 1.12. * Added yaml dependency. * `Text.Pandoc.XML`: Removed `stripTags`. (API change.) * `Text.Pandoc.Shared`: Added `metaToJSON`. This will be used in writers to create a JSON object for use in the templates from the pandoc metadata. * Revised readers and writers to use the new Meta type. * `Text.Pandoc.Options`: Added `Ext_yaml_title_block`. * Markdown reader: Added support for YAML metadata block. Note that it must come at the beginning of the document. * `Text.Pandoc.Parsing.ParserState`: Replace `stateTitle`, `stateAuthors`, `stateDate` with `stateMeta`. * RST reader: Improved metadata. Treat initial field list as metadata when standalone specified. Previously ALL fields "title", "author", "date" in field lists were treated as metadata, even if not at the beginning. Use `subtitle` metadata field for subtitle. * `Text.Pandoc.Templates`: Export `renderTemplate'` that takes a string instead of a compiled template.. * OPML template: Use 'for' loop for authors. * Org template: '#+TITLE:' is inserted before the title. Previously the writer did this.
m---------data/templates14
-rw-r--r--pandoc.cabal8
-rw-r--r--src/Text/Pandoc.hs32
-rw-r--r--src/Text/Pandoc/Options.hs2
-rw-r--r--src/Text/Pandoc/Parsing.hs16
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs43
-rw-r--r--src/Text/Pandoc/Readers/Haddock.hs2
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs49
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs93
-rw-r--r--src/Text/Pandoc/Readers/Native.hs8
-rw-r--r--src/Text/Pandoc/Readers/RST.hs73
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs2
-rw-r--r--src/Text/Pandoc/Shared.hs77
-rw-r--r--src/Text/Pandoc/Templates.hs11
-rw-r--r--src/Text/Pandoc/Writers/AsciiDoc.hs45
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs36
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs8
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs40
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs19
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs15
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs115
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs98
-rw-r--r--src/Text/Pandoc/Writers/Man.hs36
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs47
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs17
-rw-r--r--src/Text/Pandoc/Writers/Native.hs4
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs3
-rw-r--r--src/Text/Pandoc/Writers/OPML.hs31
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs37
-rw-r--r--src/Text/Pandoc/Writers/Org.hs35
-rw-r--r--src/Text/Pandoc/Writers/RST.hs62
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs28
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs42
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs12
-rw-r--r--src/Text/Pandoc/XML.hs13
-rw-r--r--tests/Tests/Arbitrary.hs11
-rw-r--r--tests/Tests/Helpers.hs6
-rw-r--r--tests/Tests/Readers/RST.hs34
-rw-r--r--tests/Tests/Writers/Native.hs2
-rw-r--r--tests/testsuite.native4
40 files changed, 678 insertions, 552 deletions
diff --git a/data/templates b/data/templates
-Subproject 05719b6491d26aa0fcb6a7de64aeebfc7595526
+Subproject 050ea0fa8dc51d1e722f8e88b7ce9a792474082
diff --git a/pandoc.cabal b/pandoc.cabal
index bbbcd06bc..4f3039e7f 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -1,5 +1,5 @@
Name: pandoc
-Version: 1.11.2
+Version: 1.12
Cabal-Version: >= 1.10
Build-Type: Custom
License: GPL
@@ -247,7 +247,7 @@ Library
random >= 1 && < 1.1,
extensible-exceptions >= 0.1 && < 0.2,
citeproc-hs >= 0.3.7 && < 0.4,
- pandoc-types >= 1.10 && < 1.11,
+ pandoc-types >= 1.12 && < 1.13,
aeson >= 0.6 && < 0.7,
tagsoup >= 0.12.5 && < 0.13,
base64-bytestring >= 0.1 && < 1.1,
@@ -259,6 +259,8 @@ Library
blaze-markup >= 0.5.1 && < 0.6,
attoparsec >= 0.10 && < 0.11,
stringable >= 0.1 && < 0.2,
+ yaml >= 0.8 && < 0.9,
+ vector >= 0.10 && < 0.11,
hslua >= 0.3 && < 0.4
if flag(embed_data_files)
cpp-options: -DEMBED_DATA_FILES
@@ -393,7 +395,7 @@ Test-Suite test-pandoc
Build-Depends: base >= 4.2 && < 5,
syb >= 0.1 && < 0.5,
pandoc,
- pandoc-types >= 1.10 && < 1.11,
+ pandoc-types >= 1.12 && < 1.13,
bytestring >= 0.9 && < 0.11,
text >= 0.11 && < 0.12,
directory >= 1 && < 1.3,
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index 5f5c893d8..86e78ce53 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -193,18 +193,18 @@ readers :: [(String, ReaderOptions -> String -> IO Pandoc)]
readers = [("native" , \_ s -> return $ readNative s)
,("json" , \_ s -> return $ checkJSON
$ decode $ UTF8.fromStringLazy s)
- ,("markdown" , markdown)
- ,("markdown_strict" , markdown)
- ,("markdown_phpextra" , markdown)
- ,("markdown_github" , markdown)
- ,("markdown_mmd", markdown)
- ,("rst" , \o s -> return $ readRST o s)
- ,("mediawiki" , \o s -> return $ readMediaWiki o s)
- ,("docbook" , \o s -> return $ readDocBook o s)
- ,("opml" , \o s -> return $ readOPML o s)
- ,("textile" , \o s -> return $ readTextile o s) -- TODO : textile+lhs
- ,("html" , \o s -> return $ readHtml o s)
- ,("latex" , \o s -> return $ readLaTeX o s)
+ ,("markdown" , markdown)
+ ,("markdown_strict" , markdown)
+ ,("markdown_phpextra" , markdown)
+ ,("markdown_github" , markdown)
+ ,("markdown_mmd", markdown)
+ ,("rst" , \o s -> return $ readRST o s)
+ ,("mediawiki" , \o s -> return $ readMediaWiki o s)
+ ,("docbook" , \o s -> return $ readDocBook o s)
+ ,("opml" , \o s -> return $ readOPML o s)
+ ,("textile" , \o s -> return $ readTextile o s) -- TODO : textile+lhs
+ ,("html" , \o s -> return $ readHtml o s)
+ ,("latex" , \o s -> return $ readLaTeX o s)
,("haddock" , \o s -> return $ readHaddock o s)
]
@@ -218,10 +218,10 @@ writers = [
("native" , PureStringWriter writeNative)
,("json" , PureStringWriter $ \_ -> UTF8.toStringLazy . encode)
,("docx" , IOByteStringWriter writeDocx)
- ,("odt" , IOByteStringWriter writeODT)
- ,("epub" , IOByteStringWriter $ \o ->
- writeEPUB o{ writerEpubVersion = Just EPUB2 })
- ,("epub3" , IOByteStringWriter $ \o ->
+ ,("odt" , IOByteStringWriter writeODT)
+ ,("epub" , IOByteStringWriter $ \o ->
+ writeEPUB o{ writerEpubVersion = Just EPUB2 })
+ ,("epub3" , IOByteStringWriter $ \o ->
writeEPUB o{ writerEpubVersion = Just EPUB3 })
,("fb2" , IOStringWriter writeFB2)
,("html" , PureStringWriter writeHtmlString)
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 4eb527b6e..c88cee9c4 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -55,6 +55,7 @@ data Extension =
Ext_footnotes -- ^ Pandoc/PHP/MMD style footnotes
| Ext_inline_notes -- ^ Pandoc-style inline notes
| Ext_pandoc_title_block -- ^ Pandoc title block
+ | Ext_yaml_title_block -- ^ YAML metadata block
| Ext_mmd_title_block -- ^ Multimarkdown metadata block
| Ext_table_captions -- ^ Pandoc-style table captions
| Ext_implicit_figures -- ^ A paragraph with just an image is a figure
@@ -106,6 +107,7 @@ pandocExtensions = Set.fromList
[ Ext_footnotes
, Ext_inline_notes
, Ext_pandoc_title_block
+ , Ext_yaml_title_block
, Ext_table_captions
, Ext_implicit_figures
, Ext_simple_tables
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 71b16b7ca..fce6f2248 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -148,7 +148,7 @@ where
import Text.Pandoc.Definition
import Text.Pandoc.Options
-import Text.Pandoc.Builder (Blocks, Inlines, rawBlock)
+import Text.Pandoc.Builder (Blocks, Inlines, rawBlock, HasMeta(..))
import Text.Pandoc.XML (fromEntities)
import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
import Text.Parsec
@@ -799,9 +799,7 @@ data ParserState = ParserState
stateSubstitutions :: SubstTable, -- ^ List of substitution references
stateNotes :: NoteTable, -- ^ List of notes (raw bodies)
stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies)
- stateTitle :: [Inline], -- ^ Title of document
- stateAuthors :: [[Inline]], -- ^ Authors of document
- stateDate :: [Inline], -- ^ Date of document
+ stateMeta :: Meta, -- ^ Document metadata
stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links)
stateIdentifiers :: [String], -- ^ List of header identifiers used
@@ -816,6 +814,12 @@ data ParserState = ParserState
instance Default ParserState where
def = defaultParserState
+instance HasMeta ParserState where
+ setMeta field val st =
+ st{ stateMeta = setMeta field val $ stateMeta st }
+ deleteMeta field st =
+ st{ stateMeta = deleteMeta field $ stateMeta st }
+
defaultParserState :: ParserState
defaultParserState =
ParserState { stateOptions = def,
@@ -828,9 +832,7 @@ defaultParserState =
stateSubstitutions = M.empty,
stateNotes = [],
stateNotes' = [],
- stateTitle = [],
- stateAuthors = [],
- stateDate = [],
+ stateMeta = nullMeta,
stateHeaderTable = [],
stateHeaders = M.empty,
stateIdentifiers = [],
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 32ce46fba..f6657a4d1 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -39,7 +39,7 @@ module Text.Pandoc.Readers.HTML ( readHtml
import Text.HTML.TagSoup
import Text.HTML.TagSoup.Match
import Text.Pandoc.Definition
-import Text.Pandoc.Builder (text, toList)
+import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Shared
import Text.Pandoc.Options
import Text.Pandoc.Parsing
@@ -47,6 +47,7 @@ import Data.Maybe ( fromMaybe, isJust )
import Data.List ( intercalate )
import Data.Char ( isDigit )
import Control.Monad ( liftM, guard, when, mzero )
+import Control.Applicative ( (<$>), (<$) )
isSpace :: Char -> Bool
isSpace ' ' = True
@@ -58,32 +59,26 @@ isSpace _ = False
readHtml :: ReaderOptions -- ^ Reader options
-> String -- ^ String to parse (assumes @'\n'@ line endings)
-> Pandoc
-readHtml opts inp = Pandoc meta blocks
- where blocks = case runParser parseBody def{ stateOptions = opts }
- "source" rest of
- Left err' -> error $ "\nError at " ++ show err'
- Right result -> result
- tags = canonicalizeTags $
+readHtml opts inp =
+ case runParser parseDoc def{ stateOptions = opts } "source" tags of
+ Left err' -> error $ "\nError at " ++ show err'
+ Right result -> result
+ where tags = canonicalizeTags $
parseTagsOptions parseOptions{ optTagPosition = True } inp
- hasHeader = any (~== TagOpen "head" []) tags
- (meta, rest) = if hasHeader
- then parseHeader tags
- else (Meta [] [] [], tags)
+ parseDoc = do
+ blocks <- (fixPlains False . concat) <$> manyTill block eof
+ meta <- stateMeta <$> getState
+ return $ Pandoc meta blocks
type TagParser = Parser [Tag String] ParserState
--- TODO - fix this - not every header has a title tag
-parseHeader :: [Tag String] -> (Meta, [Tag String])
-parseHeader tags = (Meta{docTitle = tit'', docAuthors = [], docDate = []}, rest)
- where (tit,_) = break (~== TagClose "title") $ drop 1 $
- dropWhile (\t -> not $ t ~== TagOpen "title" []) tags
- tit' = concatMap fromTagText $ filter isTagText tit
- tit'' = normalizeSpaces $ toList $ text tit'
- rest = drop 1 $ dropWhile (\t -> not $ t ~== TagClose "head" ||
- t ~== TagOpen "body" []) tags
+pBody :: TagParser [Block]
+pBody = pInTags "body" block
-parseBody :: TagParser [Block]
-parseBody = liftM (fixPlains False . concat) $ manyTill block eof
+pHead :: TagParser [Block]
+pHead = pInTags "head" $ pTitle <|> ([] <$ pAnyTag)
+ where pTitle = pInTags "title" inline >>= setTitle . normalizeSpaces
+ setTitle t = [] <$ (updateState $ B.setMeta "title" (B.fromList t))
block :: TagParser [Block]
block = choice
@@ -94,6 +89,8 @@ block = choice
, pList
, pHrule
, pSimpleTable
+ , pHead
+ , pBody
, pPlain
, pRawHtmlBlock
]
@@ -366,7 +363,7 @@ pImage = do
let url = fromAttrib "src" tag
let title = fromAttrib "title" tag
let alt = fromAttrib "alt" tag
- return [Image (toList $ text alt) (escapeURI url, title)]
+ return [Image (B.toList $ B.text alt) (escapeURI url, title)]
pCode :: TagParser [Inline]
pCode = try $ do
diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs
index 081ec7b5e..0e74406ef 100644
--- a/src/Text/Pandoc/Readers/Haddock.hs
+++ b/src/Text/Pandoc/Readers/Haddock.hs
@@ -21,7 +21,7 @@ import Text.Pandoc.Readers.Haddock.Parse
readHaddock :: ReaderOptions -- ^ Reader options
-> String -- ^ String to parse
-> Pandoc
-readHaddock _ s = Pandoc (Meta [] [] []) blocks
+readHaddock _ s = Pandoc nullMeta blocks
where
blocks = case parseParas (tokenise s (0,0)) of
Left [] -> error "parse failure"
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index f3f76ce5c..0d4afb2a7 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -65,13 +65,11 @@ parseLaTeX = do
bs <- blocks
eof
st <- getState
- let title' = stateTitle st
- let authors' = stateAuthors st
- let date' = stateDate st
+ let meta = stateMeta st
refs <- getOption readerReferences
mbsty <- getOption readerCitationStyle
- return $ processBiblio mbsty refs
- $ Pandoc (Meta title' authors' date') $ toList bs
+ let (Pandoc _ bs') = processBiblio mbsty refs $ doc bs
+ return $ Pandoc meta bs'
type LP = Parser [Char] ParserState
@@ -249,13 +247,13 @@ ignoreBlocks name = (name, doraw <|> (mempty <$ optargs))
blockCommands :: M.Map String (LP Blocks)
blockCommands = M.fromList $
[ ("par", mempty <$ skipopts)
- , ("title", mempty <$ (skipopts *> tok >>= addTitle))
- , ("subtitle", mempty <$ (skipopts *> tok >>= addSubtitle))
+ , ("title", mempty <$ (skipopts *> tok >>= addMeta "title"))
+ , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
, ("author", mempty <$ (skipopts *> authors))
-- -- in letter class, temp. store address & sig as title, author
- , ("address", mempty <$ (skipopts *> tok >>= addTitle))
+ , ("address", mempty <$ (skipopts *> tok >>= addMeta "address"))
, ("signature", mempty <$ (skipopts *> authors))
- , ("date", mempty <$ (skipopts *> tok >>= addDate))
+ , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
-- sectioning
, ("chapter", updateState (\s -> s{ stateHasChapters = True })
*> section nullAttr 0)
@@ -301,12 +299,8 @@ blockCommands = M.fromList $
, "hspace", "vspace"
]
-addTitle :: Inlines -> LP ()
-addTitle tit = updateState (\s -> s{ stateTitle = toList tit })
-
-addSubtitle :: Inlines -> LP ()
-addSubtitle tit = updateState (\s -> s{ stateTitle = stateTitle s ++
- toList (str ":" <> linebreak <> tit) })
+addMeta :: ToMetaValue a => String -> a -> LP ()
+addMeta field val = updateState $ setMeta field val
authors :: LP ()
authors = try $ do
@@ -317,10 +311,7 @@ authors = try $ do
-- skip e.g. \vspace{10pt}
auths <- sepBy oneAuthor (controlSeq "and")
char '}'
- updateState (\s -> s { stateAuthors = map (normalizeSpaces . toList) auths })
-
-addDate :: Inlines -> LP ()
-addDate dat = updateState (\s -> s{ stateDate = toList dat })
+ addMeta "authors" (map trimInlines auths)
section :: Attr -> Int -> LP Blocks
section attr lvl = do
@@ -872,20 +863,24 @@ letter_contents = do
bs <- blocks
st <- getState
-- add signature (author) and address (title)
- let addr = case stateTitle st of
- [] -> mempty
- x -> para $ trimInlines $ fromList x
- updateState $ \s -> s{ stateAuthors = [], stateTitle = [] }
+ let addr = case lookupMeta "address" (stateMeta st) of
+ Just (MetaBlocks [Plain xs]) ->
+ para $ trimInlines $ fromList xs
+ _ -> mempty
return $ addr <> bs -- sig added by \closing
closing :: LP Blocks
closing = do
contents <- tok
st <- getState
- let sigs = case stateAuthors st of
- [] -> mempty
- xs -> para $ trimInlines $ fromList
- $ intercalate [LineBreak] xs
+ let extractInlines (MetaBlocks [Plain ys]) = ys
+ extractInlines (MetaBlocks [Para ys ]) = ys
+ extractInlines _ = []
+ let sigs = case lookupMeta "author" (stateMeta st) of
+ Just (MetaList xs) ->
+ para $ trimInlines $ fromList $
+ intercalate [LineBreak] $ map extractInlines xs
+ _ -> mempty
return $ para (trimInlines contents) <> sigs
item :: LP Blocks
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 35c236041..8c836614f 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -37,7 +37,13 @@ import Data.Ord ( comparing )
import Data.Char ( isAlphaNum, toLower )
import Data.Maybe
import Text.Pandoc.Definition
+import qualified Data.Text as T
+import Data.Text (Text)
+import qualified Data.Yaml as Yaml
+import qualified Data.HashMap.Strict as H
import qualified Text.Pandoc.Builder as B
+import qualified Text.Pandoc.UTF8 as UTF8
+import qualified Data.Vector as V
import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
import Text.Pandoc.Options
import Text.Pandoc.Shared
@@ -196,12 +202,13 @@ dateLine = try $ do
skipSpaces
trimInlinesF . mconcat <$> manyTill inline newline
-titleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines)
+titleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
titleBlock = pandocTitleBlock
+ <|> yamlTitleBlock
<|> mmdTitleBlock
- <|> return (mempty, return [], mempty)
+ <|> return (return id)
-pandocTitleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines)
+pandocTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
pandocTitleBlock = try $ do
guardEnabled Ext_pandoc_title_block
lookAhead (char '%')
@@ -209,25 +216,78 @@ pandocTitleBlock = try $ do
author <- option (return []) authorsLine
date <- option mempty dateLine
optional blanklines
- return (title, author, date)
-
-mmdTitleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines)
+ return $ do
+ title' <- title
+ author' <- author
+ date' <- date
+ return $ B.setMeta "title" title'
+ . B.setMeta "author" author'
+ . B.setMeta "date" date'
+
+yamlTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
+yamlTitleBlock = try $ do
+ guardEnabled Ext_yaml_title_block
+ string "---"
+ blankline
+ rawYaml <- unlines <$> manyTill anyLine stopLine
+ optional blanklines
+ opts <- stateOptions <$> getState
+ return $ return $
+ case Yaml.decode $ UTF8.fromString rawYaml of
+ Just (Yaml.Object hashmap) ->
+ H.foldrWithKey (\k v f ->
+ if ignorable k
+ then f
+ else B.setMeta (T.unpack k) (yamlToMeta opts v) . f)
+ id hashmap
+ _ -> fail "Could not parse yaml object"
+
+-- ignore fields starting with _
+ignorable :: Text -> Bool
+ignorable t = (T.pack "_") `T.isPrefixOf` t
+
+toMetaValue :: ReaderOptions -> Text -> MetaValue
+toMetaValue opts x =
+ case readMarkdown opts (T.unpack x) of
+ Pandoc _ [Plain xs] -> MetaInlines xs
+ Pandoc _ [Para xs]
+ | endsWithNewline x -> MetaBlocks [Para xs]
+ | otherwise -> MetaInlines xs
+ Pandoc _ bs -> MetaBlocks bs
+ where endsWithNewline t = (T.pack "\n") `T.isSuffixOf` t
+
+yamlToMeta :: ReaderOptions -> Yaml.Value -> MetaValue
+yamlToMeta opts (Yaml.String t) = toMetaValue opts t
+yamlToMeta _ (Yaml.Number n) = MetaString $ show n
+yamlToMeta _ (Yaml.Bool b) = MetaString $ map toLower $ show b
+yamlToMeta opts (Yaml.Array xs) = B.toMetaValue $ map (yamlToMeta opts)
+ $ V.toList xs
+yamlToMeta opts (Yaml.Object o) = MetaMap $ H.foldrWithKey (\k v m ->
+ if ignorable k
+ then m
+ else M.insert (T.unpack k)
+ (yamlToMeta opts v) m)
+ M.empty o
+yamlToMeta _ _ = MetaString ""
+
+stopLine :: MarkdownParser ()
+stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()
+
+mmdTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
mmdTitleBlock = try $ do
guardEnabled Ext_mmd_title_block
kvPairs <- many1 kvPair
blanklines
- let title = maybe mempty return $ lookup "title" kvPairs
- let author = maybe mempty (\x -> return [x]) $ lookup "author" kvPairs
- let date = maybe mempty return $ lookup "date" kvPairs
- return (title, author, date)
+ return $ return $ \(Pandoc m bs) ->
+ Pandoc (foldl (\m' (k,v) -> addMetaField k v m') m kvPairs) bs
-kvPair :: MarkdownParser (String, Inlines)
+kvPair :: MarkdownParser (String, MetaValue)
kvPair = try $ do
key <- many1Till (alphaNum <|> oneOf "_- ") (char ':')
val <- manyTill anyChar
(try $ newline >> lookAhead (blankline <|> nonspaceChar))
let key' = concat $ words $ map toLower key
- let val' = trimInlines $ B.text val
+ let val' = MetaBlocks $ B.toList $ B.plain $ B.text $ trim val
return (key',val')
parseMarkdown :: MarkdownParser Pandoc
@@ -236,16 +296,15 @@ parseMarkdown = do
updateState $ \state -> state { stateOptions =
let oldOpts = stateOptions state in
oldOpts{ readerParseRaw = True } }
- (title, authors, date) <- option (mempty,return [],mempty) titleBlock
+ titleTrans <- option (return id) titleBlock
blocks <- parseBlocks
st <- getState
mbsty <- getOption readerCitationStyle
refs <- getOption readerReferences
return $ processBiblio mbsty refs
- $ B.setTitle (runF title st)
- $ B.setAuthors (runF authors st)
- $ B.setDate (runF date st)
- $ B.doc $ runF blocks st
+ $ runF titleTrans st
+ $ B.doc
+ $ runF blocks st
addWarning :: Maybe SourcePos -> String -> MarkdownParser ()
addWarning mbpos msg =
diff --git a/src/Text/Pandoc/Readers/Native.hs b/src/Text/Pandoc/Readers/Native.hs
index a0e5a0635..c5d4cb98a 100644
--- a/src/Text/Pandoc/Readers/Native.hs
+++ b/src/Text/Pandoc/Readers/Native.hs
@@ -33,12 +33,6 @@ module Text.Pandoc.Readers.Native ( readNative ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared (safeRead)
-nullMeta :: Meta
-nullMeta = Meta{ docTitle = []
- , docAuthors = []
- , docDate = []
- }
-
-- | Read native formatted text and return a Pandoc document.
-- The input may be a full pandoc document, a block list, a block,
-- an inline list, or an inline. Thus, for example,
@@ -47,7 +41,7 @@ nullMeta = Meta{ docTitle = []
--
-- will be treated as if it were
--
--- > Pandoc (Meta [] [] []) [Plain [Str "hi"]]
+-- > Pandoc nullMeta [Plain [Str "hi"]]
--
readNative :: String -- ^ String to parse (assuming @'\n'@ line endings)
-> Pandoc
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 4e0c0a277..0829996a7 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -31,6 +31,7 @@ module Text.Pandoc.Readers.RST (
readRST
) where
import Text.Pandoc.Definition
+import Text.Pandoc.Builder (setMeta, fromList)
import Text.Pandoc.Shared
import Text.Pandoc.Parsing
import Text.Pandoc.Options
@@ -39,7 +40,6 @@ import Data.List ( findIndex, intersperse, intercalate,
transpose, sort, deleteFirstsBy, isSuffixOf )
import qualified Data.Map as M
import Text.Printf ( printf )
-import Data.Maybe ( catMaybes )
import Control.Applicative ((<$>), (<$), (<*), (*>))
import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
import qualified Text.Pandoc.Builder as B
@@ -87,16 +87,30 @@ promoteHeaders _ [] = []
-- | If list of blocks starts with a header (or a header and subheader)
-- of level that are not found elsewhere, return it as a title and
--- promote all the other headers.
-titleTransform :: [Block] -- ^ list of blocks
- -> ([Block], [Inline]) -- ^ modified list of blocks, title
-titleTransform ((Header 1 _ head1):(Header 2 _ head2):rest) |
- not (any (isHeader 1) rest || any (isHeader 2) rest) = -- both title & subtitle
- (promoteHeaders 2 rest, head1 ++ [Str ":", Space] ++ head2)
-titleTransform ((Header 1 _ head1):rest) |
- not (any (isHeader 1) rest) = -- title, no subtitle
- (promoteHeaders 1 rest, head1)
-titleTransform blocks = (blocks, [])
+-- promote all the other headers. Also process a definition list right
+-- after the title block as metadata.
+titleTransform :: ([Block], Meta) -- ^ list of blocks, metadata
+ -> ([Block], Meta) -- ^ modified list of blocks, metadata
+titleTransform (bs, meta) =
+ let (bs', meta') =
+ case bs of
+ ((Header 1 _ head1):(Header 2 _ head2):rest)
+ | not (any (isHeader 1) rest || any (isHeader 2) rest) -> -- tit/sub
+ (promoteHeaders 2 rest, setMeta "title" (fromList head1) $
+ setMeta "subtitle" (fromList head2) meta)
+ ((Header 1 _ head1):rest)
+ | not (any (isHeader 1) rest) -> -- title only
+ (promoteHeaders 1 rest,
+ setMeta "title" (fromList head1) meta)
+ _ -> (bs, meta)
+ in case bs' of
+ (DefinitionList ds : rest) ->
+ (rest, metaFromDefList ds meta')
+ _ -> (bs', meta')
+
+metaFromDefList :: [([Inline], [[Block]])] -> Meta -> Meta
+metaFromDefList ds meta = foldr f meta ds
+ where f (k,v) = setMeta (map toLower $ stringify k) (mconcat $ map fromList v)
parseRST :: RSTParser Pandoc
parseRST = do
@@ -114,14 +128,12 @@ parseRST = do
-- now parse it for real...
blocks <- B.toList <$> parseBlocks
standalone <- getOption readerStandalone
- let (blocks', title) = if standalone
- then titleTransform blocks
- else (blocks, [])
state <- getState
- let authors = stateAuthors state
- let date = stateDate state
- let title' = if null title then stateTitle state else title
- return $ Pandoc (Meta title' authors date) blocks'
+ let meta = stateMeta state
+ let (blocks', meta') = if standalone
+ then titleTransform (blocks, meta)
+ else (blocks, meta)
+ return $ Pandoc meta' blocks'
--
-- parsing blocks
@@ -163,38 +175,19 @@ rawFieldListItem indent = try $ do
return (name, raw)
fieldListItem :: String
- -> RSTParser (Maybe (Inlines, [Blocks]))
+ -> RSTParser (Inlines, [Blocks])
fieldListItem indent = try $ do
(name, raw) <- rawFieldListItem indent
let term = B.str name
contents <- parseFromString parseBlocks raw
optional blanklines
- case (name, B.toList contents) of
- ("Author", x) -> do
- updateState $ \st ->
- st{ stateAuthors = stateAuthors st ++ [extractContents x] }
- return Nothing
- ("Authors", [BulletList auths]) -> do
- updateState $ \st -> st{ stateAuthors = map extractContents auths }
- return Nothing
- ("Date", x) -> do
- updateState $ \st -> st{ stateDate = extractContents x }
- return Nothing
- ("Title", x) -> do
- updateState $ \st -> st{ stateTitle = extractContents x }
- return Nothing
- _ -> return $ Just (term, [contents])
-
-extractContents :: [Block] -> [Inline]
-extractContents [Plain auth] = auth
-extractContents [Para auth] = auth
-extractContents _ = []
+ return (term, [contents])
fieldList :: RSTParser Blocks
fieldList = try $ do
indent <- lookAhead $ many spaceChar
items <- many1 $ fieldListItem indent
- case catMaybes items of
+ case items of
[] -> return mempty
items' -> return $ B.definitionList items'
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
index 22ec52362..a1687a691 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -93,7 +93,7 @@ parseTextile = do
updateState $ \s -> s { stateNotes = reverse reversedNotes }
-- now parse it for real...
blocks <- parseBlocks
- return $ Pandoc (Meta [] [] []) blocks -- FIXME
+ return $ Pandoc nullMeta blocks -- FIXME
noteMarker :: Parser [Char] ParserState [Char]
noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index c571c4143..9c62db86e 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE DeriveDataTypeable, CPP #-}
{-
-Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
+Copyright (C) 2006-2013 John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Text.Pandoc.Shared
- Copyright : Copyright (C) 2006-2010 John MacFarlane
+ Copyright : Copyright (C) 2006-2013 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
@@ -61,6 +61,10 @@ module Text.Pandoc.Shared (
isHeaderBlock,
headerShift,
isTightList,
+ addMetaField,
+ makeMeta,
+ metaToJSON,
+ setField,
-- * TagSoup HTML handling
renderTags',
-- * File handling
@@ -78,7 +82,7 @@ module Text.Pandoc.Shared (
import Text.Pandoc.Definition
import Text.Pandoc.Generic
-import Text.Pandoc.Builder (Blocks)
+import Text.Pandoc.Builder (Blocks, ToMetaValue(..))
import qualified Text.Pandoc.Builder as B
import qualified Text.Pandoc.UTF8 as UTF8
import System.Environment (getProgName)
@@ -86,6 +90,7 @@ import System.Exit (exitWith, ExitCode(..))
import Data.Char ( toLower, isLower, isUpper, isAlpha,
isLetter, isDigit, isSpace )
import Data.List ( find, isPrefixOf, intercalate )
+import qualified Data.Map as M
import Network.URI ( escapeURIString, isAbsoluteURI, parseURI, unEscapeString )
import System.Directory
import Text.Pandoc.MIME (getMimeType)
@@ -104,6 +109,11 @@ import qualified Data.ByteString.Char8 as B8
import Network.HTTP (findHeader, rspBody,
RequestMethod(..), HeaderName(..), mkRequest)
import Network.Browser (browse, setAllowRedirects, setOutHandler, request)
+import qualified Data.Traversable as Traversable
+import qualified Data.HashMap.Strict as H
+import qualified Data.Text as T
+import Data.Aeson (ToJSON (..), Value(Object), Result(..), fromJSON)
+
#ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles)
import System.FilePath ( joinPath, splitDirectories )
@@ -491,6 +501,67 @@ isTightList = and . map firstIsPlain
where firstIsPlain (Plain _ : _) = True
firstIsPlain _ = False
+-- | Set a field of a 'Meta' object. If the field already has a value,
+-- convert it into a list with the new value appended to the old value(s).
+addMetaField :: ToMetaValue a
+ => String
+ -> a
+ -> Meta
+ -> Meta
+addMetaField key val (Meta meta) =
+ Meta $ M.insertWith combine key (toMetaValue val) meta
+ where combine newval (MetaList xs) = MetaList (xs ++ [newval])
+ combine newval x = MetaList [x, newval]
+
+-- | Create 'Meta' from old-style title, authors, date. This is
+-- provided to ease the transition from the old API.
+makeMeta :: [Inline] -> [[Inline]] -> [Inline] -> Meta
+makeMeta title authors date =
+ addMetaField "title" (B.fromList title)
+ $ addMetaField "author" (map B.fromList authors)
+ $ addMetaField "date" (B.fromList date)
+ $ nullMeta
+
+-- | Create JSON value for template from a 'Meta' and an association list
+-- of variables, specified at the command line or in the writer.
+-- Variables overwrite metadata fields with the same names.
+metaToJSON :: (Monad m, Functor m)
+ => ([Block] -> m String) -- ^ Writer for output format
+ => ([Inline] -> m String) -- ^ Writer for output format
+ -> Meta -- ^ Metadata
+ -> m Value
+metaToJSON blockWriter inlineWriter (Meta metamap) = toJSON
+ `fmap` Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap
+
+metaValueToJSON :: (Monad m, Functor m)
+ => ([Block] -> m String)
+ -> ([Inline] -> m String)
+ -> MetaValue
+ -> m Value
+metaValueToJSON blockWriter inlineWriter (MetaMap metamap) = toJSON
+ `fmap` Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap
+metaValueToJSON blockWriter inlineWriter (MetaList xs) =
+ toJSON `fmap` Traversable.mapM (metaValueToJSON blockWriter inlineWriter) xs
+metaValueToJSON _ _ (MetaString s) = return $ toJSON s
+metaValueToJSON blockWriter _ (MetaBlocks bs) = toJSON `fmap` blockWriter bs
+metaValueToJSON _ inlineWriter (MetaInlines bs) = toJSON `fmap` inlineWriter bs
+
+setField :: ToJSON a
+ => String
+ -> a
+ -> Value
+ -> Value
+-- | Set a field of a JSON object. If the field already has a value,
+-- convert it into a list with the new value appended to the old value(s).
+-- This is a utility function to be used in preparing template contexts.
+setField field val (Object hashmap) =
+ Object $ H.insertWith combine (T.pack field) (toJSON val) hashmap
+ where combine newval oldval =
+ case fromJSON oldval of
+ Success xs -> toJSON $ xs ++ [newval]
+ _ -> toJSON [oldval, newval]
+setField _ _ x = x
+
--
-- TagSoup HTML handling
--
diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs
index 12a7e732a..e1a127bbd 100644
--- a/src/Text/Pandoc/Templates.hs
+++ b/src/Text/Pandoc/Templates.hs
@@ -86,6 +86,7 @@ example above.
-}
module Text.Pandoc.Templates ( renderTemplate
+ , renderTemplate'
, TemplateTarget(..)
, varListToJSON
, compileTemplate
@@ -165,13 +166,17 @@ varListToJSON assoc = toJSON $ M.fromList assoc'
toVal xs = toJSON xs
renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
-renderTemplate template context =
- toTarget $ renderTemplate' template (toJSON context)
- where renderTemplate' (Template f) val = f val
+renderTemplate (Template f) context = toTarget $ f $ toJSON context
compileTemplate :: Text -> Either String Template
compileTemplate template = A.parseOnly pTemplate template
+-- | Like 'renderTemplate', but compiles the template first,
+-- raising an error if compilation fails.
+renderTemplate' :: (ToJSON a, TemplateTarget b) => String -> a -> b
+renderTemplate' template =
+ renderTemplate (either error id $ compileTemplate $ T.pack template)
+
var :: Variable -> Template
var = Template . resolveVar
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index 16ce452ef..60879d54f 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -38,13 +38,16 @@ AsciiDoc: <http://www.methods.co.nz/asciidoc/>
-}
module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where
import Text.Pandoc.Definition
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Shared
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, space)
import Data.List ( isPrefixOf, intersperse, intercalate )
import Text.Pandoc.Pretty
import Control.Monad.State
+import qualified Data.Map as M
+import Data.Aeson (Value(String), fromJSON, toJSON, Result(..))
+import qualified Data.Text as T
data WriterState = WriterState { defListMarker :: String
, orderedListLevel :: Int
@@ -62,29 +65,33 @@ writeAsciiDoc opts document =
-- | Return asciidoc representation of document.
pandocToAsciiDoc :: WriterOptions -> Pandoc -> State WriterState String
-pandocToAsciiDoc opts (Pandoc (Meta title authors date) blocks) = do
- title' <- inlineListToAsciiDoc opts title
- let title'' = title' $$ text (replicate (offset title') '=')
- authors' <- mapM (inlineListToAsciiDoc opts) authors
- -- asciidoc only allows a singel author
- date' <- inlineListToAsciiDoc opts date
- let titleblock = not $ null title && null authors && null date
- body <- blockListToAsciiDoc opts blocks
+pandocToAsciiDoc opts (Pandoc meta blocks) = do
+ let titleblock = not $ null (docTitle meta) && null (docAuthors meta) &&
+ null (docDate meta)
let colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
+ metadata <- metaToJSON
+ (fmap (render colwidth) . blockListToAsciiDoc opts)
+ (fmap (render colwidth) . inlineListToAsciiDoc opts)
+ meta
+ let addTitleLine (String t) = String $
+ t <> "\n" <> T.replicate (T.length t) "="
+ addTitleLine x = x
+ let metadata' = case fromJSON metadata of
+ Success m -> toJSON $ M.adjust addTitleLine
+ ("title" :: T.Text) m
+ _ -> metadata
+ body <- blockListToAsciiDoc opts blocks
let main = render colwidth body
- let context = writerVariables opts ++
- [ ("body", main)
- , ("title", render colwidth title'')
- , ("date", render colwidth date')
- ] ++
- [ ("toc", "yes") | writerTableOfContents opts &&
- writerStandalone opts ] ++
- [ ("titleblock", "yes") | titleblock ] ++
- [ ("author", render colwidth a) | a <- authors' ]
+ let context = setField "body" main
+ $ setField "toc"
+ (writerTableOfContents opts && writerStandalone opts)
+ $ setField "titleblock" titleblock
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata' (writerVariables opts)
if writerStandalone opts
- then return $ renderTemplate context $ writerTemplate opts
+ then return $ renderTemplate' (writerTemplate opts) context
else return main
-- | Escape special characters for AsciiDoc.
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index 0566abbbd..b19737a5e 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -37,7 +37,7 @@ import Text.Printf ( printf )
import Data.List ( intercalate, isPrefixOf )
import Control.Monad.State
import Text.Pandoc.Pretty
-import Text.Pandoc.Templates ( renderTemplate )
+import Text.Pandoc.Templates ( renderTemplate' )
import Network.URI ( isURI, unEscapeString )
data WriterState =
@@ -59,36 +59,32 @@ writeConTeXt options document =
in evalState (pandocToConTeXt options document) defaultWriterState
pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String
-pandocToConTeXt options (Pandoc (Meta title authors date) blocks) = do
+pandocToConTeXt options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options
then Just $ writerColumns options
else Nothing
- titletext <- if null title
- then return ""
- else liftM (render colwidth) $ inlineListToConTeXt title
- authorstext <- mapM (liftM (render colwidth) . inlineListToConTeXt) authors
- datetext <- if null date
- then return ""
- else liftM (render colwidth) $ inlineListToConTeXt date
+ metadata <- metaToJSON
+ (fmap (render colwidth) . blockListToConTeXt)
+ (fmap (render colwidth) . inlineListToConTeXt)
+ meta
body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
let main = (render colwidth . vcat) body
- let context = writerVariables options ++
- [ ("toc", if writerTableOfContents options then "yes" else "")
- , ("placelist", intercalate "," $
+ let context = setField "toc" (writerTableOfContents options)
+ $ setField "placelist" (intercalate ("," :: String) $
take (writerTOCDepth options + if writerChapters options
then 0
else 1)
["chapter","section","subsection","subsubsection",
"subsubsubsection","subsubsubsubsection"])
- , ("body", main)
- , ("title", titletext)
- , ("date", datetext) ] ++
- [ ("number-sections", "yes") | writerNumberSections options ] ++
- [ ("mainlang", maybe "" (reverse . takeWhile (/=',') . reverse)
- (lookup "lang" $ writerVariables options)) ] ++
- [ ("author", a) | a <- authorstext ]
+ $ setField "body" main
+ $ setField "number-sections" (writerNumberSections options)
+ $ setField "mainlang" (maybe ""
+ (reverse . takeWhile (/=',') . reverse)
+ (lookup "lang" $ writerVariables options))
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables options)
return $ if writerStandalone options
- then renderTemplate context $ writerTemplate options
+ then renderTemplate' (writerTemplate options) context
else main
-- escape things as needed for ConTeXt
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index fc16a057e..e6d912e78 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -121,10 +121,10 @@ writeCustom luaFile opts doc = do
return $ toString rendered
docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO ByteString
-docToCustom lua opts (Pandoc (Meta title authors date) blocks) = do
- title' <- inlineListToCustom lua title
- authors' <- mapM (inlineListToCustom lua) authors
- date' <- inlineListToCustom lua date
+docToCustom lua opts (Pandoc meta blocks) = do
+ title' <- inlineListToCustom lua $ docTitle meta
+ authors' <- mapM (inlineListToCustom lua) $ docAuthors meta
+ date' <- inlineListToCustom lua $ docDate meta
body <- blockListToCustom lua blocks
callfunc lua "Doc" body title' authors' date' (writerVariables opts)
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 35e7f3342..404171fe0 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -32,21 +32,26 @@ import Text.Pandoc.Definition
import Text.Pandoc.XML
import Text.Pandoc.Shared
import Text.Pandoc.Options
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Readers.TeXMath
import Data.List ( isPrefixOf, intercalate, isSuffixOf )
import Data.Char ( toLower )
import Text.Pandoc.Highlighting ( languages, languagesByExtension )
import Text.Pandoc.Pretty
+import qualified Text.Pandoc.Builder as B
import Text.TeXMath
import qualified Text.XML.Light as Xml
import Data.Generics (everywhere, mkT)
-- | Convert list of authors to a docbook <author> section
-authorToDocbook :: WriterOptions -> [Inline] -> Doc
+authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines
authorToDocbook opts name' =
let name = render Nothing $ inlinesToDocbook opts name'
- in if ',' `elem` name
+ colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ in B.rawInline "docbook" $ render colwidth $
+ if ',' `elem` name
then -- last name first
let (lastname, rest) = break (==',') name
firstname = triml rest in
@@ -64,11 +69,8 @@ authorToDocbook opts name' =
-- | Convert Pandoc document to string in Docbook format.
writeDocbook :: WriterOptions -> Pandoc -> String
-writeDocbook opts (Pandoc (Meta tit auths dat) blocks) =
- let title = inlinesToDocbook opts tit
- authors = map (authorToDocbook opts) auths
- date = inlinesToDocbook opts dat
- elements = hierarchicalize blocks
+writeDocbook opts (Pandoc meta blocks) =
+ let elements = hierarchicalize blocks
colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
@@ -78,17 +80,21 @@ writeDocbook opts (Pandoc (Meta tit auths dat) blocks) =
then opts{ writerChapters = True }
else opts
startLvl = if writerChapters opts' then 0 else 1
+ auths' = map (authorToDocbook opts) $ docAuthors meta
+ meta' = B.setMeta "author" auths' meta
+ Just metadata = metaToJSON
+ (Just . render colwidth . blocksToDocbook opts)
+ (Just . render colwidth . inlinesToDocbook opts)
+ meta'
main = render' $ vcat (map (elementToDocbook opts' startLvl) elements)
- context = writerVariables opts ++
- [ ("body", main)
- , ("title", render' title)
- , ("date", render' date) ] ++
- [ ("author", render' a) | a <- authors ] ++
- [ ("mathml", "yes") | case writerHTMLMathMethod opts of
- MathML _ -> True
- _ -> False ]
+ context = setField "body" main
+ $ setField "mathml" (case writerHTMLMathMethod opts of
+ MathML _ -> True
+ _ -> False)
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
in if writerStandalone opts
- then renderTemplate context $ writerTemplate opts
+ then renderTemplate' (writerTemplate opts) context
else main
-- | Convert an Element to Docbook.
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 50e39a2a7..85b9705ac 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -103,7 +103,7 @@ toLazy = BL.fromChunks . (:[])
writeDocx :: WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert
-> IO BL.ByteString
-writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
+writeDocx opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts
let doc' = bottomUp (concatMap fixDisplayMath) doc
refArchive <- liftM (toArchive . toLazy) $
@@ -226,11 +226,11 @@ writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do
,("xmlns:dcterms","http://purl.org/dc/terms/")
,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")]
- $ mknode "dc:title" [] (stringify tit)
+ $ mknode "dc:title" [] (stringify $ docTitle meta)
: mknode "dcterms:created" [("xsi:type","dcterms:W3CDTF")]
- (maybe "" id $ normalizeDate $ stringify date)
+ (maybe "" id $ normalizeDate $ stringify $ docDate meta)
: mknode "dcterms:modified" [("xsi:type","dcterms:W3CDTF")] () -- put current time here
- : map (mknode "dc:creator" [] . stringify) auths
+ : map (mknode "dc:creator" [] . stringify) (docAuthors meta)
let docPropsEntry = toEntry docPropsPath epochtime $ UTF8.fromStringLazy $ showTopElement' docProps
let relsPath = "_rels/.rels"
rels <- case findEntryByPath relsPath refArchive of
@@ -361,7 +361,12 @@ getNumId = length `fmap` gets stLists
-- | Convert Pandoc document to two OpenXML elements (the main document and footnotes).
writeOpenXML :: WriterOptions -> Pandoc -> WS (Element, Element)
-writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
+writeOpenXML opts (Pandoc meta blocks) = do
+ let tit = docTitle meta ++ case lookupMeta "subtitle" meta of
+ Just (MetaBlocks [Plain xs]) -> LineBreak : xs
+ _ -> []
+ let auths = docAuthors meta
+ let dat = docDate meta
title <- withParaProp (pStyle "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
authors <- withParaProp (pStyle "Authors") $ blocksToOpenXML opts
[Para (intercalate [LineBreak] auths) | not (null auths)]
@@ -372,7 +377,7 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
let blocks' = bottomUp convertSpace $ blocks
doc' <- blocksToOpenXML opts blocks'
notes' <- reverse `fmap` gets stFootnotes
- let meta = title ++ authors ++ date
+ let meta' = title ++ authors ++ date
let stdAttributes =
[("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
@@ -383,7 +388,7 @@ writeOpenXML opts (Pandoc (Meta tit auths dat) blocks) = do
,("xmlns:a","http://schemas.openxmlformats.org/drawingml/2006/main")
,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")]
- let doc = mknode "w:document" stdAttributes $ mknode "w:body" [] (meta ++ doc')
+ let doc = mknode "w:document" stdAttributes $ mknode "w:body" [] (meta' ++ doc')
let notes = mknode "w:footnotes" stdAttributes notes'
return (doc, notes)
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 9af78a338..f171a2560 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -45,6 +45,7 @@ import Data.Time
import System.Locale
import Text.Pandoc.Shared hiding ( Element )
import qualified Text.Pandoc.Shared as Shared
+import Text.Pandoc.Builder (fromList, setMeta)
import Text.Pandoc.Options
import Text.Pandoc.Definition
import Text.Pandoc.Generic
@@ -180,8 +181,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
$ writeHtml opts'{ writerNumberOffset =
maybe [] id mbnum }
$ case bs of
- (Header _ _ xs : _) -> Pandoc (Meta xs [] []) bs
- _ -> Pandoc (Meta [] [] []) bs
+ (Header _ _ xs : _) ->
+ Pandoc (setMeta "title" (fromList xs) nullMeta) bs
+ _ ->
+ Pandoc nullMeta bs
let chapterEntries = zipWith chapToEntry [1..] chapters
@@ -248,9 +251,9 @@ writeEPUB opts doc@(Pandoc meta _) = do
Just _ -> [ unode "itemref" !
[("idref", "cover"),("linear","no")] $ () ]
++ ((unode "itemref" ! [("idref", "title_page")
- ,("linear", case meta of
- Meta [] [] [] -> "no"
- _ -> "yes")] $ ()) :
+ ,("linear", if null (docTitle meta)
+ then "no"
+ else "yes")] $ ()) :
(unode "itemref" ! [("idref", "nav")
,("linear", if writerTableOfContents opts
then "yes"
@@ -440,7 +443,7 @@ transformInline _ _ _ x = return x
writeHtmlInline :: WriterOptions -> Inline -> String
writeHtmlInline opts z = trimr $
writeHtmlString opts{ writerStandalone = False }
- $ Pandoc (Meta [] [] []) [Plain [z]]
+ $ Pandoc nullMeta [Plain [z]]
(!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element
(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 1cc17d7fd..169fdcbce 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -34,18 +34,16 @@ import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Options
import Text.Pandoc.Templates
-import Text.Pandoc.Generic
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Slides
import Text.Pandoc.Highlighting ( highlight, styleToCss,
formatHtmlInline, formatHtmlBlock )
-import Text.Pandoc.XML (stripTags, fromEntities)
+import Text.Pandoc.XML (fromEntities)
import Network.HTTP ( urlEncode )
import Numeric ( showHex )
import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, intersperse )
import Data.String ( fromString )
-import qualified Data.Text as T
import Data.Maybe ( catMaybes )
import Control.Monad.State
import Text.Blaze.Html hiding(contents)
@@ -62,6 +60,7 @@ import Text.TeXMath
import Text.XML.Light.Output
import System.FilePath (takeExtension)
import Data.Monoid
+import Data.Aeson (Value)
data WriterState = WriterState
{ stNotes :: [Html] -- ^ List of notes
@@ -93,39 +92,30 @@ nl opts = if writerWrapText opts
-- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String
writeHtmlString opts d =
- let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d)
- defaultWriterState
+ let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
in if writerStandalone opts
- then inTemplate opts tit auths authsMeta date toc body' newvars
- else renderHtml body'
+ then inTemplate opts context body
+ else renderHtml body
-- | Convert Pandoc document to Html structure.
writeHtml :: WriterOptions -> Pandoc -> Html
writeHtml opts d =
- let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d)
- defaultWriterState
+ let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
in if writerStandalone opts
- then inTemplate opts tit auths authsMeta date toc body' newvars
- else body'
+ then inTemplate opts context body
+ else body
-- result is (title, authors, date, toc, body, new variables)
pandocToHtml :: WriterOptions
-> Pandoc
- -> State WriterState (Html, [Html], [Html], Html, Maybe Html, Html, [(String,String)])
-pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
- let standalone = writerStandalone opts
- tit <- if standalone
- then inlineListToHtml opts title'
- else return mempty
- auths <- if standalone
- then mapM (inlineListToHtml opts) authors'
- else return []
- authsMeta <- if standalone
- then mapM (inlineListToHtml opts . prepForMeta) authors'
- else return []
- date <- if standalone
- then inlineListToHtml opts date'
- else return mempty
+ -> State WriterState (Html, Value)
+pandocToHtml opts (Pandoc meta blocks) = do
+ metadata <- metaToJSON
+ (fmap renderHtml . blockListToHtml opts)
+ (fmap renderHtml . inlineListToHtml opts)
+ meta
+ let authsMeta = map stringify $ docAuthors meta
+ let dateMeta = stringify $ docDate meta
let slideLevel = maybe (getSlideLevel blocks) id $ writerSlideLevel opts
let sects = hierarchicalize $
if writerSlideVariant opts == NoSlides
@@ -165,58 +155,37 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
| otherwise -> mempty
Nothing -> mempty
else mempty
- let newvars = [("highlighting-css",
- styleToCss $ writerHighlightStyle opts) |
- stHighlighting st] ++
- [("math", renderHtml math) | stMath st] ++
- [("quotes", "yes") | stQuotes st]
- return (tit, auths, authsMeta, date, toc, thebody, newvars)
-
--- | Prepare author for meta tag, converting notes into
--- bracketed text and removing links.
-prepForMeta :: [Inline] -> [Inline]
-prepForMeta = bottomUp (concatMap fixInline)
- where fixInline (Note [Para xs]) = [Str " ["] ++ xs ++ [Str "]"]
- fixInline (Note [Plain xs]) = [Str " ["] ++ xs ++ [Str "]"]
- fixInline (Link lab _) = lab
- fixInline (Image lab _) = lab
- fixInline x = [x]
+ let context = (if stHighlighting st
+ then setField "highlighting-css"
+ (styleToCss $ writerHighlightStyle opts)
+ else id) $
+ (if stMath st
+ then setField "math" (renderHtml math)
+ else id) $
+ setField "quotes" (stQuotes st) $
+ maybe id (setField "toc" . renderHtml) toc $
+ setField "author-meta" authsMeta $
+ maybe id (setField "date-meta") (normalizeDate dateMeta) $
+ setField "pagetitle" (stringify $ docTitle meta) $
+ setField "idprefix" (writerIdentifierPrefix opts) $
+ -- these should maybe be set in pandoc.hs
+ setField "slidy-url"
+ ("http://www.w3.org/Talks/Tools/Slidy2" :: String) $
+ setField "slideous-url" ("slideous" :: String) $
+ setField "revealjs-url" ("reveal.js" :: String) $
+ setField "s5-url" ("s5/default" :: String) $
+ setField "html5" (writerHtml5 opts) $
+ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
+ return (thebody, context)
inTemplate :: TemplateTarget a
=> WriterOptions
+ -> Value
-> Html
- -> [Html]
- -> [Html]
- -> Html
- -> Maybe Html
- -> Html
- -> [(String,String)]
-> a
-inTemplate opts tit auths authsMeta date toc body' newvars =
- let title' = renderHtml tit
- date' = renderHtml date
- dateMeta = maybe [] (\x -> [("date-meta",x)]) $ normalizeDate date'
- variables = writerVariables opts ++ newvars
- context = variables ++ dateMeta ++
- [ ("body", dropWhile (=='\n') $ renderHtml body')
- , ("pagetitle", stripTags title')
- , ("title", title')
- , ("date", date')
- , ("idprefix", writerIdentifierPrefix opts)
- , ("slidy-url", "http://www.w3.org/Talks/Tools/Slidy2")
- , ("slideous-url", "slideous")
- , ("revealjs-url", "reveal.js")
- , ("s5-url", "s5/default") ] ++
- [ ("html5","true") | writerHtml5 opts ] ++
- (case toc of
- Just t -> [ ("toc", renderHtml t)]
- Nothing -> []) ++
- [ ("author", renderHtml a) | a <- auths ] ++
- [ ("author-meta", stripTags $ renderHtml a) | a <- authsMeta ]
- template = case compileTemplate (T.pack $ writerTemplate opts) of
- Left e -> error e
- Right t -> t
- in renderTemplate template (varListToJSON context)
+inTemplate opts context body = renderTemplate' (writerTemplate opts)
+ $ setField "body" (renderHtml body) context
-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
prefixedId :: WriterOptions -> String -> Attribute
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 04bb3f9e2..89cf9812a 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -81,7 +81,7 @@ writeLaTeX options document =
stInternalLinks = [], stUsesEuro = False }
pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String
-pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
+pandocToLaTeX options (Pandoc meta blocks) = do
-- see if there are internal links
let isInternalLink (Link _ ('#':xs,_)) = [xs]
isInternalLink _ = []
@@ -103,9 +103,10 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
let colwidth = if writerWrapText options
then Just $ writerColumns options
else Nothing
- titletext <- liftM (render colwidth) $ inlineListToLaTeX title
- authorsText <- mapM (liftM (render colwidth) . inlineListToLaTeX) authors
- dateText <- liftM (render colwidth) $ inlineListToLaTeX date
+ metadata <- metaToJSON
+ (fmap (render colwidth) . blockListToLaTeX)
+ (fmap (render colwidth) . inlineListToLaTeX)
+ meta
let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then
(blocks, [])
else case last blocks of
@@ -115,55 +116,52 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
then toSlides blocks'
else return blocks'
body <- mapM (elementToLaTeX options) $ hierarchicalize blocks''
- biblioTitle <- liftM (render colwidth) $ inlineListToLaTeX lastHeader
+ (biblioTitle :: String) <- liftM (render colwidth) $ inlineListToLaTeX lastHeader
let main = render colwidth $ vsep body
st <- get
let biblioFiles = intercalate "," $ map dropExtension $ writerBiblioFiles options
- citecontext = case writerCiteMethod options of
- Natbib -> [ ("biblio-files", biblioFiles)
- , ("biblio-title", biblioTitle)
- , ("natbib", "yes")
- ]
- Biblatex -> [ ("biblio-files", biblioFiles)
- , ("biblio-title", biblioTitle)
- , ("biblatex", "yes")
- ]
- _ -> []
- context = writerVariables options ++
- [ ("toc", if writerTableOfContents options then "yes" else "")
- , ("toc-depth", show (writerTOCDepth options -
- if writerChapters options
- then 1
- else 0))
- , ("body", main)
- , ("title", titletext)
- , ("title-meta", stringify title)
- , ("author-meta", intercalate "; " $ map stringify authors)
- , ("date", dateText)
- , ("documentclass", if writerBeamer options
- then "beamer"
- else if writerChapters options
- then "book"
- else "article") ] ++
- [ ("author", a) | a <- authorsText ] ++
- [ ("verbatim-in-note", "yes") | stVerbInNote st ] ++
- [ ("tables", "yes") | stTable st ] ++
- [ ("strikeout", "yes") | stStrikeout st ] ++
- [ ("url", "yes") | stUrl st ] ++
- [ ("numbersections", "yes") | writerNumberSections options ] ++
- [ ("lhs", "yes") | stLHS st ] ++
- [ ("graphics", "yes") | stGraphics st ] ++
- [ ("book-class", "yes") | stBook st] ++
- [ ("euro", "yes") | stUsesEuro st] ++
- [ ("listings", "yes") | writerListings options || stLHS st ] ++
- [ ("beamer", "yes") | writerBeamer options ] ++
- [ ("mainlang", maybe "" (reverse . takeWhile (/=',') . reverse)
- (lookup "lang" $ writerVariables options)) ] ++
- [ ("highlighting-macros", styleToLaTeX
- $ writerHighlightStyle options ) | stHighlighting st ] ++
- citecontext
+ let context = setField "toc" (writerTableOfContents options) $
+ setField "toc-depth" (show (writerTOCDepth options -
+ if writerChapters options
+ then 1
+ else 0)) $
+ setField "body" main $
+ setField "title-meta" (stringify $ docTitle meta) $
+ setField "author-meta" (intercalate "; " $ map stringify $ docAuthors meta) $
+ setField "documentclass" (if writerBeamer options
+ then ("beamer" :: String)
+ else if writerChapters options
+ then "book"
+ else "article") $
+ setField "verbatim-in-note" (stVerbInNote st) $
+ setField "tables" (stTable st) $
+ setField "strikeout" (stStrikeout st) $
+ setField "url" (stUrl st) $
+ setField "numbersections" (writerNumberSections options) $
+ setField "lhs" (stLHS st) $
+ setField "graphics" (stGraphics st) $
+ setField "book-class" (stBook st) $
+ setField "euro" (stUsesEuro st) $
+ setField "listings" (writerListings options || stLHS st) $
+ setField "beamer" (writerBeamer options) $
+ setField "mainlang" (maybe "" (reverse . takeWhile (/=',') . reverse)
+ (lookup "lang" $ writerVariables options)) $
+ (if stHighlighting st
+ then setField "highlighting-macros" (styleToLaTeX
+ $ writerHighlightStyle options )
+ else id) $
+ (case writerCiteMethod options of
+ Natbib -> setField "biblio-files" biblioFiles .
+ setField "biblio-title" biblioTitle .
+ setField "natbib" True
+ Biblatex -> setField "biblio-files" biblioFiles .
+ setField "biblio-title" biblioTitle .
+ setField "biblatex" True
+ _ -> id) $
+ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables options)
return $ if writerStandalone options
- then renderTemplate context template
+ then renderTemplate' template context
else main
-- | Convert Elements to LaTeX
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 17be983ce..b417565ce 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -37,8 +37,8 @@ import Text.Pandoc.Readers.TeXMath
import Text.Printf ( printf )
import Data.List ( isPrefixOf, intersperse, intercalate )
import Text.Pandoc.Pretty
+import Text.Pandoc.Builder (deleteMeta)
import Control.Monad.State
-import qualified Data.Text as T
type Notes = [[Block]]
data WriterState = WriterState { stNotes :: Notes
@@ -50,39 +50,37 @@ writeMan opts document = evalState (pandocToMan opts document) (WriterState [] F
-- | Return groff man representation of document.
pandocToMan :: WriterOptions -> Pandoc -> State WriterState String
-pandocToMan opts (Pandoc (Meta title authors date) blocks) = do
- titleText <- inlineListToMan opts title
- authors' <- mapM (inlineListToMan opts) authors
- date' <- inlineListToMan opts date
+pandocToMan opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
let render' = render colwidth
+ titleText <- inlineListToMan opts $ docTitle meta
let (cmdName, rest) = break (== ' ') $ render' titleText
let (title', section) = case reverse cmdName of
(')':d:'(':xs) | d `elem` ['0'..'9'] ->
- (text (reverse xs), char d)
- xs -> (text (reverse xs), doubleQuotes empty)
+ (reverse xs, [d])
+ xs -> (reverse xs, "\"\"")
let description = hsep $
map (doubleQuotes . text . trim) $ splitBy (== '|') rest
+ metadata <- metaToJSON
+ (fmap (render colwidth) . blockListToMan opts)
+ (fmap (render colwidth) . inlineListToMan opts)
+ $ deleteMeta "title" meta
body <- blockListToMan opts blocks
notes <- liftM stNotes get
notes' <- notesToMan opts (reverse notes)
let main = render' $ body $$ notes' $$ text ""
hasTables <- liftM stHasTables get
- let context = writerVariables opts ++
- [ ("body", main)
- , ("title", render' title')
- , ("section", render' section)
- , ("date", render' date')
- , ("description", render' description) ] ++
- [ ("has-tables", "yes") | hasTables ] ++
- [ ("author", render' a) | a <- authors' ]
- template = case compileTemplate (T.pack $ writerTemplate opts) of
- Left e -> error e
- Right t -> t
+ let context = setField "body" main
+ $ setField "title" title'
+ $ setField "section" section
+ $ setField "description" (render' description)
+ $ setField "has-tables" hasTables
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
if writerStandalone opts
- then return $ renderTemplate template (varListToJSON context)
+ then return $ renderTemplate' (writerTemplate opts) context
else return main
-- | Return man representation of notes.
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 76e804cf3..cd3c1db81 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, TupleSections #-}
+{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables #-}
{-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@@ -33,7 +33,7 @@ Markdown: <http://daringfireball.net/projects/markdown/>
module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Text.Pandoc.Definition
import Text.Pandoc.Generic
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Shared
import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, char, space)
@@ -111,10 +111,10 @@ plainTitleBlock tit auths dat =
-- | Return markdown representation of document.
pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
-pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
- title' <- inlineListToMarkdown opts title
- authors' <- mapM (inlineListToMarkdown opts) authors
- date' <- inlineListToMarkdown opts date
+pandocToMarkdown opts (Pandoc meta blocks) = do
+ title' <- inlineListToMarkdown opts $ docTitle meta
+ authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta
+ date' <- inlineListToMarkdown opts $ docDate meta
isPlain <- gets stPlain
let titleblock = case True of
_ | isPlain ->
@@ -128,28 +128,33 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
let toc = if writerTableOfContents opts
then tableOfContents opts headerBlocks
else empty
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ metadata <- metaToJSON
+ (fmap (render colwidth) . blockListToMarkdown opts)
+ (fmap (render colwidth) . inlineListToMarkdown opts)
+ meta
body <- blockListToMarkdown opts blocks
st <- get
notes' <- notesToMarkdown opts (reverse $ stNotes st)
st' <- get -- note that the notes may contain refs
refs' <- refsToMarkdown opts (reverse $ stRefs st')
- let colwidth = if writerWrapText opts
- then Just $ writerColumns opts
- else Nothing
- let main = render colwidth $ body <>
+ let render' :: Doc -> String
+ render' = render colwidth
+ let main = render' $ body <>
(if isEmpty notes' then empty else blankline <> notes') <>
(if isEmpty refs' then empty else blankline <> refs')
- let context = writerVariables opts ++
- [ ("toc", render colwidth toc)
- , ("body", main)
- , ("title", render Nothing title')
- , ("date", render Nothing date')
- ] ++
- [ ("author", render Nothing a) | a <- authors' ] ++
- [ ("titleblock", render colwidth titleblock)
- | not (null title && null authors && null date) ]
+ let context = setField "toc" (render' toc)
+ $ setField "body" main
+ $ (if not (null (docTitle meta) && null (docAuthors meta)
+ && null (docDate meta))
+ then setField "titleblock" (render' titleblock)
+ else id)
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
if writerStandalone opts
- then return $ renderTemplate context $ writerTemplate opts
+ then return $ renderTemplate' (writerTemplate opts) context
else return main
-- | Return markdown representation of reference key table.
@@ -370,7 +375,7 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
rawHeaders rawRows
| otherwise -> fmap (id,) $
return $ text $ writeHtmlString def
- $ Pandoc (Meta [] [] []) [t]
+ $ Pandoc nullMeta [t]
return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
blockToMarkdown opts (BulletList items) = do
contents <- mapM (bulletListItemToMarkdown opts) items
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index 4cec2d648..c0f141780 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -33,7 +33,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.XML ( escapeStringForXML )
import Data.List ( intersect, intercalate )
import Network.URI ( isURI )
@@ -53,18 +53,23 @@ writeMediaWiki opts document =
-- | Return MediaWiki representation of document.
pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String
-pandocToMediaWiki opts (Pandoc _ blocks) = do
+pandocToMediaWiki opts (Pandoc meta blocks) = do
+ metadata <- metaToJSON
+ (fmap trimr . blockListToMediaWiki opts)
+ (inlineListToMediaWiki opts)
+ meta
body <- blockListToMediaWiki opts blocks
notesExist <- get >>= return . stNotes
let notes = if notesExist
then "\n<references />"
else ""
let main = body ++ notes
- let context = writerVariables opts ++
- [ ("body", main) ] ++
- [ ("toc", "yes") | writerTableOfContents opts ]
+ let context = setField "body" main
+ $ setField "toc" (writerTableOfContents opts)
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
if writerStandalone opts
- then return $ renderTemplate context $ writerTemplate opts
+ then return $ renderTemplate' (writerTemplate opts) context
else return main
-- | Escape special characters for MediaWiki.
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index 7fb304e86..afe73102c 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -72,7 +72,7 @@ writeNative opts (Pandoc meta blocks) =
then Just $ writerColumns opts
else Nothing
withHead = if writerStandalone opts
- then \bs -> text ("Pandoc " ++ "(" ++ show meta ++ ")") $$
- bs $$ cr
+ then \bs -> text ("Pandoc (" ++ show meta ++ ") ") $$
+ bs $$ cr
else id
in render colwidth $ withHead $ prettyList $ map prettyBlock blocks
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 030a975f4..db27286e8 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -53,8 +53,9 @@ import System.FilePath ( takeExtension )
writeODT :: WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert
-> IO B.ByteString
-writeODT opts doc@(Pandoc (Meta title _ _) _) = do
+writeODT opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts
+ let title = docTitle meta
refArchive <- liftM toArchive $
case writerReferenceODT opts of
Just f -> B.readFile f
diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs
index f7eb9289a..b71c7cf6e 100644
--- a/src/Text/Pandoc/Writers/OPML.hs
+++ b/src/Text/Pandoc/Writers/OPML.hs
@@ -32,37 +32,38 @@ import Text.Pandoc.Definition
import Text.Pandoc.XML
import Text.Pandoc.Shared
import Text.Pandoc.Options
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Writers.HTML (writeHtmlString)
import Text.Pandoc.Writers.Markdown (writeMarkdown)
-import Data.List ( intercalate )
import Text.Pandoc.Pretty
import Data.Time
import System.Locale (defaultTimeLocale)
+import qualified Text.Pandoc.Builder as B
-- | Convert Pandoc document to string in OPML format.
writeOPML :: WriterOptions -> Pandoc -> String
-writeOPML opts (Pandoc (Meta tit auths dat) blocks) =
- let title = writeHtmlInlines tit
- author = writeHtmlInlines $ intercalate [Space,Str ";",Space] auths
- date = convertDate dat
- elements = hierarchicalize blocks
+writeOPML opts (Pandoc meta blocks) =
+ let elements = hierarchicalize blocks
colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
+ meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
+ Just metadata = metaToJSON
+ (Just . writeMarkdown def . Pandoc nullMeta)
+ (Just . trimr . writeMarkdown def . Pandoc nullMeta .
+ (\ils -> [Plain ils]))
+ meta'
main = render colwidth $ vcat (map (elementToOPML opts) elements)
- context = writerVariables opts ++
- [ ("body", main)
- , ("title", title)
- , ("date", date)
- , ("author", author) ]
+ context = setField "body" main
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
in if writerStandalone opts
- then renderTemplate context $ writerTemplate opts
+ then renderTemplate' (writerTemplate opts) context
else main
writeHtmlInlines :: [Inline] -> String
writeHtmlInlines ils = trim $ writeHtmlString def
- $ Pandoc (Meta [] [] []) [Plain ils]
+ $ Pandoc nullMeta [Plain ils]
-- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT
showDateTimeRFC822 :: UTCTime -> String
@@ -82,7 +83,7 @@ elementToOPML opts (Sec _ _num _ title elements) =
fromBlk _ = error "fromBlk called on non-block"
(blocks, rest) = span isBlk elements
attrs = [("text", writeHtmlInlines title)] ++
- [("_note", writeMarkdown def (Pandoc (Meta [] [] [])
+ [("_note", writeMarkdown def (Pandoc nullMeta
(map fromBlk blocks)))
| not (null blocks)]
in inTags True "outline" attrs $
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index b59e096c9..0c09cde99 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -33,7 +33,7 @@ module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.XML
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Pretty
import Text.Printf ( printf )
@@ -42,6 +42,7 @@ import Control.Arrow ( (***), (>>>) )
import Control.Monad.State hiding ( when )
import Data.Char (chr, isDigit)
import qualified Data.Map as Map
+import Text.Pandoc.Shared (metaToJSON, setField)
-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
@@ -172,34 +173,32 @@ handleSpaces s
-- | Convert Pandoc document to string in OpenDocument format.
writeOpenDocument :: WriterOptions -> Pandoc -> String
-writeOpenDocument opts (Pandoc (Meta title authors date) blocks) =
- let ((doc, title', authors', date'),s) = flip runState
- defaultWriterState $ do
- title'' <- inlinesToOpenDocument opts title
- authors'' <- mapM (inlinesToOpenDocument opts) authors
- date'' <- inlinesToOpenDocument opts date
- doc'' <- blocksToOpenDocument opts blocks
- return (doc'', title'', authors'', date'')
- colwidth = if writerWrapText opts
+writeOpenDocument opts (Pandoc meta blocks) =
+ let colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
render' = render colwidth
- body' = render' doc
+ ((body, metadata),s) = flip runState
+ defaultWriterState $ do
+ m <- metaToJSON
+ (fmap (render colwidth) . blocksToOpenDocument opts)
+ (fmap (render colwidth) . inlinesToOpenDocument opts)
+ meta
+ b <- render' `fmap` blocksToOpenDocument opts blocks
+ return (b, m)
styles = stTableStyles s ++ stParaStyles s ++ stTextStyles s
listStyle (n,l) = inTags True "text:list-style"
[("style:name", "L" ++ show n)] (vcat l)
listStyles = map listStyle (stListStyles s)
automaticStyles = inTagsIndented "office:automatic-styles" $ vcat $
reverse $ styles ++ listStyles
- context = writerVariables opts ++
- [ ("body", body')
- , ("automatic-styles", render' automaticStyles)
- , ("title", render' title')
- , ("date", render' date') ] ++
- [ ("author", render' a) | a <- authors' ]
+ context = setField "body" body
+ $ setField "automatic-styles" (render' automaticStyles)
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
in if writerStandalone opts
- then renderTemplate context $ writerTemplate opts
- else body'
+ then renderTemplate' (writerTemplate opts) context
+ else body
withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
withParagraphStyle o s (b:bs)
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 4e7b21e35..49af8124a 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -35,7 +35,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Pretty
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Data.List ( intersect, intersperse, transpose )
import Control.Monad.State
import Control.Applicative ( (<$>) )
@@ -58,27 +58,26 @@ writeOrg opts document =
-- | Return Org representation of document.
pandocToOrg :: Pandoc -> State WriterState String
-pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do
+pandocToOrg (Pandoc meta blocks) = do
opts <- liftM stOptions get
- title <- titleToOrg tit
- authors <- mapM inlineListToOrg auth
- date <- inlineListToOrg dat
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ metadata <- metaToJSON
+ (fmap (render colwidth) . blockListToOrg)
+ (fmap (render colwidth) . inlineListToOrg)
+ meta
body <- blockListToOrg blocks
notes <- liftM (reverse . stNotes) get >>= notesToOrg
-- note that the notes may contain refs, so we do them first
hasMath <- liftM stHasMath get
- let colwidth = if writerWrapText opts
- then Just $ writerColumns opts
- else Nothing
let main = render colwidth $ foldl ($+$) empty $ [body, notes]
- let context = writerVariables opts ++
- [ ("body", main)
- , ("title", render Nothing title)
- , ("date", render Nothing date) ] ++
- [ ("math", "yes") | hasMath ] ++
- [ ("author", render Nothing a) | a <- authors ]
+ let context = setField "body" main
+ $ setField "math" hasMath
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
if writerStandalone opts
- then return $ renderTemplate context $ writerTemplate opts
+ then return $ renderTemplate' (writerTemplate opts) context
else return main
-- | Return Org representation of notes.
@@ -103,12 +102,6 @@ escapeString = escapeStringUsing $
, ('\x2026',"...")
] ++ backslashEscapes "^_"
-titleToOrg :: [Inline] -> State WriterState Doc
-titleToOrg [] = return empty
-titleToOrg lst = do
- contents <- inlineListToOrg lst
- return $ "#+TITLE: " <> contents
-
-- | Convert Pandoc block element to Org.
blockToOrg :: Block -- ^ Block element
-> State WriterState Doc
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 72afb1f21..fc9b69983 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -30,11 +30,12 @@ Conversion of 'Pandoc' documents to reStructuredText.
reStructuredText: <http://docutils.sourceforge.net/rst.html>
-}
-module Text.Pandoc.Writers.RST ( writeRST) where
+module Text.Pandoc.Writers.RST ( writeRST ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
+import Text.Pandoc.Builder (deleteMeta)
import Data.List ( isPrefixOf, intersperse, transpose )
import Network.URI (isAbsoluteURI)
import Text.Pandoc.Pretty
@@ -62,31 +63,35 @@ writeRST opts document =
-- | Return RST representation of document.
pandocToRST :: Pandoc -> State WriterState String
-pandocToRST (Pandoc (Meta tit auth dat) blocks) = do
+pandocToRST (Pandoc meta blocks) = do
opts <- liftM stOptions get
- title <- titleToRST tit
- authors <- mapM inlineListToRST auth
- date <- inlineListToRST dat
+ let colwidth = if writerWrapText opts
+ then Just $ writerColumns opts
+ else Nothing
+ let subtit = case lookupMeta "subtitle" meta of
+ Just (MetaBlocks [Plain xs]) -> xs
+ _ -> []
+ title <- titleToRST (docTitle meta) subtit
+ metadata <- metaToJSON (fmap (render colwidth) . blockListToRST)
+ (fmap (trimr . render colwidth) . inlineListToRST)
+ $ deleteMeta "title" $ deleteMeta "subtitle" meta
body <- blockListToRST blocks
notes <- liftM (reverse . stNotes) get >>= notesToRST
-- note that the notes may contain refs, so we do them first
refs <- liftM (reverse . stLinks) get >>= refsToRST
pics <- liftM (reverse . stImages) get >>= pictRefsToRST
hasMath <- liftM stHasMath get
- let colwidth = if writerWrapText opts
- then Just $ writerColumns opts
- else Nothing
let main = render colwidth $ foldl ($+$) empty $ [body, notes, refs, pics]
- let context = writerVariables opts ++
- [ ("body", main)
- , ("title", render Nothing title)
- , ("date", render colwidth date)
- , ("toc", if writerTableOfContents opts then "yes" else "")
- , ("toc-depth", show (writerTOCDepth opts)) ] ++
- [ ("math", "yes") | hasMath ] ++
- [ ("author", render colwidth a) | a <- authors ]
+ let context = setField "body" main
+ $ setField "toc" (writerTableOfContents opts)
+ $ setField "toc-depth" (writerTOCDepth opts)
+ $ setField "math" hasMath
+ $ setField "title" (render Nothing title :: String)
+ $ setField "math" hasMath
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
if writerStandalone opts
- then return $ renderTemplate context $ writerTemplate opts
+ then return $ renderTemplate' (writerTemplate opts) context
else return main
-- | Return RST representation of reference key table.
@@ -136,13 +141,20 @@ pictToRST (label, (src, _, mbtarget)) = do
escapeString :: String -> String
escapeString = escapeStringUsing (backslashEscapes "`\\|*_")
-titleToRST :: [Inline] -> State WriterState Doc
-titleToRST [] = return empty
-titleToRST lst = do
- contents <- inlineListToRST lst
- let titleLength = length $ (render Nothing contents :: String)
- let border = text (replicate titleLength '=')
- return $ border $$ contents $$ border
+titleToRST :: [Inline] -> [Inline] -> State WriterState Doc
+titleToRST [] _ = return empty
+titleToRST tit subtit = do
+ title <- inlineListToRST tit
+ subtitle <- inlineListToRST subtit
+ return $ bordered title '=' $$ bordered subtitle '-'
+
+bordered :: Doc -> Char -> Doc
+bordered contents c =
+ if len > 0
+ then border $$ contents $$ border
+ else empty
+ where len = offset contents
+ border = text (replicate len c)
-- | Convert Pandoc block element to RST.
blockToRST :: Block -- ^ Block element
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 0d4a22cd5..cc59be4be 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -32,7 +32,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Generic (bottomUpM)
import Data.List ( isSuffixOf, intercalate )
import Data.Char ( ord, chr, isDigit, toLower )
@@ -73,24 +73,22 @@ writeRTFWithEmbeddedImages options doc =
-- | Convert Pandoc to a string in rich text format.
writeRTF :: WriterOptions -> Pandoc -> String
-writeRTF options (Pandoc (Meta title authors date) blocks) =
- let titletext = inlineListToRTF title
- authorstext = map inlineListToRTF authors
- datetext = inlineListToRTF date
- spacer = not $ all null $ titletext : datetext : authorstext
+writeRTF options (Pandoc meta blocks) =
+ let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta
+ Just metadata = metaToJSON
+ (Just . concatMap (blockToRTF 0 AlignDefault))
+ (Just . inlineListToRTF)
+ meta
body = concatMap (blockToRTF 0 AlignDefault) blocks
isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options
isTOCHeader _ = False
- context = writerVariables options ++
- [ ("body", body)
- , ("title", titletext)
- , ("date", datetext) ] ++
- [ ("author", a) | a <- authorstext ] ++
- [ ("spacer", "yes") | spacer ] ++
- [ ("toc", tableOfContents $ filter isTOCHeader blocks) |
- writerTableOfContents options ]
+ context = setField "body" body
+ $ setField "spacer" spacer
+ $ setField "toc" (tableOfContents $ filter isTOCHeader blocks)
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables options)
in if writerStandalone options
- then renderTemplate context $ writerTemplate options
+ then renderTemplate' (writerTemplate options) context
else body
-- | Construct table of contents from list of header blocks.
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index 502a91967..c2131ad98 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -31,7 +31,7 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Printf ( printf )
import Data.List ( transpose, maximumBy )
import Data.Ord ( comparing )
@@ -63,33 +63,33 @@ writeTexinfo options document =
-- | Add a "Top" node around the document, needed by Texinfo.
wrapTop :: Pandoc -> Pandoc
-wrapTop (Pandoc (Meta title authors date) blocks) =
- Pandoc (Meta title authors date) (Header 0 nullAttr title : blocks)
+wrapTop (Pandoc meta blocks) =
+ Pandoc meta (Header 0 nullAttr (docTitle meta) : blocks)
pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String
-pandocToTexinfo options (Pandoc (Meta title authors date) blocks) = do
- titleText <- inlineListToTexinfo title
- authorsText <- mapM inlineListToTexinfo authors
- dateText <- inlineListToTexinfo date
- let titlePage = not $ all null $ title : date : authors
- main <- blockListToTexinfo blocks
- st <- get
+pandocToTexinfo options (Pandoc meta blocks) = do
+ let titlePage = not $ all null
+ $ docTitle meta : docDate meta : docAuthors meta
let colwidth = if writerWrapText options
then Just $ writerColumns options
else Nothing
+ metadata <- metaToJSON
+ (fmap (render colwidth) . blockListToTexinfo)
+ (fmap (render colwidth) . inlineListToTexinfo)
+ meta
+ main <- blockListToTexinfo blocks
+ st <- get
let body = render colwidth main
- let context = writerVariables options ++
- [ ("body", body)
- , ("title", render colwidth titleText)
- , ("date", render colwidth dateText) ] ++
- [ ("toc", "yes") | writerTableOfContents options ] ++
- [ ("titlepage", "yes") | titlePage ] ++
- [ ("subscript", "yes") | stSubscript st ] ++
- [ ("superscript", "yes") | stSuperscript st ] ++
- [ ("strikeout", "yes") | stStrikeout st ] ++
- [ ("author", render colwidth a) | a <- authorsText ]
+ let context = setField "body" body
+ $ setField "toc" (writerTableOfContents options)
+ $ setField "titlepage" titlePage
+ $ setField "subscript" (stSubscript st)
+ $ setField "superscript" (stSuperscript st)
+ $ setField "strikeout" (stStrikeout st)
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables options)
if writerStandalone options
- then return $ renderTemplate context $ writerTemplate options
+ then return $ renderTemplate' (writerTemplate options) context
else return body
-- | Escape things as needed for Texinfo.
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 6a3f2fea5..58d1a3a95 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -33,7 +33,7 @@ module Text.Pandoc.Writers.Textile ( writeTextile ) where
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared
-import Text.Pandoc.Templates (renderTemplate)
+import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.XML ( escapeStringForXML )
import Data.List ( intercalate )
import Control.Monad.State
@@ -53,13 +53,17 @@ writeTextile opts document =
-- | Return Textile representation of document.
pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String
-pandocToTextile opts (Pandoc _ blocks) = do
+pandocToTextile opts (Pandoc meta blocks) = do
+ metadata <- metaToJSON
+ (blockListToTextile opts) (inlineListToTextile opts) meta
body <- blockListToTextile opts blocks
notes <- liftM (unlines . reverse . stNotes) get
let main = body ++ if null notes then "" else ("\n\n" ++ notes)
- let context = writerVariables opts ++ [ ("body", main) ]
+ let context = setField "body" main
+ $ foldl (\acc (x,y) -> setField x y acc)
+ metadata (writerVariables opts)
if writerStandalone opts
- then return $ renderTemplate context $ writerTemplate opts
+ then return $ renderTemplate' (writerTemplate opts) context
else return main
withUseTags :: State WriterState a -> State WriterState a
diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs
index 3f684f728..89ae81a10 100644
--- a/src/Text/Pandoc/XML.hs
+++ b/src/Text/Pandoc/XML.hs
@@ -27,8 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Functions for escaping and formatting XML.
-}
-module Text.Pandoc.XML ( stripTags,
- escapeCharForXML,
+module Text.Pandoc.XML ( escapeCharForXML,
escapeStringForXML,
inTags,
selfClosingTag,
@@ -41,16 +40,6 @@ import Text.Pandoc.Pretty
import Data.Char (ord, isAscii, isSpace)
import Text.HTML.TagSoup.Entity (lookupEntity)
--- | Remove everything between <...>
-stripTags :: String -> String
-stripTags ('<':xs) =
- let (_,rest) = break (=='>') xs
- in if null rest
- then ""
- else stripTags (tail rest) -- leave off >
-stripTags (x:xs) = x : stripTags xs
-stripTags [] = []
-
-- | Escape one character as needed for XML.
escapeCharForXML :: Char -> String
escapeCharForXML x = case x of
diff --git a/tests/Tests/Arbitrary.hs b/tests/Tests/Arbitrary.hs
index d0000dcee..5939d088d 100644
--- a/tests/Tests/Arbitrary.hs
+++ b/tests/Tests/Arbitrary.hs
@@ -150,10 +150,13 @@ instance Arbitrary QuoteType where
instance Arbitrary Meta where
arbitrary
- = do x1 <- arbitrary
- x2 <- liftM (filter (not . null)) arbitrary
- x3 <- arbitrary
- return (Meta x1 x2 x3)
+ = do (x1 :: Inlines) <- arbitrary
+ (x2 :: [Inlines]) <- liftM (filter (not . isNull)) arbitrary
+ (x3 :: Inlines) <- arbitrary
+ return $ setMeta "title" x1
+ $ setMeta "author" x2
+ $ setMeta "date" x3
+ $ nullMeta
instance Arbitrary Alignment where
arbitrary
diff --git a/tests/Tests/Helpers.hs b/tests/Tests/Helpers.hs
index af64f5148..b48c8af3a 100644
--- a/tests/Tests/Helpers.hs
+++ b/tests/Tests/Helpers.hs
@@ -20,6 +20,7 @@ import Text.Pandoc.Options
import Text.Pandoc.Writers.Native (writeNative)
import qualified Test.QuickCheck.Property as QP
import Data.Algorithm.Diff
+import qualified Data.Map as M
test :: (ToString a, ToString b, ToString c)
=> (a -> b) -- ^ function to test
@@ -58,8 +59,9 @@ class ToString a where
instance ToString Pandoc where
toString d = writeNative def{ writerStandalone = s } $ toPandoc d
where s = case d of
- (Pandoc (Meta [] [] []) _) -> False
- _ -> True
+ (Pandoc (Meta m) _)
+ | M.null m -> False
+ | otherwise -> True
instance ToString Blocks where
toString = writeNative def . toPandoc
diff --git a/tests/Tests/Readers/RST.hs b/tests/Tests/Readers/RST.hs
index 2876f4270..a80dc32b7 100644
--- a/tests/Tests/Readers/RST.hs
+++ b/tests/Tests/Readers/RST.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Tests.Readers.RST (tests) where
import Text.Pandoc.Definition
@@ -7,9 +7,10 @@ import Tests.Helpers
import Tests.Arbitrary()
import Text.Pandoc.Builder
import Text.Pandoc
+import Data.Monoid (mempty)
rst :: String -> Pandoc
-rst = readRST def
+rst = readRST def{ readerStandalone = True }
infix 4 =:
(=:) :: ToString c
@@ -21,14 +22,12 @@ tests = [ "line block with blank line" =:
"| a\n|\n| b" =?> para (str "a") <>
para (str "\160b")
, "field list" =: unlines
- [ ":Hostname: media08"
+ [ "para"
+ , ""
+ , ":Hostname: media08"
, ":IP address: 10.0.0.19"
, ":Size: 3ru"
- , ":Date: 2001-08-16"
, ":Version: 1"
- , ":Authors: - Me"
- , " - Myself"
- , " - I"
, ":Indentation: Since the field marker may be quite long, the second"
, " and subsequent lines of the field body do not have to line up"
, " with the first line, but they must be indented relative to the"
@@ -36,10 +35,9 @@ tests = [ "line block with blank line" =:
, ":Parameter i: integer"
, ":Final: item"
, " on two lines" ]
- =?> ( setAuthors ["Me","Myself","I"]
- $ setDate "2001-08-16"
- $ doc
- $ definitionList [ (str "Hostname", [para "media08"])
+ =?> ( doc
+ $ para "para" <>
+ definitionList [ (str "Hostname", [para "media08"])
, (str "IP address", [para "10.0.0.19"])
, (str "Size", [para "3ru"])
, (str "Version", [para "1"])
@@ -47,6 +45,20 @@ tests = [ "line block with blank line" =:
, (str "Parameter i", [para "integer"])
, (str "Final", [para "item on two lines"])
])
+ , "initial field list" =: unlines
+ [ "====="
+ , "Title"
+ , "====="
+ , "--------"
+ , "Subtitle"
+ , "--------"
+ , ""
+ , ":Version: 1"
+ ]
+ =?> ( setMeta "version" (para "1")
+ $ setMeta "title" ("Title" :: Inlines)
+ $ setMeta "subtitle" ("Subtitle" :: Inlines)
+ $ doc mempty )
, "URLs with following punctuation" =:
("http://google.com, http://yahoo.com; http://foo.bar.baz.\n" ++
"http://foo.bar/baz_(bam) (http://foo.bar)") =?>
diff --git a/tests/Tests/Writers/Native.hs b/tests/Tests/Writers/Native.hs
index e199cf94e..9833bf5ae 100644
--- a/tests/Tests/Writers/Native.hs
+++ b/tests/Tests/Writers/Native.hs
@@ -12,7 +12,7 @@ p_write_rt d =
p_write_blocks_rt :: [Block] -> Bool
p_write_blocks_rt bs = length bs > 20 ||
- read (writeNative def (Pandoc (Meta [] [] []) bs)) ==
+ read (writeNative def (Pandoc nullMeta bs)) ==
bs
tests :: [Test]
diff --git a/tests/testsuite.native b/tests/testsuite.native
index 90727a660..c10be2f5d 100644
--- a/tests/testsuite.native
+++ b/tests/testsuite.native
@@ -1,4 +1,4 @@
-Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docAuthors = [[Str "John",Space,Str "MacFarlane"],[Str "Anonymous"]], docDate = [Str "July",Space,Str "17,",Space,Str "2006"]})
+Pandoc {docMeta = Meta {unMeta = fromList [("author",MetaList [MetaBlocks [Plain [Str "John",Space,Str "MacFarlane"]],MetaBlocks [Plain [Str "Anonymous"]]]),("date",MetaBlocks [Plain [Str "July",Space,Str "17,",Space,Str "2006"]]),("title",MetaBlocks [Plain [Str "Pandoc",Space,Str "Test",Space,Str "Suite"]])]}, docBody =
[Para [Str "This",Space,Str "is",Space,Str "a",Space,Str "set",Space,Str "of",Space,Str "tests",Space,Str "for",Space,Str "pandoc.",Space,Str "Most",Space,Str "of",Space,Str "them",Space,Str "are",Space,Str "adapted",Space,Str "from",Space,Str "John",Space,Str "Gruber\8217s",Space,Str "markdown",Space,Str "test",Space,Str "suite."]
,HorizontalRule
,Header 1 ("headers",[],[]) [Str "Headers"]
@@ -393,4 +393,4 @@ Pandoc (Meta {docTitle = [Str "Pandoc",Space,Str "Test",Space,Str "Suite"], docA
[Para [Str "Notes",Space,Str "can",Space,Str "go",Space,Str "in",Space,Str "quotes.",Note [Para [Str "In",Space,Str "quote."]]]]
,OrderedList (1,Decimal,Period)
[[Plain [Str "And",Space,Str "in",Space,Str "list",Space,Str "items.",Note [Para [Str "In",Space,Str "list."]]]]]
-,Para [Str "This",Space,Str "paragraph",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "part",Space,Str "of",Space,Str "the",Space,Str "note,",Space,Str "as",Space,Str "it",Space,Str "is",Space,Str "not",Space,Str "indented."]]
+,Para [Str "This",Space,Str "paragraph",Space,Str "should",Space,Str "not",Space,Str "be",Space,Str "part",Space,Str "of",Space,Str "the",Space,Str "note,",Space,Str "as",Space,Str "it",Space,Str "is",Space,Str "not",Space,Str "indented."]]}