Markdown writer: Don't include variables in metadata.

This commit is contained in:
John MacFarlane 2013-07-01 12:48:13 -07:00
parent 5d01e9a117
commit 0ec8573347
2 changed files with 41 additions and 35 deletions

View file

@ -46,10 +46,8 @@ import Text.Pandoc.Readers.TeXMath (readTeXMath)
import Text.HTML.TagSoup (renderTags, parseTags, isTagText, Tag(..)) import Text.HTML.TagSoup (renderTags, parseTags, isTagText, Tag(..))
import Network.URI (isAbsoluteURI) import Network.URI (isAbsoluteURI)
import Data.Default import Data.Default
import Data.Yaml (Value(Object,String,Array,Bool,Number)) import qualified Data.Map as M
import qualified Data.HashMap.Strict as H import Control.Applicative ((<$>))
import qualified Data.Vector as V
import qualified Data.Text as T
type Notes = [[Block]] type Notes = [[Block]]
type Refs = [([Inline], Target)] type Refs = [([Inline], Target)]
@ -113,21 +111,34 @@ plainTitleBlock tit auths dat =
(hcat (intersperse (text "; ") auths)) <> cr <> (hcat (intersperse (text "; ") auths)) <> cr <>
dat <> cr dat <> cr
yamlTitleBlock :: Value -> Doc yamlTitleBlock :: WriterOptions -> Meta -> State WriterState Doc
yamlTitleBlock v = "---" $$ (jsonToYaml v) $$ "..." yamlTitleBlock opts (Meta metamap) = do
m <- jsonToYaml opts (MetaMap metamap)
return $ "---" $$ m $$ "..."
jsonToYaml :: Value -> Doc jsonToYaml :: WriterOptions -> MetaValue -> State WriterState Doc
jsonToYaml (Object hashmap) = jsonToYaml opts (MetaMap metamap) = vcat
vcat (map (\(k,v) -> <$> mapM (\(k,v) -> ((text k <> ":") <>) <$>
text (T.unpack k) <> ":" <> space <> jsonToYaml v) $ H.toList hashmap) case v of
jsonToYaml (Array vec) = (MetaList _) -> (cr <>) <$> jsonToYaml opts v
cr <> vcat (map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec) (MetaMap _) -> ((cr <>) . nest 2) <$> jsonToYaml opts v
jsonToYaml (String s) _ -> (space <> ) <$> jsonToYaml opts v)
| "\n" `T.isInfixOf` s = hang 2 ("|" <> cr) $ text $ T.unpack s (M.toList metamap)
| otherwise = text $ "'" ++ substitute "'" "''" (T.unpack s) ++ "'" jsonToYaml opts (MetaList xs) = vcat
jsonToYaml (Bool b) = text $ show b <$> mapM (\v -> hang 2 "- " <$> (jsonToYaml opts v)) xs
jsonToYaml (Number n) = text $ show n jsonToYaml _ (MetaString s)
jsonToYaml _ = empty | '\n' `elem` s = return $ hang 2 ("|" <> cr) $ text s
| otherwise = return $ text $ "'" ++ substitute "'" "''" s ++ "'"
jsonToYaml opts (MetaInlines ils) =
inlineListToMarkdown opts ils >>= jsonToYaml opts . MetaString . render' opts
jsonToYaml opts (MetaBlocks bs) =
blockListToMarkdown opts bs >>= jsonToYaml opts . MetaString . render' opts
render' :: WriterOptions -> Doc -> String
render' opts = render colwidth
where colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
-- | Return markdown representation of document. -- | Return markdown representation of document.
pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
@ -135,25 +146,22 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
title' <- inlineListToMarkdown opts $ docTitle meta title' <- inlineListToMarkdown opts $ docTitle meta
authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta
date' <- inlineListToMarkdown opts $ docDate meta date' <- inlineListToMarkdown opts $ docDate meta
let colwidth = if writerWrapText opts
then Just $ writerColumns opts
else Nothing
metadata <- metaToJSON metadata <- metaToJSON
(fmap (render colwidth) . blockListToMarkdown opts) (fmap (render' opts) . blockListToMarkdown opts)
(fmap (render colwidth) . inlineListToMarkdown opts) (fmap (render' opts) . inlineListToMarkdown opts)
(writerVariables opts) (writerVariables opts)
meta meta
isPlain <- gets stPlain isPlain <- gets stPlain
let titleblock = case True of titleblock <- case True of
_ | isPlain -> _ | isPlain ->
plainTitleBlock title' authors' date' return $ plainTitleBlock title' authors' date'
| isEnabled Ext_yaml_title_block opts -> | isEnabled Ext_yaml_title_block opts ->
yamlTitleBlock metadata yamlTitleBlock opts meta
| isEnabled Ext_pandoc_title_block opts -> | isEnabled Ext_pandoc_title_block opts ->
pandocTitleBlock title' authors' date' return $ pandocTitleBlock title' authors' date'
| isEnabled Ext_mmd_title_block opts -> | isEnabled Ext_mmd_title_block opts ->
mmdTitleBlock title' authors' date' return $ mmdTitleBlock title' authors' date'
| otherwise -> empty | otherwise -> return empty
let headerBlocks = filter isHeaderBlock blocks let headerBlocks = filter isHeaderBlock blocks
let toc = if writerTableOfContents opts let toc = if writerTableOfContents opts
then tableOfContents opts headerBlocks then tableOfContents opts headerBlocks
@ -163,16 +171,14 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
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 render' :: Doc -> String let main = render' opts $ body <>
render' = render colwidth
let main = render' $ 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 = defField "toc" (render' toc) let context = defField "toc" (render' opts toc)
$ defField "body" main $ defField "body" main
$ (if not (null (docTitle meta) && null (docAuthors meta) $ (if not (null (docTitle meta) && null (docAuthors meta)
&& null (docDate meta)) && null (docDate meta))
then defField "titleblock" (render' titleblock) then defField "titleblock" (render' opts titleblock)
else id) else id)
$ metadata $ metadata
if writerStandalone opts if writerStandalone opts

View file

@ -1,9 +1,9 @@
--- ---
title: 'Pandoc Test Suite'
author: author:
- 'John MacFarlane' - 'John MacFarlane'
- 'Anonymous' - 'Anonymous'
date: 'July 17, 2006' date: 'July 17, 2006'
title: 'Pandoc Test Suite'
... ...
This is a set of tests for pandoc. Most of them are adapted from John Grubers This is a set of tests for pandoc. Most of them are adapted from John Grubers