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.
This commit is contained in:
John MacFarlane 2013-05-10 22:53:35 -07:00
parent e32a8f5981
commit f869f7e08d
40 changed files with 671 additions and 545 deletions

@ -1 +1 @@
Subproject commit 05719b6491d26aa0fcb6a7de64aeebfc75955267 Subproject commit 050ea0fa8dc51d1e722f8e88b7ce9a792474082f

View file

@ -1,5 +1,5 @@
Name: pandoc Name: pandoc
Version: 1.11.2 Version: 1.12
Cabal-Version: >= 1.10 Cabal-Version: >= 1.10
Build-Type: Custom Build-Type: Custom
License: GPL License: GPL
@ -247,7 +247,7 @@ Library
random >= 1 && < 1.1, random >= 1 && < 1.1,
extensible-exceptions >= 0.1 && < 0.2, extensible-exceptions >= 0.1 && < 0.2,
citeproc-hs >= 0.3.7 && < 0.4, citeproc-hs >= 0.3.7 && < 0.4,
pandoc-types >= 1.10 && < 1.11, pandoc-types >= 1.12 && < 1.13,
aeson >= 0.6 && < 0.7, aeson >= 0.6 && < 0.7,
tagsoup >= 0.12.5 && < 0.13, tagsoup >= 0.12.5 && < 0.13,
base64-bytestring >= 0.1 && < 1.1, base64-bytestring >= 0.1 && < 1.1,
@ -259,6 +259,8 @@ Library
blaze-markup >= 0.5.1 && < 0.6, blaze-markup >= 0.5.1 && < 0.6,
attoparsec >= 0.10 && < 0.11, attoparsec >= 0.10 && < 0.11,
stringable >= 0.1 && < 0.2, stringable >= 0.1 && < 0.2,
yaml >= 0.8 && < 0.9,
vector >= 0.10 && < 0.11,
hslua >= 0.3 && < 0.4 hslua >= 0.3 && < 0.4
if flag(embed_data_files) if flag(embed_data_files)
cpp-options: -DEMBED_DATA_FILES cpp-options: -DEMBED_DATA_FILES
@ -393,7 +395,7 @@ Test-Suite test-pandoc
Build-Depends: base >= 4.2 && < 5, Build-Depends: base >= 4.2 && < 5,
syb >= 0.1 && < 0.5, syb >= 0.1 && < 0.5,
pandoc, pandoc,
pandoc-types >= 1.10 && < 1.11, pandoc-types >= 1.12 && < 1.13,
bytestring >= 0.9 && < 0.11, bytestring >= 0.9 && < 0.11,
text >= 0.11 && < 0.12, text >= 0.11 && < 0.12,
directory >= 1 && < 1.3, directory >= 1 && < 1.3,

View file

@ -193,18 +193,18 @@ readers :: [(String, ReaderOptions -> String -> IO Pandoc)]
readers = [("native" , \_ s -> return $ readNative s) readers = [("native" , \_ s -> return $ readNative s)
,("json" , \_ s -> return $ checkJSON ,("json" , \_ s -> return $ checkJSON
$ decode $ UTF8.fromStringLazy s) $ decode $ UTF8.fromStringLazy s)
,("markdown" , markdown) ,("markdown" , markdown)
,("markdown_strict" , markdown) ,("markdown_strict" , markdown)
,("markdown_phpextra" , markdown) ,("markdown_phpextra" , markdown)
,("markdown_github" , markdown) ,("markdown_github" , markdown)
,("markdown_mmd", markdown) ,("markdown_mmd", markdown)
,("rst" , \o s -> return $ readRST o s) ,("rst" , \o s -> return $ readRST o s)
,("mediawiki" , \o s -> return $ readMediaWiki o s) ,("mediawiki" , \o s -> return $ readMediaWiki o s)
,("docbook" , \o s -> return $ readDocBook o s) ,("docbook" , \o s -> return $ readDocBook o s)
,("opml" , \o s -> return $ readOPML o s) ,("opml" , \o s -> return $ readOPML o s)
,("textile" , \o s -> return $ readTextile o s) -- TODO : textile+lhs ,("textile" , \o s -> return $ readTextile o s) -- TODO : textile+lhs
,("html" , \o s -> return $ readHtml o s) ,("html" , \o s -> return $ readHtml o s)
,("latex" , \o s -> return $ readLaTeX o s) ,("latex" , \o s -> return $ readLaTeX o s)
,("haddock" , \o s -> return $ readHaddock o s) ,("haddock" , \o s -> return $ readHaddock o s)
] ]
@ -218,10 +218,10 @@ writers = [
("native" , PureStringWriter writeNative) ("native" , PureStringWriter writeNative)
,("json" , PureStringWriter $ \_ -> UTF8.toStringLazy . encode) ,("json" , PureStringWriter $ \_ -> UTF8.toStringLazy . encode)
,("docx" , IOByteStringWriter writeDocx) ,("docx" , IOByteStringWriter writeDocx)
,("odt" , IOByteStringWriter writeODT) ,("odt" , IOByteStringWriter writeODT)
,("epub" , IOByteStringWriter $ \o -> ,("epub" , IOByteStringWriter $ \o ->
writeEPUB o{ writerEpubVersion = Just EPUB2 }) writeEPUB o{ writerEpubVersion = Just EPUB2 })
,("epub3" , IOByteStringWriter $ \o -> ,("epub3" , IOByteStringWriter $ \o ->
writeEPUB o{ writerEpubVersion = Just EPUB3 }) writeEPUB o{ writerEpubVersion = Just EPUB3 })
,("fb2" , IOStringWriter writeFB2) ,("fb2" , IOStringWriter writeFB2)
,("html" , PureStringWriter writeHtmlString) ,("html" , PureStringWriter writeHtmlString)

View file

@ -55,6 +55,7 @@ data Extension =
Ext_footnotes -- ^ Pandoc/PHP/MMD style footnotes Ext_footnotes -- ^ Pandoc/PHP/MMD style footnotes
| Ext_inline_notes -- ^ Pandoc-style inline notes | Ext_inline_notes -- ^ Pandoc-style inline notes
| Ext_pandoc_title_block -- ^ Pandoc title block | Ext_pandoc_title_block -- ^ Pandoc title block
| Ext_yaml_title_block -- ^ YAML metadata block
| Ext_mmd_title_block -- ^ Multimarkdown metadata block | Ext_mmd_title_block -- ^ Multimarkdown metadata block
| Ext_table_captions -- ^ Pandoc-style table captions | Ext_table_captions -- ^ Pandoc-style table captions
| Ext_implicit_figures -- ^ A paragraph with just an image is a figure | Ext_implicit_figures -- ^ A paragraph with just an image is a figure
@ -106,6 +107,7 @@ pandocExtensions = Set.fromList
[ Ext_footnotes [ Ext_footnotes
, Ext_inline_notes , Ext_inline_notes
, Ext_pandoc_title_block , Ext_pandoc_title_block
, Ext_yaml_title_block
, Ext_table_captions , Ext_table_captions
, Ext_implicit_figures , Ext_implicit_figures
, Ext_simple_tables , Ext_simple_tables

View file

@ -148,7 +148,7 @@ where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Options 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 Text.Pandoc.XML (fromEntities)
import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn) import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
import Text.Parsec import Text.Parsec
@ -799,9 +799,7 @@ data ParserState = ParserState
stateSubstitutions :: SubstTable, -- ^ List of substitution references stateSubstitutions :: SubstTable, -- ^ List of substitution references
stateNotes :: NoteTable, -- ^ List of notes (raw bodies) stateNotes :: NoteTable, -- ^ List of notes (raw bodies)
stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies) stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies)
stateTitle :: [Inline], -- ^ Title of document stateMeta :: Meta, -- ^ Document metadata
stateAuthors :: [[Inline]], -- ^ Authors of document
stateDate :: [Inline], -- ^ Date of document
stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used
stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links) stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links)
stateIdentifiers :: [String], -- ^ List of header identifiers used stateIdentifiers :: [String], -- ^ List of header identifiers used
@ -816,6 +814,12 @@ data ParserState = ParserState
instance Default ParserState where instance Default ParserState where
def = defaultParserState 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
defaultParserState = defaultParserState =
ParserState { stateOptions = def, ParserState { stateOptions = def,
@ -828,9 +832,7 @@ defaultParserState =
stateSubstitutions = M.empty, stateSubstitutions = M.empty,
stateNotes = [], stateNotes = [],
stateNotes' = [], stateNotes' = [],
stateTitle = [], stateMeta = nullMeta,
stateAuthors = [],
stateDate = [],
stateHeaderTable = [], stateHeaderTable = [],
stateHeaders = M.empty, stateHeaders = M.empty,
stateIdentifiers = [], stateIdentifiers = [],

View file

@ -39,7 +39,7 @@ module Text.Pandoc.Readers.HTML ( readHtml
import Text.HTML.TagSoup import Text.HTML.TagSoup
import Text.HTML.TagSoup.Match import Text.HTML.TagSoup.Match
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Builder (text, toList) import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Parsing import Text.Pandoc.Parsing
@ -47,6 +47,7 @@ import Data.Maybe ( fromMaybe, isJust )
import Data.List ( intercalate ) import Data.List ( intercalate )
import Data.Char ( isDigit ) import Data.Char ( isDigit )
import Control.Monad ( liftM, guard, when, mzero ) import Control.Monad ( liftM, guard, when, mzero )
import Control.Applicative ( (<$>), (<$) )
isSpace :: Char -> Bool isSpace :: Char -> Bool
isSpace ' ' = True isSpace ' ' = True
@ -58,32 +59,26 @@ isSpace _ = False
readHtml :: ReaderOptions -- ^ Reader options readHtml :: ReaderOptions -- ^ Reader options
-> String -- ^ String to parse (assumes @'\n'@ line endings) -> String -- ^ String to parse (assumes @'\n'@ line endings)
-> Pandoc -> Pandoc
readHtml opts inp = Pandoc meta blocks readHtml opts inp =
where blocks = case runParser parseBody def{ stateOptions = opts } case runParser parseDoc def{ stateOptions = opts } "source" tags of
"source" rest of Left err' -> error $ "\nError at " ++ show err'
Left err' -> error $ "\nError at " ++ show err' Right result -> result
Right result -> result where tags = canonicalizeTags $
tags = canonicalizeTags $
parseTagsOptions parseOptions{ optTagPosition = True } inp parseTagsOptions parseOptions{ optTagPosition = True } inp
hasHeader = any (~== TagOpen "head" []) tags parseDoc = do
(meta, rest) = if hasHeader blocks <- (fixPlains False . concat) <$> manyTill block eof
then parseHeader tags meta <- stateMeta <$> getState
else (Meta [] [] [], tags) return $ Pandoc meta blocks
type TagParser = Parser [Tag String] ParserState type TagParser = Parser [Tag String] ParserState
-- TODO - fix this - not every header has a title tag pBody :: TagParser [Block]
parseHeader :: [Tag String] -> (Meta, [Tag String]) pBody = pInTags "body" block
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
parseBody :: TagParser [Block] pHead :: TagParser [Block]
parseBody = liftM (fixPlains False . concat) $ manyTill block eof 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 :: TagParser [Block]
block = choice block = choice
@ -94,6 +89,8 @@ block = choice
, pList , pList
, pHrule , pHrule
, pSimpleTable , pSimpleTable
, pHead
, pBody
, pPlain , pPlain
, pRawHtmlBlock , pRawHtmlBlock
] ]
@ -366,7 +363,7 @@ pImage = do
let url = fromAttrib "src" tag let url = fromAttrib "src" tag
let title = fromAttrib "title" tag let title = fromAttrib "title" tag
let alt = fromAttrib "alt" 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 :: TagParser [Inline]
pCode = try $ do pCode = try $ do

View file

@ -21,7 +21,7 @@ import Text.Pandoc.Readers.Haddock.Parse
readHaddock :: ReaderOptions -- ^ Reader options readHaddock :: ReaderOptions -- ^ Reader options
-> String -- ^ String to parse -> String -- ^ String to parse
-> Pandoc -> Pandoc
readHaddock _ s = Pandoc (Meta [] [] []) blocks readHaddock _ s = Pandoc nullMeta blocks
where where
blocks = case parseParas (tokenise s (0,0)) of blocks = case parseParas (tokenise s (0,0)) of
Left [] -> error "parse failure" Left [] -> error "parse failure"

View file

@ -65,13 +65,11 @@ parseLaTeX = do
bs <- blocks bs <- blocks
eof eof
st <- getState st <- getState
let title' = stateTitle st let meta = stateMeta st
let authors' = stateAuthors st
let date' = stateDate st
refs <- getOption readerReferences refs <- getOption readerReferences
mbsty <- getOption readerCitationStyle mbsty <- getOption readerCitationStyle
return $ processBiblio mbsty refs let (Pandoc _ bs') = processBiblio mbsty refs $ doc bs
$ Pandoc (Meta title' authors' date') $ toList bs return $ Pandoc meta bs'
type LP = Parser [Char] ParserState type LP = Parser [Char] ParserState
@ -249,13 +247,13 @@ ignoreBlocks name = (name, doraw <|> (mempty <$ optargs))
blockCommands :: M.Map String (LP Blocks) blockCommands :: M.Map String (LP Blocks)
blockCommands = M.fromList $ blockCommands = M.fromList $
[ ("par", mempty <$ skipopts) [ ("par", mempty <$ skipopts)
, ("title", mempty <$ (skipopts *> tok >>= addTitle)) , ("title", mempty <$ (skipopts *> tok >>= addMeta "title"))
, ("subtitle", mempty <$ (skipopts *> tok >>= addSubtitle)) , ("subtitle", mempty <$ (skipopts *> tok >>= addMeta "subtitle"))
, ("author", mempty <$ (skipopts *> authors)) , ("author", mempty <$ (skipopts *> authors))
-- -- in letter class, temp. store address & sig as title, author -- -- 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)) , ("signature", mempty <$ (skipopts *> authors))
, ("date", mempty <$ (skipopts *> tok >>= addDate)) , ("date", mempty <$ (skipopts *> tok >>= addMeta "date"))
-- sectioning -- sectioning
, ("chapter", updateState (\s -> s{ stateHasChapters = True }) , ("chapter", updateState (\s -> s{ stateHasChapters = True })
*> section nullAttr 0) *> section nullAttr 0)
@ -301,12 +299,8 @@ blockCommands = M.fromList $
, "hspace", "vspace" , "hspace", "vspace"
] ]
addTitle :: Inlines -> LP () addMeta :: ToMetaValue a => String -> a -> LP ()
addTitle tit = updateState (\s -> s{ stateTitle = toList tit }) addMeta field val = updateState $ setMeta field val
addSubtitle :: Inlines -> LP ()
addSubtitle tit = updateState (\s -> s{ stateTitle = stateTitle s ++
toList (str ":" <> linebreak <> tit) })
authors :: LP () authors :: LP ()
authors = try $ do authors = try $ do
@ -317,10 +311,7 @@ authors = try $ do
-- skip e.g. \vspace{10pt} -- skip e.g. \vspace{10pt}
auths <- sepBy oneAuthor (controlSeq "and") auths <- sepBy oneAuthor (controlSeq "and")
char '}' char '}'
updateState (\s -> s { stateAuthors = map (normalizeSpaces . toList) auths }) addMeta "authors" (map trimInlines auths)
addDate :: Inlines -> LP ()
addDate dat = updateState (\s -> s{ stateDate = toList dat })
section :: Attr -> Int -> LP Blocks section :: Attr -> Int -> LP Blocks
section attr lvl = do section attr lvl = do
@ -872,20 +863,24 @@ letter_contents = do
bs <- blocks bs <- blocks
st <- getState st <- getState
-- add signature (author) and address (title) -- add signature (author) and address (title)
let addr = case stateTitle st of let addr = case lookupMeta "address" (stateMeta st) of
[] -> mempty Just (MetaBlocks [Plain xs]) ->
x -> para $ trimInlines $ fromList x para $ trimInlines $ fromList xs
updateState $ \s -> s{ stateAuthors = [], stateTitle = [] } _ -> mempty
return $ addr <> bs -- sig added by \closing return $ addr <> bs -- sig added by \closing
closing :: LP Blocks closing :: LP Blocks
closing = do closing = do
contents <- tok contents <- tok
st <- getState st <- getState
let sigs = case stateAuthors st of let extractInlines (MetaBlocks [Plain ys]) = ys
[] -> mempty extractInlines (MetaBlocks [Para ys ]) = ys
xs -> para $ trimInlines $ fromList extractInlines _ = []
$ intercalate [LineBreak] xs 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 return $ para (trimInlines contents) <> sigs
item :: LP Blocks item :: LP Blocks

View file

@ -37,7 +37,13 @@ import Data.Ord ( comparing )
import Data.Char ( isAlphaNum, toLower ) import Data.Char ( isAlphaNum, toLower )
import Data.Maybe import Data.Maybe
import Text.Pandoc.Definition 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.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.Builder (Inlines, Blocks, trimInlines, (<>))
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Shared import Text.Pandoc.Shared
@ -196,12 +202,13 @@ dateLine = try $ do
skipSpaces skipSpaces
trimInlinesF . mconcat <$> manyTill inline newline trimInlinesF . mconcat <$> manyTill inline newline
titleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines) titleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
titleBlock = pandocTitleBlock titleBlock = pandocTitleBlock
<|> yamlTitleBlock
<|> mmdTitleBlock <|> mmdTitleBlock
<|> return (mempty, return [], mempty) <|> return (return id)
pandocTitleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines) pandocTitleBlock :: MarkdownParser (F (Pandoc -> Pandoc))
pandocTitleBlock = try $ do pandocTitleBlock = try $ do
guardEnabled Ext_pandoc_title_block guardEnabled Ext_pandoc_title_block
lookAhead (char '%') lookAhead (char '%')
@ -209,25 +216,78 @@ pandocTitleBlock = try $ do
author <- option (return []) authorsLine author <- option (return []) authorsLine
date <- option mempty dateLine date <- option mempty dateLine
optional blanklines optional blanklines
return (title, author, date) return $ do
title' <- title
author' <- author
date' <- date
return $ B.setMeta "title" title'
. B.setMeta "author" author'
. B.setMeta "date" date'
mmdTitleBlock :: MarkdownParser (F Inlines, F [Inlines], F Inlines) 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 mmdTitleBlock = try $ do
guardEnabled Ext_mmd_title_block guardEnabled Ext_mmd_title_block
kvPairs <- many1 kvPair kvPairs <- many1 kvPair
blanklines blanklines
let title = maybe mempty return $ lookup "title" kvPairs return $ return $ \(Pandoc m bs) ->
let author = maybe mempty (\x -> return [x]) $ lookup "author" kvPairs Pandoc (foldl (\m' (k,v) -> addMetaField k v m') m kvPairs) bs
let date = maybe mempty return $ lookup "date" kvPairs
return (title, author, date)
kvPair :: MarkdownParser (String, Inlines) kvPair :: MarkdownParser (String, MetaValue)
kvPair = try $ do kvPair = try $ do
key <- many1Till (alphaNum <|> oneOf "_- ") (char ':') key <- many1Till (alphaNum <|> oneOf "_- ") (char ':')
val <- manyTill anyChar val <- manyTill anyChar
(try $ newline >> lookAhead (blankline <|> nonspaceChar)) (try $ newline >> lookAhead (blankline <|> nonspaceChar))
let key' = concat $ words $ map toLower key 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') return (key',val')
parseMarkdown :: MarkdownParser Pandoc parseMarkdown :: MarkdownParser Pandoc
@ -236,16 +296,15 @@ parseMarkdown = do
updateState $ \state -> state { stateOptions = updateState $ \state -> state { stateOptions =
let oldOpts = stateOptions state in let oldOpts = stateOptions state in
oldOpts{ readerParseRaw = True } } oldOpts{ readerParseRaw = True } }
(title, authors, date) <- option (mempty,return [],mempty) titleBlock titleTrans <- option (return id) titleBlock
blocks <- parseBlocks blocks <- parseBlocks
st <- getState st <- getState
mbsty <- getOption readerCitationStyle mbsty <- getOption readerCitationStyle
refs <- getOption readerReferences refs <- getOption readerReferences
return $ processBiblio mbsty refs return $ processBiblio mbsty refs
$ B.setTitle (runF title st) $ runF titleTrans st
$ B.setAuthors (runF authors st) $ B.doc
$ B.setDate (runF date st) $ runF blocks st
$ B.doc $ runF blocks st
addWarning :: Maybe SourcePos -> String -> MarkdownParser () addWarning :: Maybe SourcePos -> String -> MarkdownParser ()
addWarning mbpos msg = addWarning mbpos msg =

View file

@ -33,12 +33,6 @@ module Text.Pandoc.Readers.Native ( readNative ) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Shared (safeRead) import Text.Pandoc.Shared (safeRead)
nullMeta :: Meta
nullMeta = Meta{ docTitle = []
, docAuthors = []
, docDate = []
}
-- | Read native formatted text and return a Pandoc document. -- | Read native formatted text and return a Pandoc document.
-- The input may be a full pandoc document, a block list, a block, -- The input may be a full pandoc document, a block list, a block,
-- an inline list, or an inline. Thus, for example, -- an inline list, or an inline. Thus, for example,
@ -47,7 +41,7 @@ nullMeta = Meta{ docTitle = []
-- --
-- will be treated as if it were -- 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) readNative :: String -- ^ String to parse (assuming @'\n'@ line endings)
-> Pandoc -> Pandoc

View file

@ -31,6 +31,7 @@ module Text.Pandoc.Readers.RST (
readRST readRST
) where ) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Builder (setMeta, fromList)
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Parsing import Text.Pandoc.Parsing
import Text.Pandoc.Options import Text.Pandoc.Options
@ -39,7 +40,6 @@ import Data.List ( findIndex, intersperse, intercalate,
transpose, sort, deleteFirstsBy, isSuffixOf ) transpose, sort, deleteFirstsBy, isSuffixOf )
import qualified Data.Map as M import qualified Data.Map as M
import Text.Printf ( printf ) import Text.Printf ( printf )
import Data.Maybe ( catMaybes )
import Control.Applicative ((<$>), (<$), (<*), (*>)) import Control.Applicative ((<$>), (<$), (<*), (*>))
import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>)) import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
import qualified Text.Pandoc.Builder as B 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) -- | 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 -- of level that are not found elsewhere, return it as a title and
-- promote all the other headers. -- promote all the other headers. Also process a definition list right
titleTransform :: [Block] -- ^ list of blocks -- after the title block as metadata.
-> ([Block], [Inline]) -- ^ modified list of blocks, title titleTransform :: ([Block], Meta) -- ^ list of blocks, metadata
titleTransform ((Header 1 _ head1):(Header 2 _ head2):rest) | -> ([Block], Meta) -- ^ modified list of blocks, metadata
not (any (isHeader 1) rest || any (isHeader 2) rest) = -- both title & subtitle titleTransform (bs, meta) =
(promoteHeaders 2 rest, head1 ++ [Str ":", Space] ++ head2) let (bs', meta') =
titleTransform ((Header 1 _ head1):rest) | case bs of
not (any (isHeader 1) rest) = -- title, no subtitle ((Header 1 _ head1):(Header 2 _ head2):rest)
(promoteHeaders 1 rest, head1) | not (any (isHeader 1) rest || any (isHeader 2) rest) -> -- tit/sub
titleTransform blocks = (blocks, []) (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 :: RSTParser Pandoc
parseRST = do parseRST = do
@ -114,14 +128,12 @@ parseRST = do
-- now parse it for real... -- now parse it for real...
blocks <- B.toList <$> parseBlocks blocks <- B.toList <$> parseBlocks
standalone <- getOption readerStandalone standalone <- getOption readerStandalone
let (blocks', title) = if standalone
then titleTransform blocks
else (blocks, [])
state <- getState state <- getState
let authors = stateAuthors state let meta = stateMeta state
let date = stateDate state let (blocks', meta') = if standalone
let title' = if null title then stateTitle state else title then titleTransform (blocks, meta)
return $ Pandoc (Meta title' authors date) blocks' else (blocks, meta)
return $ Pandoc meta' blocks'
-- --
-- parsing blocks -- parsing blocks
@ -163,38 +175,19 @@ rawFieldListItem indent = try $ do
return (name, raw) return (name, raw)
fieldListItem :: String fieldListItem :: String
-> RSTParser (Maybe (Inlines, [Blocks])) -> RSTParser (Inlines, [Blocks])
fieldListItem indent = try $ do fieldListItem indent = try $ do
(name, raw) <- rawFieldListItem indent (name, raw) <- rawFieldListItem indent
let term = B.str name let term = B.str name
contents <- parseFromString parseBlocks raw contents <- parseFromString parseBlocks raw
optional blanklines optional blanklines
case (name, B.toList contents) of return (term, [contents])
("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 _ = []
fieldList :: RSTParser Blocks fieldList :: RSTParser Blocks
fieldList = try $ do fieldList = try $ do
indent <- lookAhead $ many spaceChar indent <- lookAhead $ many spaceChar
items <- many1 $ fieldListItem indent items <- many1 $ fieldListItem indent
case catMaybes items of case items of
[] -> return mempty [] -> return mempty
items' -> return $ B.definitionList items' items' -> return $ B.definitionList items'

View file

@ -93,7 +93,7 @@ parseTextile = do
updateState $ \s -> s { stateNotes = reverse reversedNotes } updateState $ \s -> s { stateNotes = reverse reversedNotes }
-- now parse it for real... -- now parse it for real...
blocks <- parseBlocks blocks <- parseBlocks
return $ Pandoc (Meta [] [] []) blocks -- FIXME return $ Pandoc nullMeta blocks -- FIXME
noteMarker :: Parser [Char] ParserState [Char] noteMarker :: Parser [Char] ParserState [Char]
noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.') noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')

View file

@ -1,6 +1,6 @@
{-# LANGUAGE DeriveDataTypeable, CPP #-} {-# 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 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 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 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 License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu> Maintainer : John MacFarlane <jgm@berkeley.edu>
@ -61,6 +61,10 @@ module Text.Pandoc.Shared (
isHeaderBlock, isHeaderBlock,
headerShift, headerShift,
isTightList, isTightList,
addMetaField,
makeMeta,
metaToJSON,
setField,
-- * TagSoup HTML handling -- * TagSoup HTML handling
renderTags', renderTags',
-- * File handling -- * File handling
@ -78,7 +82,7 @@ module Text.Pandoc.Shared (
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Generic 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.Builder as B
import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.UTF8 as UTF8
import System.Environment (getProgName) import System.Environment (getProgName)
@ -86,6 +90,7 @@ import System.Exit (exitWith, ExitCode(..))
import Data.Char ( toLower, isLower, isUpper, isAlpha, import Data.Char ( toLower, isLower, isUpper, isAlpha,
isLetter, isDigit, isSpace ) isLetter, isDigit, isSpace )
import Data.List ( find, isPrefixOf, intercalate ) import Data.List ( find, isPrefixOf, intercalate )
import qualified Data.Map as M
import Network.URI ( escapeURIString, isAbsoluteURI, parseURI, unEscapeString ) import Network.URI ( escapeURIString, isAbsoluteURI, parseURI, unEscapeString )
import System.Directory import System.Directory
import Text.Pandoc.MIME (getMimeType) import Text.Pandoc.MIME (getMimeType)
@ -104,6 +109,11 @@ import qualified Data.ByteString.Char8 as B8
import Network.HTTP (findHeader, rspBody, import Network.HTTP (findHeader, rspBody,
RequestMethod(..), HeaderName(..), mkRequest) RequestMethod(..), HeaderName(..), mkRequest)
import Network.Browser (browse, setAllowRedirects, setOutHandler, request) 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 #ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles) import Text.Pandoc.Data (dataFiles)
import System.FilePath ( joinPath, splitDirectories ) import System.FilePath ( joinPath, splitDirectories )
@ -491,6 +501,67 @@ isTightList = and . map firstIsPlain
where firstIsPlain (Plain _ : _) = True where firstIsPlain (Plain _ : _) = True
firstIsPlain _ = False 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 -- TagSoup HTML handling
-- --

View file

@ -86,6 +86,7 @@ example above.
-} -}
module Text.Pandoc.Templates ( renderTemplate module Text.Pandoc.Templates ( renderTemplate
, renderTemplate'
, TemplateTarget(..) , TemplateTarget(..)
, varListToJSON , varListToJSON
, compileTemplate , compileTemplate
@ -165,13 +166,17 @@ varListToJSON assoc = toJSON $ M.fromList assoc'
toVal xs = toJSON xs toVal xs = toJSON xs
renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b renderTemplate :: (ToJSON a, TemplateTarget b) => Template -> a -> b
renderTemplate template context = renderTemplate (Template f) context = toTarget $ f $ toJSON context
toTarget $ renderTemplate' template (toJSON context)
where renderTemplate' (Template f) val = f val
compileTemplate :: Text -> Either String Template compileTemplate :: Text -> Either String Template
compileTemplate template = A.parseOnly pTemplate 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 :: Variable -> Template
var = Template . resolveVar var = Template . resolveVar

View file

@ -38,13 +38,16 @@ AsciiDoc: <http://www.methods.co.nz/asciidoc/>
-} -}
module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, space) import Text.Pandoc.Parsing hiding (blankline, space)
import Data.List ( isPrefixOf, intersperse, intercalate ) import Data.List ( isPrefixOf, intersperse, intercalate )
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import Control.Monad.State 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 data WriterState = WriterState { defListMarker :: String
, orderedListLevel :: Int , orderedListLevel :: Int
@ -62,29 +65,33 @@ writeAsciiDoc opts document =
-- | Return asciidoc representation of document. -- | Return asciidoc representation of document.
pandocToAsciiDoc :: WriterOptions -> Pandoc -> State WriterState String pandocToAsciiDoc :: WriterOptions -> Pandoc -> State WriterState String
pandocToAsciiDoc opts (Pandoc (Meta title authors date) blocks) = do pandocToAsciiDoc opts (Pandoc meta blocks) = do
title' <- inlineListToAsciiDoc opts title let titleblock = not $ null (docTitle meta) && null (docAuthors meta) &&
let title'' = title' $$ text (replicate (offset title') '=') null (docDate meta)
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
let colwidth = if writerWrapText opts let colwidth = if writerWrapText opts
then Just $ writerColumns opts then Just $ writerColumns opts
else Nothing 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 main = render colwidth body
let context = writerVariables opts ++ let context = setField "body" main
[ ("body", main) $ setField "toc"
, ("title", render colwidth title'') (writerTableOfContents opts && writerStandalone opts)
, ("date", render colwidth date') $ setField "titleblock" titleblock
] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("toc", "yes") | writerTableOfContents opts && metadata' (writerVariables opts)
writerStandalone opts ] ++
[ ("titleblock", "yes") | titleblock ] ++
[ ("author", render colwidth a) | a <- authors' ]
if writerStandalone opts if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts then return $ renderTemplate' (writerTemplate opts) context
else return main else return main
-- | Escape special characters for AsciiDoc. -- | Escape special characters for AsciiDoc.

View file

@ -37,7 +37,7 @@ import Text.Printf ( printf )
import Data.List ( intercalate, isPrefixOf ) import Data.List ( intercalate, isPrefixOf )
import Control.Monad.State import Control.Monad.State
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import Text.Pandoc.Templates ( renderTemplate ) import Text.Pandoc.Templates ( renderTemplate' )
import Network.URI ( isURI, unEscapeString ) import Network.URI ( isURI, unEscapeString )
data WriterState = data WriterState =
@ -59,36 +59,32 @@ writeConTeXt options document =
in evalState (pandocToConTeXt options document) defaultWriterState in evalState (pandocToConTeXt options document) defaultWriterState
pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String 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 let colwidth = if writerWrapText options
then Just $ writerColumns options then Just $ writerColumns options
else Nothing else Nothing
titletext <- if null title metadata <- metaToJSON
then return "" (fmap (render colwidth) . blockListToConTeXt)
else liftM (render colwidth) $ inlineListToConTeXt title (fmap (render colwidth) . inlineListToConTeXt)
authorstext <- mapM (liftM (render colwidth) . inlineListToConTeXt) authors meta
datetext <- if null date
then return ""
else liftM (render colwidth) $ inlineListToConTeXt date
body <- mapM (elementToConTeXt options) $ hierarchicalize blocks body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
let main = (render colwidth . vcat) body let main = (render colwidth . vcat) body
let context = writerVariables options ++ let context = setField "toc" (writerTableOfContents options)
[ ("toc", if writerTableOfContents options then "yes" else "") $ setField "placelist" (intercalate ("," :: String) $
, ("placelist", intercalate "," $
take (writerTOCDepth options + if writerChapters options take (writerTOCDepth options + if writerChapters options
then 0 then 0
else 1) else 1)
["chapter","section","subsection","subsubsection", ["chapter","section","subsection","subsubsection",
"subsubsubsection","subsubsubsubsection"]) "subsubsubsection","subsubsubsubsection"])
, ("body", main) $ setField "body" main
, ("title", titletext) $ setField "number-sections" (writerNumberSections options)
, ("date", datetext) ] ++ $ setField "mainlang" (maybe ""
[ ("number-sections", "yes") | writerNumberSections options ] ++ (reverse . takeWhile (/=',') . reverse)
[ ("mainlang", maybe "" (reverse . takeWhile (/=',') . reverse) (lookup "lang" $ writerVariables options))
(lookup "lang" $ writerVariables options)) ] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("author", a) | a <- authorstext ] metadata (writerVariables options)
return $ if writerStandalone options return $ if writerStandalone options
then renderTemplate context $ writerTemplate options then renderTemplate' (writerTemplate options) context
else main else main
-- escape things as needed for ConTeXt -- escape things as needed for ConTeXt

View file

@ -121,10 +121,10 @@ writeCustom luaFile opts doc = do
return $ toString rendered return $ toString rendered
docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO ByteString docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO ByteString
docToCustom lua opts (Pandoc (Meta title authors date) blocks) = do docToCustom lua opts (Pandoc meta blocks) = do
title' <- inlineListToCustom lua title title' <- inlineListToCustom lua $ docTitle meta
authors' <- mapM (inlineListToCustom lua) authors authors' <- mapM (inlineListToCustom lua) $ docAuthors meta
date' <- inlineListToCustom lua date date' <- inlineListToCustom lua $ docDate meta
body <- blockListToCustom lua blocks body <- blockListToCustom lua blocks
callfunc lua "Doc" body title' authors' date' (writerVariables opts) callfunc lua "Doc" body title' authors' date' (writerVariables opts)

View file

@ -32,21 +32,26 @@ import Text.Pandoc.Definition
import Text.Pandoc.XML import Text.Pandoc.XML
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Readers.TeXMath
import Data.List ( isPrefixOf, intercalate, isSuffixOf ) import Data.List ( isPrefixOf, intercalate, isSuffixOf )
import Data.Char ( toLower ) import Data.Char ( toLower )
import Text.Pandoc.Highlighting ( languages, languagesByExtension ) import Text.Pandoc.Highlighting ( languages, languagesByExtension )
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import qualified Text.Pandoc.Builder as B
import Text.TeXMath import Text.TeXMath
import qualified Text.XML.Light as Xml import qualified Text.XML.Light as Xml
import Data.Generics (everywhere, mkT) import Data.Generics (everywhere, mkT)
-- | Convert list of authors to a docbook <author> section -- | Convert list of authors to a docbook <author> section
authorToDocbook :: WriterOptions -> [Inline] -> Doc authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines
authorToDocbook opts name' = authorToDocbook opts name' =
let name = render Nothing $ inlinesToDocbook 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 then -- last name first
let (lastname, rest) = break (==',') name let (lastname, rest) = break (==',') name
firstname = triml rest in firstname = triml rest in
@ -64,11 +69,8 @@ authorToDocbook opts name' =
-- | Convert Pandoc document to string in Docbook format. -- | Convert Pandoc document to string in Docbook format.
writeDocbook :: WriterOptions -> Pandoc -> String writeDocbook :: WriterOptions -> Pandoc -> String
writeDocbook opts (Pandoc (Meta tit auths dat) blocks) = writeDocbook opts (Pandoc meta blocks) =
let title = inlinesToDocbook opts tit let elements = hierarchicalize blocks
authors = map (authorToDocbook opts) auths
date = inlinesToDocbook opts dat
elements = hierarchicalize blocks
colwidth = if writerWrapText opts colwidth = if writerWrapText opts
then Just $ writerColumns opts then Just $ writerColumns opts
else Nothing else Nothing
@ -78,17 +80,21 @@ writeDocbook opts (Pandoc (Meta tit auths dat) blocks) =
then opts{ writerChapters = True } then opts{ writerChapters = True }
else opts else opts
startLvl = if writerChapters opts' then 0 else 1 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) main = render' $ vcat (map (elementToDocbook opts' startLvl) elements)
context = writerVariables opts ++ context = setField "body" main
[ ("body", main) $ setField "mathml" (case writerHTMLMathMethod opts of
, ("title", render' title) MathML _ -> True
, ("date", render' date) ] ++ _ -> False)
[ ("author", render' a) | a <- authors ] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("mathml", "yes") | case writerHTMLMathMethod opts of metadata (writerVariables opts)
MathML _ -> True
_ -> False ]
in if writerStandalone opts in if writerStandalone opts
then renderTemplate context $ writerTemplate opts then renderTemplate' (writerTemplate opts) context
else main else main
-- | Convert an Element to Docbook. -- | Convert an Element to Docbook.

View file

@ -103,7 +103,7 @@ toLazy = BL.fromChunks . (:[])
writeDocx :: WriterOptions -- ^ Writer options writeDocx :: WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert -> Pandoc -- ^ Document to convert
-> IO BL.ByteString -> IO BL.ByteString
writeDocx opts doc@(Pandoc (Meta tit auths date) _) = do writeDocx opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts let datadir = writerUserDataDir opts
let doc' = bottomUp (concatMap fixDisplayMath) doc let doc' = bottomUp (concatMap fixDisplayMath) doc
refArchive <- liftM (toArchive . toLazy) $ 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:dcterms","http://purl.org/dc/terms/")
,("xmlns:dcmitype","http://purl.org/dc/dcmitype/") ,("xmlns:dcmitype","http://purl.org/dc/dcmitype/")
,("xmlns:xsi","http://www.w3.org/2001/XMLSchema-instance")] ,("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")] : 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 : 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 docPropsEntry = toEntry docPropsPath epochtime $ UTF8.fromStringLazy $ showTopElement' docProps
let relsPath = "_rels/.rels" let relsPath = "_rels/.rels"
rels <- case findEntryByPath relsPath refArchive of 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). -- | Convert Pandoc document to two OpenXML elements (the main document and footnotes).
writeOpenXML :: WriterOptions -> Pandoc -> WS (Element, Element) 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)] title <- withParaProp (pStyle "Title") $ blocksToOpenXML opts [Para tit | not (null tit)]
authors <- withParaProp (pStyle "Authors") $ blocksToOpenXML opts authors <- withParaProp (pStyle "Authors") $ blocksToOpenXML opts
[Para (intercalate [LineBreak] auths) | not (null auths)] [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 let blocks' = bottomUp convertSpace $ blocks
doc' <- blocksToOpenXML opts blocks' doc' <- blocksToOpenXML opts blocks'
notes' <- reverse `fmap` gets stFootnotes notes' <- reverse `fmap` gets stFootnotes
let meta = title ++ authors ++ date let meta' = title ++ authors ++ date
let stdAttributes = let stdAttributes =
[("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main") [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math") ,("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:a","http://schemas.openxmlformats.org/drawingml/2006/main")
,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture") ,("xmlns:pic","http://schemas.openxmlformats.org/drawingml/2006/picture")
,("xmlns:wp","http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing")] ,("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' let notes = mknode "w:footnotes" stdAttributes notes'
return (doc, notes) return (doc, notes)

View file

@ -45,6 +45,7 @@ import Data.Time
import System.Locale import System.Locale
import Text.Pandoc.Shared hiding ( Element ) import Text.Pandoc.Shared hiding ( Element )
import qualified Text.Pandoc.Shared as Shared import qualified Text.Pandoc.Shared as Shared
import Text.Pandoc.Builder (fromList, setMeta)
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Generic import Text.Pandoc.Generic
@ -180,8 +181,10 @@ writeEPUB opts doc@(Pandoc meta _) = do
$ writeHtml opts'{ writerNumberOffset = $ writeHtml opts'{ writerNumberOffset =
maybe [] id mbnum } maybe [] id mbnum }
$ case bs of $ case bs of
(Header _ _ xs : _) -> Pandoc (Meta xs [] []) bs (Header _ _ xs : _) ->
_ -> Pandoc (Meta [] [] []) bs Pandoc (setMeta "title" (fromList xs) nullMeta) bs
_ ->
Pandoc nullMeta bs
let chapterEntries = zipWith chapToEntry [1..] chapters let chapterEntries = zipWith chapToEntry [1..] chapters
@ -248,9 +251,9 @@ writeEPUB opts doc@(Pandoc meta _) = do
Just _ -> [ unode "itemref" ! Just _ -> [ unode "itemref" !
[("idref", "cover"),("linear","no")] $ () ] [("idref", "cover"),("linear","no")] $ () ]
++ ((unode "itemref" ! [("idref", "title_page") ++ ((unode "itemref" ! [("idref", "title_page")
,("linear", case meta of ,("linear", if null (docTitle meta)
Meta [] [] [] -> "no" then "no"
_ -> "yes")] $ ()) : else "yes")] $ ()) :
(unode "itemref" ! [("idref", "nav") (unode "itemref" ! [("idref", "nav")
,("linear", if writerTableOfContents opts ,("linear", if writerTableOfContents opts
then "yes" then "yes"
@ -440,7 +443,7 @@ transformInline _ _ _ x = return x
writeHtmlInline :: WriterOptions -> Inline -> String writeHtmlInline :: WriterOptions -> Inline -> String
writeHtmlInline opts z = trimr $ writeHtmlInline opts z = trimr $
writeHtmlString opts{ writerStandalone = False } writeHtmlString opts{ writerStandalone = False }
$ Pandoc (Meta [] [] []) [Plain [z]] $ Pandoc nullMeta [Plain [z]]
(!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element (!) :: Node t => (t -> Element) -> [(String, String)] -> t -> Element
(!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n) (!) f attrs n = add_attrs (map (\(k,v) -> Attr (unqual k) v) attrs) (f n)

View file

@ -34,18 +34,16 @@ import Text.Pandoc.Definition
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Templates import Text.Pandoc.Templates
import Text.Pandoc.Generic
import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Slides import Text.Pandoc.Slides
import Text.Pandoc.Highlighting ( highlight, styleToCss, import Text.Pandoc.Highlighting ( highlight, styleToCss,
formatHtmlInline, formatHtmlBlock ) formatHtmlInline, formatHtmlBlock )
import Text.Pandoc.XML (stripTags, fromEntities) import Text.Pandoc.XML (fromEntities)
import Network.HTTP ( urlEncode ) import Network.HTTP ( urlEncode )
import Numeric ( showHex ) import Numeric ( showHex )
import Data.Char ( ord, toLower ) import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, intersperse ) import Data.List ( isPrefixOf, intersperse )
import Data.String ( fromString ) import Data.String ( fromString )
import qualified Data.Text as T
import Data.Maybe ( catMaybes ) import Data.Maybe ( catMaybes )
import Control.Monad.State import Control.Monad.State
import Text.Blaze.Html hiding(contents) import Text.Blaze.Html hiding(contents)
@ -62,6 +60,7 @@ import Text.TeXMath
import Text.XML.Light.Output import Text.XML.Light.Output
import System.FilePath (takeExtension) import System.FilePath (takeExtension)
import Data.Monoid import Data.Monoid
import Data.Aeson (Value)
data WriterState = WriterState data WriterState = WriterState
{ stNotes :: [Html] -- ^ List of notes { stNotes :: [Html] -- ^ List of notes
@ -93,39 +92,30 @@ nl opts = if writerWrapText opts
-- | Convert Pandoc document to Html string. -- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString :: WriterOptions -> Pandoc -> String
writeHtmlString opts d = writeHtmlString opts d =
let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d) let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
defaultWriterState
in if writerStandalone opts in if writerStandalone opts
then inTemplate opts tit auths authsMeta date toc body' newvars then inTemplate opts context body
else renderHtml body' else renderHtml body
-- | Convert Pandoc document to Html structure. -- | Convert Pandoc document to Html structure.
writeHtml :: WriterOptions -> Pandoc -> Html writeHtml :: WriterOptions -> Pandoc -> Html
writeHtml opts d = writeHtml opts d =
let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d) let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
defaultWriterState
in if writerStandalone opts in if writerStandalone opts
then inTemplate opts tit auths authsMeta date toc body' newvars then inTemplate opts context body
else body' else body
-- result is (title, authors, date, toc, body, new variables) -- result is (title, authors, date, toc, body, new variables)
pandocToHtml :: WriterOptions pandocToHtml :: WriterOptions
-> Pandoc -> Pandoc
-> State WriterState (Html, [Html], [Html], Html, Maybe Html, Html, [(String,String)]) -> State WriterState (Html, Value)
pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do pandocToHtml opts (Pandoc meta blocks) = do
let standalone = writerStandalone opts metadata <- metaToJSON
tit <- if standalone (fmap renderHtml . blockListToHtml opts)
then inlineListToHtml opts title' (fmap renderHtml . inlineListToHtml opts)
else return mempty meta
auths <- if standalone let authsMeta = map stringify $ docAuthors meta
then mapM (inlineListToHtml opts) authors' let dateMeta = stringify $ docDate meta
else return []
authsMeta <- if standalone
then mapM (inlineListToHtml opts . prepForMeta) authors'
else return []
date <- if standalone
then inlineListToHtml opts date'
else return mempty
let slideLevel = maybe (getSlideLevel blocks) id $ writerSlideLevel opts let slideLevel = maybe (getSlideLevel blocks) id $ writerSlideLevel opts
let sects = hierarchicalize $ let sects = hierarchicalize $
if writerSlideVariant opts == NoSlides if writerSlideVariant opts == NoSlides
@ -165,58 +155,37 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
| otherwise -> mempty | otherwise -> mempty
Nothing -> mempty Nothing -> mempty
else mempty else mempty
let newvars = [("highlighting-css", let context = (if stHighlighting st
styleToCss $ writerHighlightStyle opts) | then setField "highlighting-css"
stHighlighting st] ++ (styleToCss $ writerHighlightStyle opts)
[("math", renderHtml math) | stMath st] ++ else id) $
[("quotes", "yes") | stQuotes st] (if stMath st
return (tit, auths, authsMeta, date, toc, thebody, newvars) then setField "math" (renderHtml math)
else id) $
-- | Prepare author for meta tag, converting notes into setField "quotes" (stQuotes st) $
-- bracketed text and removing links. maybe id (setField "toc" . renderHtml) toc $
prepForMeta :: [Inline] -> [Inline] setField "author-meta" authsMeta $
prepForMeta = bottomUp (concatMap fixInline) maybe id (setField "date-meta") (normalizeDate dateMeta) $
where fixInline (Note [Para xs]) = [Str " ["] ++ xs ++ [Str "]"] setField "pagetitle" (stringify $ docTitle meta) $
fixInline (Note [Plain xs]) = [Str " ["] ++ xs ++ [Str "]"] setField "idprefix" (writerIdentifierPrefix opts) $
fixInline (Link lab _) = lab -- these should maybe be set in pandoc.hs
fixInline (Image lab _) = lab setField "slidy-url"
fixInline x = [x] ("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 inTemplate :: TemplateTarget a
=> WriterOptions => WriterOptions
-> Value
-> Html -> Html
-> [Html]
-> [Html]
-> Html
-> Maybe Html
-> Html
-> [(String,String)]
-> a -> a
inTemplate opts tit auths authsMeta date toc body' newvars = inTemplate opts context body = renderTemplate' (writerTemplate opts)
let title' = renderHtml tit $ setField "body" (renderHtml body) context
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)
-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
prefixedId :: WriterOptions -> String -> Attribute prefixedId :: WriterOptions -> String -> Attribute

View file

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
{- {-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu> Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
@ -81,7 +81,7 @@ writeLaTeX options document =
stInternalLinks = [], stUsesEuro = False } stInternalLinks = [], stUsesEuro = False }
pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String 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 -- see if there are internal links
let isInternalLink (Link _ ('#':xs,_)) = [xs] let isInternalLink (Link _ ('#':xs,_)) = [xs]
isInternalLink _ = [] isInternalLink _ = []
@ -103,9 +103,10 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
let colwidth = if writerWrapText options let colwidth = if writerWrapText options
then Just $ writerColumns options then Just $ writerColumns options
else Nothing else Nothing
titletext <- liftM (render colwidth) $ inlineListToLaTeX title metadata <- metaToJSON
authorsText <- mapM (liftM (render colwidth) . inlineListToLaTeX) authors (fmap (render colwidth) . blockListToLaTeX)
dateText <- liftM (render colwidth) $ inlineListToLaTeX date (fmap (render colwidth) . inlineListToLaTeX)
meta
let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then let (blocks', lastHeader) = if writerCiteMethod options == Citeproc then
(blocks, []) (blocks, [])
else case last blocks of else case last blocks of
@ -115,55 +116,52 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
then toSlides blocks' then toSlides blocks'
else return blocks' else return blocks'
body <- mapM (elementToLaTeX options) $ hierarchicalize 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 let main = render colwidth $ vsep body
st <- get st <- get
let biblioFiles = intercalate "," $ map dropExtension $ writerBiblioFiles options let biblioFiles = intercalate "," $ map dropExtension $ writerBiblioFiles options
citecontext = case writerCiteMethod options of let context = setField "toc" (writerTableOfContents options) $
Natbib -> [ ("biblio-files", biblioFiles) setField "toc-depth" (show (writerTOCDepth options -
, ("biblio-title", biblioTitle) if writerChapters options
, ("natbib", "yes") then 1
] else 0)) $
Biblatex -> [ ("biblio-files", biblioFiles) setField "body" main $
, ("biblio-title", biblioTitle) setField "title-meta" (stringify $ docTitle meta) $
, ("biblatex", "yes") setField "author-meta" (intercalate "; " $ map stringify $ docAuthors meta) $
] setField "documentclass" (if writerBeamer options
_ -> [] then ("beamer" :: String)
context = writerVariables options ++ else if writerChapters options
[ ("toc", if writerTableOfContents options then "yes" else "") then "book"
, ("toc-depth", show (writerTOCDepth options - else "article") $
if writerChapters options setField "verbatim-in-note" (stVerbInNote st) $
then 1 setField "tables" (stTable st) $
else 0)) setField "strikeout" (stStrikeout st) $
, ("body", main) setField "url" (stUrl st) $
, ("title", titletext) setField "numbersections" (writerNumberSections options) $
, ("title-meta", stringify title) setField "lhs" (stLHS st) $
, ("author-meta", intercalate "; " $ map stringify authors) setField "graphics" (stGraphics st) $
, ("date", dateText) setField "book-class" (stBook st) $
, ("documentclass", if writerBeamer options setField "euro" (stUsesEuro st) $
then "beamer" setField "listings" (writerListings options || stLHS st) $
else if writerChapters options setField "beamer" (writerBeamer options) $
then "book" setField "mainlang" (maybe "" (reverse . takeWhile (/=',') . reverse)
else "article") ] ++ (lookup "lang" $ writerVariables options)) $
[ ("author", a) | a <- authorsText ] ++ (if stHighlighting st
[ ("verbatim-in-note", "yes") | stVerbInNote st ] ++ then setField "highlighting-macros" (styleToLaTeX
[ ("tables", "yes") | stTable st ] ++ $ writerHighlightStyle options )
[ ("strikeout", "yes") | stStrikeout st ] ++ else id) $
[ ("url", "yes") | stUrl st ] ++ (case writerCiteMethod options of
[ ("numbersections", "yes") | writerNumberSections options ] ++ Natbib -> setField "biblio-files" biblioFiles .
[ ("lhs", "yes") | stLHS st ] ++ setField "biblio-title" biblioTitle .
[ ("graphics", "yes") | stGraphics st ] ++ setField "natbib" True
[ ("book-class", "yes") | stBook st] ++ Biblatex -> setField "biblio-files" biblioFiles .
[ ("euro", "yes") | stUsesEuro st] ++ setField "biblio-title" biblioTitle .
[ ("listings", "yes") | writerListings options || stLHS st ] ++ setField "biblatex" True
[ ("beamer", "yes") | writerBeamer options ] ++ _ -> id) $
[ ("mainlang", maybe "" (reverse . takeWhile (/=',') . reverse) foldl (\acc (x,y) -> setField x y acc)
(lookup "lang" $ writerVariables options)) ] ++ metadata (writerVariables options)
[ ("highlighting-macros", styleToLaTeX
$ writerHighlightStyle options ) | stHighlighting st ] ++
citecontext
return $ if writerStandalone options return $ if writerStandalone options
then renderTemplate context template then renderTemplate' template context
else main else main
-- | Convert Elements to LaTeX -- | Convert Elements to LaTeX

View file

@ -37,8 +37,8 @@ import Text.Pandoc.Readers.TeXMath
import Text.Printf ( printf ) import Text.Printf ( printf )
import Data.List ( isPrefixOf, intersperse, intercalate ) import Data.List ( isPrefixOf, intersperse, intercalate )
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import Text.Pandoc.Builder (deleteMeta)
import Control.Monad.State import Control.Monad.State
import qualified Data.Text as T
type Notes = [[Block]] type Notes = [[Block]]
data WriterState = WriterState { stNotes :: Notes data WriterState = WriterState { stNotes :: Notes
@ -50,39 +50,37 @@ writeMan opts document = evalState (pandocToMan opts document) (WriterState [] F
-- | Return groff man representation of document. -- | Return groff man representation of document.
pandocToMan :: WriterOptions -> Pandoc -> State WriterState String pandocToMan :: WriterOptions -> Pandoc -> State WriterState String
pandocToMan opts (Pandoc (Meta title authors date) blocks) = do pandocToMan opts (Pandoc meta blocks) = do
titleText <- inlineListToMan opts title
authors' <- mapM (inlineListToMan opts) authors
date' <- inlineListToMan opts date
let colwidth = if writerWrapText opts let colwidth = if writerWrapText opts
then Just $ writerColumns opts then Just $ writerColumns opts
else Nothing else Nothing
let render' = render colwidth let render' = render colwidth
titleText <- inlineListToMan opts $ docTitle meta
let (cmdName, rest) = break (== ' ') $ render' titleText let (cmdName, rest) = break (== ' ') $ render' titleText
let (title', section) = case reverse cmdName of let (title', section) = case reverse cmdName of
(')':d:'(':xs) | d `elem` ['0'..'9'] -> (')':d:'(':xs) | d `elem` ['0'..'9'] ->
(text (reverse xs), char d) (reverse xs, [d])
xs -> (text (reverse xs), doubleQuotes empty) xs -> (reverse xs, "\"\"")
let description = hsep $ let description = hsep $
map (doubleQuotes . text . trim) $ splitBy (== '|') rest 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 body <- blockListToMan opts blocks
notes <- liftM stNotes get notes <- liftM stNotes get
notes' <- notesToMan opts (reverse notes) notes' <- notesToMan opts (reverse notes)
let main = render' $ body $$ notes' $$ text "" let main = render' $ body $$ notes' $$ text ""
hasTables <- liftM stHasTables get hasTables <- liftM stHasTables get
let context = writerVariables opts ++ let context = setField "body" main
[ ("body", main) $ setField "title" title'
, ("title", render' title') $ setField "section" section
, ("section", render' section) $ setField "description" (render' description)
, ("date", render' date') $ setField "has-tables" hasTables
, ("description", render' description) ] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("has-tables", "yes") | hasTables ] ++ metadata (writerVariables opts)
[ ("author", render' a) | a <- authors' ]
template = case compileTemplate (T.pack $ writerTemplate opts) of
Left e -> error e
Right t -> t
if writerStandalone opts if writerStandalone opts
then return $ renderTemplate template (varListToJSON context) then return $ renderTemplate' (writerTemplate opts) context
else return main else return main
-- | Return man representation of notes. -- | Return man representation of notes.

View file

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, TupleSections #-} {-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables #-}
{- {-
Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu> 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 module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Generic import Text.Pandoc.Generic
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Parsing hiding (blankline, char, space) import Text.Pandoc.Parsing hiding (blankline, char, space)
@ -111,10 +111,10 @@ plainTitleBlock tit auths dat =
-- | Return markdown representation of document. -- | Return markdown representation of document.
pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do pandocToMarkdown opts (Pandoc meta blocks) = do
title' <- inlineListToMarkdown opts title title' <- inlineListToMarkdown opts $ docTitle meta
authors' <- mapM (inlineListToMarkdown opts) authors authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta
date' <- inlineListToMarkdown opts date date' <- inlineListToMarkdown opts $ docDate meta
isPlain <- gets stPlain isPlain <- gets stPlain
let titleblock = case True of let titleblock = case True of
_ | isPlain -> _ | isPlain ->
@ -128,28 +128,33 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
let toc = if writerTableOfContents opts let toc = if writerTableOfContents opts
then tableOfContents opts headerBlocks then tableOfContents opts headerBlocks
else empty 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 body <- blockListToMarkdown opts blocks
st <- get st <- get
notes' <- notesToMarkdown opts (reverse $ stNotes st) notes' <- notesToMarkdown opts (reverse $ stNotes st)
st' <- get -- note that the notes may contain refs st' <- get -- note that the notes may contain refs
refs' <- refsToMarkdown opts (reverse $ stRefs st') refs' <- refsToMarkdown opts (reverse $ stRefs st')
let colwidth = if writerWrapText opts let render' :: Doc -> String
then Just $ writerColumns opts render' = render colwidth
else Nothing let main = render' $ body <>
let main = render colwidth $ body <>
(if isEmpty notes' then empty else blankline <> notes') <> (if isEmpty notes' then empty else blankline <> notes') <>
(if isEmpty refs' then empty else blankline <> refs') (if isEmpty refs' then empty else blankline <> refs')
let context = writerVariables opts ++ let context = setField "toc" (render' toc)
[ ("toc", render colwidth toc) $ setField "body" main
, ("body", main) $ (if not (null (docTitle meta) && null (docAuthors meta)
, ("title", render Nothing title') && null (docDate meta))
, ("date", render Nothing date') then setField "titleblock" (render' titleblock)
] ++ else id)
[ ("author", render Nothing a) | a <- authors' ] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("titleblock", render colwidth titleblock) metadata (writerVariables opts)
| not (null title && null authors && null date) ]
if writerStandalone opts if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts then return $ renderTemplate' (writerTemplate opts) context
else return main else return main
-- | Return markdown representation of reference key table. -- | Return markdown representation of reference key table.
@ -370,7 +375,7 @@ blockToMarkdown opts t@(Table caption aligns widths headers rows) = do
rawHeaders rawRows rawHeaders rawRows
| otherwise -> fmap (id,) $ | otherwise -> fmap (id,) $
return $ text $ writeHtmlString def return $ text $ writeHtmlString def
$ Pandoc (Meta [] [] []) [t] $ Pandoc nullMeta [t]
return $ nst $ tbl $$ blankline $$ caption'' $$ blankline return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
blockToMarkdown opts (BulletList items) = do blockToMarkdown opts (BulletList items) = do
contents <- mapM (bulletListItemToMarkdown opts) items contents <- mapM (bulletListItemToMarkdown opts) items

View file

@ -33,7 +33,7 @@ module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.XML ( escapeStringForXML ) import Text.Pandoc.XML ( escapeStringForXML )
import Data.List ( intersect, intercalate ) import Data.List ( intersect, intercalate )
import Network.URI ( isURI ) import Network.URI ( isURI )
@ -53,18 +53,23 @@ writeMediaWiki opts document =
-- | Return MediaWiki representation of document. -- | Return MediaWiki representation of document.
pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String 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 body <- blockListToMediaWiki opts blocks
notesExist <- get >>= return . stNotes notesExist <- get >>= return . stNotes
let notes = if notesExist let notes = if notesExist
then "\n<references />" then "\n<references />"
else "" else ""
let main = body ++ notes let main = body ++ notes
let context = writerVariables opts ++ let context = setField "body" main
[ ("body", main) ] ++ $ setField "toc" (writerTableOfContents opts)
[ ("toc", "yes") | writerTableOfContents opts ] $ foldl (\acc (x,y) -> setField x y acc)
metadata (writerVariables opts)
if writerStandalone opts if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts then return $ renderTemplate' (writerTemplate opts) context
else return main else return main
-- | Escape special characters for MediaWiki. -- | Escape special characters for MediaWiki.

View file

@ -72,7 +72,7 @@ writeNative opts (Pandoc meta blocks) =
then Just $ writerColumns opts then Just $ writerColumns opts
else Nothing else Nothing
withHead = if writerStandalone opts withHead = if writerStandalone opts
then \bs -> text ("Pandoc " ++ "(" ++ show meta ++ ")") $$ then \bs -> text ("Pandoc (" ++ show meta ++ ") ") $$
bs $$ cr bs $$ cr
else id else id
in render colwidth $ withHead $ prettyList $ map prettyBlock blocks in render colwidth $ withHead $ prettyList $ map prettyBlock blocks

View file

@ -53,8 +53,9 @@ import System.FilePath ( takeExtension )
writeODT :: WriterOptions -- ^ Writer options writeODT :: WriterOptions -- ^ Writer options
-> Pandoc -- ^ Document to convert -> Pandoc -- ^ Document to convert
-> IO B.ByteString -> IO B.ByteString
writeODT opts doc@(Pandoc (Meta title _ _) _) = do writeODT opts doc@(Pandoc meta _) = do
let datadir = writerUserDataDir opts let datadir = writerUserDataDir opts
let title = docTitle meta
refArchive <- liftM toArchive $ refArchive <- liftM toArchive $
case writerReferenceODT opts of case writerReferenceODT opts of
Just f -> B.readFile f Just f -> B.readFile f

View file

@ -32,37 +32,38 @@ import Text.Pandoc.Definition
import Text.Pandoc.XML import Text.Pandoc.XML
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Writers.HTML (writeHtmlString) import Text.Pandoc.Writers.HTML (writeHtmlString)
import Text.Pandoc.Writers.Markdown (writeMarkdown) import Text.Pandoc.Writers.Markdown (writeMarkdown)
import Data.List ( intercalate )
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import Data.Time import Data.Time
import System.Locale (defaultTimeLocale) import System.Locale (defaultTimeLocale)
import qualified Text.Pandoc.Builder as B
-- | Convert Pandoc document to string in OPML format. -- | Convert Pandoc document to string in OPML format.
writeOPML :: WriterOptions -> Pandoc -> String writeOPML :: WriterOptions -> Pandoc -> String
writeOPML opts (Pandoc (Meta tit auths dat) blocks) = writeOPML opts (Pandoc meta blocks) =
let title = writeHtmlInlines tit let elements = hierarchicalize blocks
author = writeHtmlInlines $ intercalate [Space,Str ";",Space] auths
date = convertDate dat
elements = hierarchicalize blocks
colwidth = if writerWrapText opts colwidth = if writerWrapText opts
then Just $ writerColumns opts then Just $ writerColumns opts
else Nothing 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) main = render colwidth $ vcat (map (elementToOPML opts) elements)
context = writerVariables opts ++ context = setField "body" main
[ ("body", main) $ foldl (\acc (x,y) -> setField x y acc)
, ("title", title) metadata (writerVariables opts)
, ("date", date)
, ("author", author) ]
in if writerStandalone opts in if writerStandalone opts
then renderTemplate context $ writerTemplate opts then renderTemplate' (writerTemplate opts) context
else main else main
writeHtmlInlines :: [Inline] -> String writeHtmlInlines :: [Inline] -> String
writeHtmlInlines ils = trim $ writeHtmlString def 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 -- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT
showDateTimeRFC822 :: UTCTime -> String showDateTimeRFC822 :: UTCTime -> String
@ -82,7 +83,7 @@ elementToOPML opts (Sec _ _num _ title elements) =
fromBlk _ = error "fromBlk called on non-block" fromBlk _ = error "fromBlk called on non-block"
(blocks, rest) = span isBlk elements (blocks, rest) = span isBlk elements
attrs = [("text", writeHtmlInlines title)] ++ attrs = [("text", writeHtmlInlines title)] ++
[("_note", writeMarkdown def (Pandoc (Meta [] [] []) [("_note", writeMarkdown def (Pandoc nullMeta
(map fromBlk blocks))) (map fromBlk blocks)))
| not (null blocks)] | not (null blocks)]
in inTags True "outline" attrs $ in inTags True "outline" attrs $

View file

@ -33,7 +33,7 @@ module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.XML import Text.Pandoc.XML
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import Text.Printf ( printf ) import Text.Printf ( printf )
@ -42,6 +42,7 @@ import Control.Arrow ( (***), (>>>) )
import Control.Monad.State hiding ( when ) import Control.Monad.State hiding ( when )
import Data.Char (chr, isDigit) import Data.Char (chr, isDigit)
import qualified Data.Map as Map import qualified Data.Map as Map
import Text.Pandoc.Shared (metaToJSON, setField)
-- | Auxiliary function to convert Plain block to Para. -- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block plainToPara :: Block -> Block
@ -172,34 +173,32 @@ handleSpaces s
-- | Convert Pandoc document to string in OpenDocument format. -- | Convert Pandoc document to string in OpenDocument format.
writeOpenDocument :: WriterOptions -> Pandoc -> String writeOpenDocument :: WriterOptions -> Pandoc -> String
writeOpenDocument opts (Pandoc (Meta title authors date) blocks) = writeOpenDocument opts (Pandoc meta blocks) =
let ((doc, title', authors', date'),s) = flip runState let colwidth = if writerWrapText opts
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
then Just $ writerColumns opts then Just $ writerColumns opts
else Nothing else Nothing
render' = render colwidth 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 styles = stTableStyles s ++ stParaStyles s ++ stTextStyles s
listStyle (n,l) = inTags True "text:list-style" listStyle (n,l) = inTags True "text:list-style"
[("style:name", "L" ++ show n)] (vcat l) [("style:name", "L" ++ show n)] (vcat l)
listStyles = map listStyle (stListStyles s) listStyles = map listStyle (stListStyles s)
automaticStyles = inTagsIndented "office:automatic-styles" $ vcat $ automaticStyles = inTagsIndented "office:automatic-styles" $ vcat $
reverse $ styles ++ listStyles reverse $ styles ++ listStyles
context = writerVariables opts ++ context = setField "body" body
[ ("body", body') $ setField "automatic-styles" (render' automaticStyles)
, ("automatic-styles", render' automaticStyles) $ foldl (\acc (x,y) -> setField x y acc)
, ("title", render' title') metadata (writerVariables opts)
, ("date", render' date') ] ++
[ ("author", render' a) | a <- authors' ]
in if writerStandalone opts in if writerStandalone opts
then renderTemplate context $ writerTemplate opts then renderTemplate' (writerTemplate opts) context
else body' else body
withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
withParagraphStyle o s (b:bs) withParagraphStyle o s (b:bs)

View file

@ -35,7 +35,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Data.List ( intersect, intersperse, transpose ) import Data.List ( intersect, intersperse, transpose )
import Control.Monad.State import Control.Monad.State
import Control.Applicative ( (<$>) ) import Control.Applicative ( (<$>) )
@ -58,27 +58,26 @@ writeOrg opts document =
-- | Return Org representation of document. -- | Return Org representation of document.
pandocToOrg :: Pandoc -> State WriterState String pandocToOrg :: Pandoc -> State WriterState String
pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do pandocToOrg (Pandoc meta blocks) = do
opts <- liftM stOptions get opts <- liftM stOptions get
title <- titleToOrg tit let colwidth = if writerWrapText opts
authors <- mapM inlineListToOrg auth then Just $ writerColumns opts
date <- inlineListToOrg dat else Nothing
metadata <- metaToJSON
(fmap (render colwidth) . blockListToOrg)
(fmap (render colwidth) . inlineListToOrg)
meta
body <- blockListToOrg blocks body <- blockListToOrg blocks
notes <- liftM (reverse . stNotes) get >>= notesToOrg notes <- liftM (reverse . stNotes) get >>= notesToOrg
-- note that the notes may contain refs, so we do them first -- note that the notes may contain refs, so we do them first
hasMath <- liftM stHasMath get hasMath <- liftM stHasMath get
let colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
let main = render colwidth $ foldl ($+$) empty $ [body, notes] let main = render colwidth $ foldl ($+$) empty $ [body, notes]
let context = writerVariables opts ++ let context = setField "body" main
[ ("body", main) $ setField "math" hasMath
, ("title", render Nothing title) $ foldl (\acc (x,y) -> setField x y acc)
, ("date", render Nothing date) ] ++ metadata (writerVariables opts)
[ ("math", "yes") | hasMath ] ++
[ ("author", render Nothing a) | a <- authors ]
if writerStandalone opts if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts then return $ renderTemplate' (writerTemplate opts) context
else return main else return main
-- | Return Org representation of notes. -- | Return Org representation of notes.
@ -103,12 +102,6 @@ escapeString = escapeStringUsing $
, ('\x2026',"...") , ('\x2026',"...")
] ++ backslashEscapes "^_" ] ++ backslashEscapes "^_"
titleToOrg :: [Inline] -> State WriterState Doc
titleToOrg [] = return empty
titleToOrg lst = do
contents <- inlineListToOrg lst
return $ "#+TITLE: " <> contents
-- | Convert Pandoc block element to Org. -- | Convert Pandoc block element to Org.
blockToOrg :: Block -- ^ Block element blockToOrg :: Block -- ^ Block element
-> State WriterState Doc -> State WriterState Doc

View file

@ -30,11 +30,12 @@ Conversion of 'Pandoc' documents to reStructuredText.
reStructuredText: <http://docutils.sourceforge.net/rst.html> 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.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Shared 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 Data.List ( isPrefixOf, intersperse, transpose )
import Network.URI (isAbsoluteURI) import Network.URI (isAbsoluteURI)
import Text.Pandoc.Pretty import Text.Pandoc.Pretty
@ -62,31 +63,35 @@ writeRST opts document =
-- | Return RST representation of document. -- | Return RST representation of document.
pandocToRST :: Pandoc -> State WriterState String pandocToRST :: Pandoc -> State WriterState String
pandocToRST (Pandoc (Meta tit auth dat) blocks) = do pandocToRST (Pandoc meta blocks) = do
opts <- liftM stOptions get opts <- liftM stOptions get
title <- titleToRST tit let colwidth = if writerWrapText opts
authors <- mapM inlineListToRST auth then Just $ writerColumns opts
date <- inlineListToRST dat 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 body <- blockListToRST blocks
notes <- liftM (reverse . stNotes) get >>= notesToRST notes <- liftM (reverse . stNotes) get >>= notesToRST
-- note that the notes may contain refs, so we do them first -- note that the notes may contain refs, so we do them first
refs <- liftM (reverse . stLinks) get >>= refsToRST refs <- liftM (reverse . stLinks) get >>= refsToRST
pics <- liftM (reverse . stImages) get >>= pictRefsToRST pics <- liftM (reverse . stImages) get >>= pictRefsToRST
hasMath <- liftM stHasMath get 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 main = render colwidth $ foldl ($+$) empty $ [body, notes, refs, pics]
let context = writerVariables opts ++ let context = setField "body" main
[ ("body", main) $ setField "toc" (writerTableOfContents opts)
, ("title", render Nothing title) $ setField "toc-depth" (writerTOCDepth opts)
, ("date", render colwidth date) $ setField "math" hasMath
, ("toc", if writerTableOfContents opts then "yes" else "") $ setField "title" (render Nothing title :: String)
, ("toc-depth", show (writerTOCDepth opts)) ] ++ $ setField "math" hasMath
[ ("math", "yes") | hasMath ] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("author", render colwidth a) | a <- authors ] metadata (writerVariables opts)
if writerStandalone opts if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts then return $ renderTemplate' (writerTemplate opts) context
else return main else return main
-- | Return RST representation of reference key table. -- | Return RST representation of reference key table.
@ -136,13 +141,20 @@ pictToRST (label, (src, _, mbtarget)) = do
escapeString :: String -> String escapeString :: String -> String
escapeString = escapeStringUsing (backslashEscapes "`\\|*_") escapeString = escapeStringUsing (backslashEscapes "`\\|*_")
titleToRST :: [Inline] -> State WriterState Doc titleToRST :: [Inline] -> [Inline] -> State WriterState Doc
titleToRST [] = return empty titleToRST [] _ = return empty
titleToRST lst = do titleToRST tit subtit = do
contents <- inlineListToRST lst title <- inlineListToRST tit
let titleLength = length $ (render Nothing contents :: String) subtitle <- inlineListToRST subtit
let border = text (replicate titleLength '=') return $ bordered title '=' $$ bordered subtitle '-'
return $ border $$ contents $$ border
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. -- | Convert Pandoc block element to RST.
blockToRST :: Block -- ^ Block element blockToRST :: Block -- ^ Block element

View file

@ -32,7 +32,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Generic (bottomUpM) import Text.Pandoc.Generic (bottomUpM)
import Data.List ( isSuffixOf, intercalate ) import Data.List ( isSuffixOf, intercalate )
import Data.Char ( ord, chr, isDigit, toLower ) import Data.Char ( ord, chr, isDigit, toLower )
@ -73,24 +73,22 @@ writeRTFWithEmbeddedImages options doc =
-- | Convert Pandoc to a string in rich text format. -- | Convert Pandoc to a string in rich text format.
writeRTF :: WriterOptions -> Pandoc -> String writeRTF :: WriterOptions -> Pandoc -> String
writeRTF options (Pandoc (Meta title authors date) blocks) = writeRTF options (Pandoc meta blocks) =
let titletext = inlineListToRTF title let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta
authorstext = map inlineListToRTF authors Just metadata = metaToJSON
datetext = inlineListToRTF date (Just . concatMap (blockToRTF 0 AlignDefault))
spacer = not $ all null $ titletext : datetext : authorstext (Just . inlineListToRTF)
meta
body = concatMap (blockToRTF 0 AlignDefault) blocks body = concatMap (blockToRTF 0 AlignDefault) blocks
isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options
isTOCHeader _ = False isTOCHeader _ = False
context = writerVariables options ++ context = setField "body" body
[ ("body", body) $ setField "spacer" spacer
, ("title", titletext) $ setField "toc" (tableOfContents $ filter isTOCHeader blocks)
, ("date", datetext) ] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("author", a) | a <- authorstext ] ++ metadata (writerVariables options)
[ ("spacer", "yes") | spacer ] ++
[ ("toc", tableOfContents $ filter isTOCHeader blocks) |
writerTableOfContents options ]
in if writerStandalone options in if writerStandalone options
then renderTemplate context $ writerTemplate options then renderTemplate' (writerTemplate options) context
else body else body
-- | Construct table of contents from list of header blocks. -- | Construct table of contents from list of header blocks.

View file

@ -31,7 +31,7 @@ module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Printf ( printf ) import Text.Printf ( printf )
import Data.List ( transpose, maximumBy ) import Data.List ( transpose, maximumBy )
import Data.Ord ( comparing ) import Data.Ord ( comparing )
@ -63,33 +63,33 @@ writeTexinfo options document =
-- | Add a "Top" node around the document, needed by Texinfo. -- | Add a "Top" node around the document, needed by Texinfo.
wrapTop :: Pandoc -> Pandoc wrapTop :: Pandoc -> Pandoc
wrapTop (Pandoc (Meta title authors date) blocks) = wrapTop (Pandoc meta blocks) =
Pandoc (Meta title authors date) (Header 0 nullAttr title : blocks) Pandoc meta (Header 0 nullAttr (docTitle meta) : blocks)
pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String
pandocToTexinfo options (Pandoc (Meta title authors date) blocks) = do pandocToTexinfo options (Pandoc meta blocks) = do
titleText <- inlineListToTexinfo title let titlePage = not $ all null
authorsText <- mapM inlineListToTexinfo authors $ docTitle meta : docDate meta : docAuthors meta
dateText <- inlineListToTexinfo date
let titlePage = not $ all null $ title : date : authors
main <- blockListToTexinfo blocks
st <- get
let colwidth = if writerWrapText options let colwidth = if writerWrapText options
then Just $ writerColumns options then Just $ writerColumns options
else Nothing else Nothing
metadata <- metaToJSON
(fmap (render colwidth) . blockListToTexinfo)
(fmap (render colwidth) . inlineListToTexinfo)
meta
main <- blockListToTexinfo blocks
st <- get
let body = render colwidth main let body = render colwidth main
let context = writerVariables options ++ let context = setField "body" body
[ ("body", body) $ setField "toc" (writerTableOfContents options)
, ("title", render colwidth titleText) $ setField "titlepage" titlePage
, ("date", render colwidth dateText) ] ++ $ setField "subscript" (stSubscript st)
[ ("toc", "yes") | writerTableOfContents options ] ++ $ setField "superscript" (stSuperscript st)
[ ("titlepage", "yes") | titlePage ] ++ $ setField "strikeout" (stStrikeout st)
[ ("subscript", "yes") | stSubscript st ] ++ $ foldl (\acc (x,y) -> setField x y acc)
[ ("superscript", "yes") | stSuperscript st ] ++ metadata (writerVariables options)
[ ("strikeout", "yes") | stStrikeout st ] ++
[ ("author", render colwidth a) | a <- authorsText ]
if writerStandalone options if writerStandalone options
then return $ renderTemplate context $ writerTemplate options then return $ renderTemplate' (writerTemplate options) context
else return body else return body
-- | Escape things as needed for Texinfo. -- | Escape things as needed for Texinfo.

View file

@ -33,7 +33,7 @@ module Text.Pandoc.Writers.Textile ( writeTextile ) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Options import Text.Pandoc.Options
import Text.Pandoc.Shared import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.XML ( escapeStringForXML ) import Text.Pandoc.XML ( escapeStringForXML )
import Data.List ( intercalate ) import Data.List ( intercalate )
import Control.Monad.State import Control.Monad.State
@ -53,13 +53,17 @@ writeTextile opts document =
-- | Return Textile representation of document. -- | Return Textile representation of document.
pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String 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 body <- blockListToTextile opts blocks
notes <- liftM (unlines . reverse . stNotes) get notes <- liftM (unlines . reverse . stNotes) get
let main = body ++ if null notes then "" else ("\n\n" ++ notes) 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 if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts then return $ renderTemplate' (writerTemplate opts) context
else return main else return main
withUseTags :: State WriterState a -> State WriterState a withUseTags :: State WriterState a -> State WriterState a

View file

@ -27,8 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Functions for escaping and formatting XML. Functions for escaping and formatting XML.
-} -}
module Text.Pandoc.XML ( stripTags, module Text.Pandoc.XML ( escapeCharForXML,
escapeCharForXML,
escapeStringForXML, escapeStringForXML,
inTags, inTags,
selfClosingTag, selfClosingTag,
@ -41,16 +40,6 @@ import Text.Pandoc.Pretty
import Data.Char (ord, isAscii, isSpace) import Data.Char (ord, isAscii, isSpace)
import Text.HTML.TagSoup.Entity (lookupEntity) 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. -- | Escape one character as needed for XML.
escapeCharForXML :: Char -> String escapeCharForXML :: Char -> String
escapeCharForXML x = case x of escapeCharForXML x = case x of

View file

@ -150,10 +150,13 @@ instance Arbitrary QuoteType where
instance Arbitrary Meta where instance Arbitrary Meta where
arbitrary arbitrary
= do x1 <- arbitrary = do (x1 :: Inlines) <- arbitrary
x2 <- liftM (filter (not . null)) arbitrary (x2 :: [Inlines]) <- liftM (filter (not . isNull)) arbitrary
x3 <- arbitrary (x3 :: Inlines) <- arbitrary
return (Meta x1 x2 x3) return $ setMeta "title" x1
$ setMeta "author" x2
$ setMeta "date" x3
$ nullMeta
instance Arbitrary Alignment where instance Arbitrary Alignment where
arbitrary arbitrary

View file

@ -20,6 +20,7 @@ import Text.Pandoc.Options
import Text.Pandoc.Writers.Native (writeNative) import Text.Pandoc.Writers.Native (writeNative)
import qualified Test.QuickCheck.Property as QP import qualified Test.QuickCheck.Property as QP
import Data.Algorithm.Diff import Data.Algorithm.Diff
import qualified Data.Map as M
test :: (ToString a, ToString b, ToString c) test :: (ToString a, ToString b, ToString c)
=> (a -> b) -- ^ function to test => (a -> b) -- ^ function to test
@ -58,8 +59,9 @@ class ToString a where
instance ToString Pandoc where instance ToString Pandoc where
toString d = writeNative def{ writerStandalone = s } $ toPandoc d toString d = writeNative def{ writerStandalone = s } $ toPandoc d
where s = case d of where s = case d of
(Pandoc (Meta [] [] []) _) -> False (Pandoc (Meta m) _)
_ -> True | M.null m -> False
| otherwise -> True
instance ToString Blocks where instance ToString Blocks where
toString = writeNative def . toPandoc toString = writeNative def . toPandoc

View file

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Tests.Readers.RST (tests) where module Tests.Readers.RST (tests) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
@ -7,9 +7,10 @@ import Tests.Helpers
import Tests.Arbitrary() import Tests.Arbitrary()
import Text.Pandoc.Builder import Text.Pandoc.Builder
import Text.Pandoc import Text.Pandoc
import Data.Monoid (mempty)
rst :: String -> Pandoc rst :: String -> Pandoc
rst = readRST def rst = readRST def{ readerStandalone = True }
infix 4 =: infix 4 =:
(=:) :: ToString c (=:) :: ToString c
@ -21,14 +22,12 @@ tests = [ "line block with blank line" =:
"| a\n|\n| b" =?> para (str "a") <> "| a\n|\n| b" =?> para (str "a") <>
para (str "\160b") para (str "\160b")
, "field list" =: unlines , "field list" =: unlines
[ ":Hostname: media08" [ "para"
, ""
, ":Hostname: media08"
, ":IP address: 10.0.0.19" , ":IP address: 10.0.0.19"
, ":Size: 3ru" , ":Size: 3ru"
, ":Date: 2001-08-16"
, ":Version: 1" , ":Version: 1"
, ":Authors: - Me"
, " - Myself"
, " - I"
, ":Indentation: Since the field marker may be quite long, the second" , ":Indentation: Since the field marker may be quite long, the second"
, " and subsequent lines of the field body do not have to line up" , " 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" , " 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" , ":Parameter i: integer"
, ":Final: item" , ":Final: item"
, " on two lines" ] , " on two lines" ]
=?> ( setAuthors ["Me","Myself","I"] =?> ( doc
$ setDate "2001-08-16" $ para "para" <>
$ doc definitionList [ (str "Hostname", [para "media08"])
$ definitionList [ (str "Hostname", [para "media08"])
, (str "IP address", [para "10.0.0.19"]) , (str "IP address", [para "10.0.0.19"])
, (str "Size", [para "3ru"]) , (str "Size", [para "3ru"])
, (str "Version", [para "1"]) , (str "Version", [para "1"])
@ -47,6 +45,20 @@ tests = [ "line block with blank line" =:
, (str "Parameter i", [para "integer"]) , (str "Parameter i", [para "integer"])
, (str "Final", [para "item on two lines"]) , (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" =: , "URLs with following punctuation" =:
("http://google.com, http://yahoo.com; http://foo.bar.baz.\n" ++ ("http://google.com, http://yahoo.com; http://foo.bar.baz.\n" ++
"http://foo.bar/baz_(bam) (http://foo.bar)") =?> "http://foo.bar/baz_(bam) (http://foo.bar)") =?>

View file

@ -12,7 +12,7 @@ p_write_rt d =
p_write_blocks_rt :: [Block] -> Bool p_write_blocks_rt :: [Block] -> Bool
p_write_blocks_rt bs = length bs > 20 || p_write_blocks_rt bs = length bs > 20 ||
read (writeNative def (Pandoc (Meta [] [] []) bs)) == read (writeNative def (Pandoc nullMeta bs)) ==
bs bs
tests :: [Test] tests :: [Test]

View file

@ -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."] [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 ,HorizontalRule
,Header 1 ("headers",[],[]) [Str "Headers"] ,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."]]]] [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) ,OrderedList (1,Decimal,Period)
[[Plain [Str "And",Space,Str "in",Space,Str "list",Space,Str "items.",Note [Para [Str "In",Space,Str "list."]]]]] [[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."]]}