aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-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
32 files changed, 613 insertions, 506 deletions
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