diff options
author | John MacFarlane <jgm@berkeley.edu> | 2013-07-01 14:17:04 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2013-07-01 14:17:04 -0700 |
commit | 2d46828b1ced50cb6a05746f3eab987812a0842d (patch) | |
tree | b11b8ad448fe5da2511b931dd480e9e6133b8dab | |
parent | 0ec8573347d53e0cba70552a50dba697f39216b6 (diff) | |
download | pandoc-2d46828b1ced50cb6a05746f3eab987812a0842d.tar.gz |
Revert "Markdown writer: Don't include variables in metadata."
This reverts commit 0ec8573347d53e0cba70552a50dba697f39216b6.
-rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 76 | ||||
-rw-r--r-- | tests/writer.markdown | 2 |
2 files changed, 36 insertions, 42 deletions
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index e464d63b5..d8ac99685 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -46,8 +46,10 @@ import Text.Pandoc.Readers.TeXMath (readTeXMath) import Text.HTML.TagSoup (renderTags, parseTags, isTagText, Tag(..)) import Network.URI (isAbsoluteURI) import Data.Default -import qualified Data.Map as M -import Control.Applicative ((<$>)) +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 type Notes = [[Block]] type Refs = [([Inline], Target)] @@ -111,34 +113,21 @@ plainTitleBlock tit auths dat = (hcat (intersperse (text "; ") auths)) <> cr <> dat <> cr -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 +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 -- | Return markdown representation of document. pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String @@ -146,22 +135,25 @@ 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' opts) . blockListToMarkdown opts) - (fmap (render' opts) . inlineListToMarkdown opts) + (fmap (render colwidth) . blockListToMarkdown opts) + (fmap (render colwidth) . inlineListToMarkdown opts) (writerVariables opts) meta isPlain <- gets stPlain - titleblock <- case True of + let titleblock = case True of _ | isPlain -> - return $ plainTitleBlock title' authors' date' + plainTitleBlock title' authors' date' | isEnabled Ext_yaml_title_block opts -> - yamlTitleBlock opts meta + yamlTitleBlock metadata | isEnabled Ext_pandoc_title_block opts -> - return $ pandocTitleBlock title' authors' date' + pandocTitleBlock title' authors' date' | isEnabled Ext_mmd_title_block opts -> - return $ mmdTitleBlock title' authors' date' - | otherwise -> return empty + mmdTitleBlock title' authors' date' + | otherwise -> empty let headerBlocks = filter isHeaderBlock blocks let toc = if writerTableOfContents opts then tableOfContents opts headerBlocks @@ -171,14 +163,16 @@ 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 main = render' opts $ body <> + let render' :: Doc -> String + render' = render colwidth + let main = render' $ body <> (if isEmpty notes' then empty else blankline <> notes') <> (if isEmpty refs' then empty else blankline <> refs') - let context = defField "toc" (render' opts toc) + let context = defField "toc" (render' toc) $ defField "body" main $ (if not (null (docTitle meta) && null (docAuthors meta) && null (docDate meta)) - then defField "titleblock" (render' opts titleblock) + then defField "titleblock" (render' titleblock) else id) $ metadata if writerStandalone opts diff --git a/tests/writer.markdown b/tests/writer.markdown index 31be784b2..e8aca9954 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 |