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:
parent
e32a8f5981
commit
f869f7e08d
40 changed files with 671 additions and 545 deletions
|
@ -1 +1 @@
|
||||||
Subproject commit 05719b6491d26aa0fcb6a7de64aeebfc75955267
|
Subproject commit 050ea0fa8dc51d1e722f8e88b7ce9a792474082f
|
|
@ -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,
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 = [],
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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'
|
||||||
|
|
||||||
|
|
|
@ -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 '.')
|
||||||
|
|
|
@ -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
|
||||||
--
|
--
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 $
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)") =?>
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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."]]}
|
||||||
|
|
Loading…
Add table
Reference in a new issue