Markdown writer: Don't include variables in metadata.
This commit is contained in:
parent
5d01e9a117
commit
0ec8573347
2 changed files with 41 additions and 35 deletions
|
@ -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
|
||||||
|
|
|
@ -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 Gruber’s
|
This is a set of tests for pandoc. Most of them are adapted from John Gruber’s
|
||||||
|
|
Loading…
Add table
Reference in a new issue