aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2013-07-01 12:48:13 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2013-07-01 12:48:13 -0700
commit0ec8573347d53e0cba70552a50dba697f39216b6 (patch)
treef692b5eccfce347b4e82264e12e5649c0e81c7a6
parent5d01e9a117b77a0f51ce67d495b9e54881a878a5 (diff)
downloadpandoc-0ec8573347d53e0cba70552a50dba697f39216b6.tar.gz
Markdown writer: Don't include variables in metadata.
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs76
-rw-r--r--tests/writer.markdown2
2 files changed, 42 insertions, 36 deletions
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index d8ac99685..e464d63b5 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -46,10 +46,8 @@ import Text.Pandoc.Readers.TeXMath (readTeXMath)
import Text.HTML.TagSoup (renderTags, parseTags, isTagText, Tag(..))
import Network.URI (isAbsoluteURI)
import Data.Default
-import Data.Yaml (Value(Object,String,Array,Bool,Number))
-import qualified Data.HashMap.Strict as H
-import qualified Data.Vector as V
-import qualified Data.Text as T
+import qualified Data.Map as M
+import Control.Applicative ((<$>))
type Notes = [[Block]]
type Refs = [([Inline], Target)]
@@ -113,21 +111,34 @@ plainTitleBlock tit auths dat =
(hcat (intersperse (text "; ") auths)) <> cr <>
dat <> cr
-yamlTitleBlock :: Value -> Doc
-yamlTitleBlock v = "---" $$ (jsonToYaml v) $$ "..."
-
-jsonToYaml :: Value -> Doc
-jsonToYaml (Object hashmap) =
- vcat (map (\(k,v) ->
- text (T.unpack k) <> ":" <> space <> jsonToYaml v) $ H.toList hashmap)
-jsonToYaml (Array vec) =
- cr <> vcat (map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec)
-jsonToYaml (String s)
- | "\n" `T.isInfixOf` s = hang 2 ("|" <> cr) $ text $ T.unpack s
- | otherwise = text $ "'" ++ substitute "'" "''" (T.unpack s) ++ "'"
-jsonToYaml (Bool b) = text $ show b
-jsonToYaml (Number n) = text $ show n
-jsonToYaml _ = empty
+yamlTitleBlock :: WriterOptions -> Meta -> State WriterState Doc
+yamlTitleBlock opts (Meta metamap) = do
+ m <- jsonToYaml opts (MetaMap metamap)
+ return $ "---" $$ m $$ "..."
+
+jsonToYaml :: WriterOptions -> MetaValue -> State WriterState Doc
+jsonToYaml opts (MetaMap metamap) = vcat
+ <$> mapM (\(k,v) -> ((text k <> ":") <>) <$>
+ case v of
+ (MetaList _) -> (cr <>) <$> jsonToYaml opts v
+ (MetaMap _) -> ((cr <>) . nest 2) <$> jsonToYaml opts v
+ _ -> (space <> ) <$> jsonToYaml opts v)
+ (M.toList metamap)
+jsonToYaml opts (MetaList xs) = vcat
+ <$> mapM (\v -> hang 2 "- " <$> (jsonToYaml opts v)) xs
+jsonToYaml _ (MetaString s)
+ | '\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.
pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
@@ -135,25 +146,22 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
title' <- inlineListToMarkdown opts $ docTitle meta
authors' <- mapM (inlineListToMarkdown opts) $ docAuthors meta
date' <- inlineListToMarkdown opts $ docDate meta
- let colwidth = if writerWrapText opts
- then Just $ writerColumns opts
- else Nothing
metadata <- metaToJSON
- (fmap (render colwidth) . blockListToMarkdown opts)
- (fmap (render colwidth) . inlineListToMarkdown opts)
+ (fmap (render' opts) . blockListToMarkdown opts)
+ (fmap (render' opts) . inlineListToMarkdown opts)
(writerVariables opts)
meta
isPlain <- gets stPlain
- let titleblock = case True of
+ titleblock <- case True of
_ | isPlain ->
- plainTitleBlock title' authors' date'
+ return $ plainTitleBlock title' authors' date'
| isEnabled Ext_yaml_title_block opts ->
- yamlTitleBlock metadata
+ yamlTitleBlock opts meta
| isEnabled Ext_pandoc_title_block opts ->
- pandocTitleBlock title' authors' date'
+ return $ pandocTitleBlock title' authors' date'
| isEnabled Ext_mmd_title_block opts ->
- mmdTitleBlock title' authors' date'
- | otherwise -> empty
+ return $ mmdTitleBlock title' authors' date'
+ | otherwise -> return empty
let headerBlocks = filter isHeaderBlock blocks
let toc = if writerTableOfContents opts
then tableOfContents opts headerBlocks
@@ -163,16 +171,14 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
notes' <- notesToMarkdown opts (reverse $ stNotes st)
st' <- get -- note that the notes may contain refs
refs' <- refsToMarkdown opts (reverse $ stRefs st')
- let render' :: Doc -> String
- render' = render colwidth
- let main = render' $ body <>
+ let main = render' opts $ body <>
(if isEmpty notes' then empty else blankline <> notes') <>
(if isEmpty refs' then empty else blankline <> refs')
- let context = defField "toc" (render' toc)
+ let context = defField "toc" (render' opts toc)
$ defField "body" main
$ (if not (null (docTitle meta) && null (docAuthors meta)
&& null (docDate meta))
- then defField "titleblock" (render' titleblock)
+ then defField "titleblock" (render' opts titleblock)
else id)
$ metadata
if writerStandalone opts
diff --git a/tests/writer.markdown b/tests/writer.markdown
index e8aca9954..31be784b2 100644
--- a/tests/writer.markdown
+++ b/tests/writer.markdown
@@ -1,9 +1,9 @@
---
-title: 'Pandoc Test Suite'
author:
- 'John MacFarlane'
- 'Anonymous'
date: 'July 17, 2006'
+title: 'Pandoc Test Suite'
...
This is a set of tests for pandoc. Most of them are adapted from John Gruber’s