summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Options.hs5
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs28
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs35
3 files changed, 57 insertions, 11 deletions
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index 6d235e7a8..9992cc9d9 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -48,7 +48,8 @@ import Text.Pandoc.Highlighting (Style, pygments)
-- | Individually selectable syntax extensions.
data Extension = Ext_footnotes
| Ext_inline_notes
- | Ext_pandoc_title_blocks
+ | Ext_pandoc_title_block
+ | Ext_mmd_title_block
| Ext_table_captions
-- | Ext_image_captions
| Ext_simple_tables
@@ -87,7 +88,7 @@ pandocExtensions :: Set Extension
pandocExtensions = Set.fromList
[ Ext_footnotes
, Ext_inline_notes
- , Ext_pandoc_title_blocks
+ , Ext_pandoc_title_block
, Ext_table_captions
-- , Ext_image_captions
, Ext_simple_tables
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 882fe1f63..995c9c65a 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -35,7 +35,7 @@ module Text.Pandoc.Readers.Markdown ( readMarkdown ) where
import Data.List ( transpose, sortBy, findIndex, intercalate )
import qualified Data.Map as M
import Data.Ord ( comparing )
-import Data.Char ( isAlphaNum )
+import Data.Char ( isAlphaNum, toLower )
import Data.Maybe
import Text.Pandoc.Definition
import qualified Text.Pandoc.Builder as B
@@ -175,14 +175,36 @@ dateLine = try $ do
trimInlinesF . mconcat <$> manyTill inline newline
titleBlock :: Parser [Char] ParserState (F Inlines, F [Inlines], F Inlines)
-titleBlock = try $ do
- guardEnabled Ext_pandoc_title_blocks
+titleBlock = pandocTitleBlock <|> mmdTitleBlock
+
+pandocTitleBlock :: Parser [Char] ParserState (F Inlines, F [Inlines], F Inlines)
+pandocTitleBlock = try $ do
+ guardEnabled Ext_pandoc_title_block
title <- option mempty titleLine
author <- option (return []) authorsLine
date <- option mempty dateLine
optional blanklines
return (title, author, date)
+mmdTitleBlock :: Parser [Char] ParserState (F Inlines, F [Inlines], F Inlines)
+mmdTitleBlock = try $ do
+ guardEnabled Ext_mmd_title_block
+ kvPairs <- many1 kvPair
+ blanklines
+ let title = maybe mempty return $ lookup "title" kvPairs
+ let author = maybe mempty (\x -> return [x]) $ lookup "author" kvPairs
+ let date = maybe mempty return $ lookup "date" kvPairs
+ return (title, author, date)
+
+kvPair :: Parser [Char] ParserState (String, Inlines)
+kvPair = try $ do
+ key <- many1Till (alphaNum <|> oneOf "_- ") (char ':')
+ val <- manyTill anyChar
+ (try $ newline >> lookAhead (blankline <|> nonspaceChar))
+ let key' = concat $ words $ map toLower key
+ let val' = trimInlines $ B.text val
+ return (key',val')
+
parseMarkdown :: Parser [Char] ParserState Pandoc
parseMarkdown = do
-- markdown allows raw HTML
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index c21c735c3..1e381b461 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -87,14 +87,39 @@ plainify = bottomUp go
go (Cite _ cits) = SmallCaps cits
go x = x
+pandocTitleBlock :: Doc -> [Doc] -> Doc -> Doc
+pandocTitleBlock tit auths dat =
+ hang 2 (text "% ") tit <> cr <>
+ hang 2 (text "% ") (hcat (intersperse (text "; ") auths)) <> cr <>
+ hang 2 (text "% ") dat <> cr
+
+mmdTitleBlock :: Doc -> [Doc] -> Doc -> Doc
+mmdTitleBlock tit auths dat =
+ hang 8 (text "Title: ") tit <> cr <>
+ hang 8 (text "Author: ") (hcat (intersperse (text "; ") auths)) <> cr <>
+ hang 8 (text "Date: ") dat <> cr
+
+plainTitleBlock :: Doc -> [Doc] -> Doc -> Doc
+plainTitleBlock tit auths dat =
+ tit <> cr <>
+ (hcat (intersperse (text "; ") auths)) <> cr <>
+ dat <> cr
+
-- | Return markdown representation of document.
pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String
pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
title' <- inlineListToMarkdown opts title
authors' <- mapM (inlineListToMarkdown opts) authors
date' <- inlineListToMarkdown opts date
- let titleblock = isEnabled Ext_pandoc_title_blocks opts &&
- not (null title && null authors && null date)
+ isPlain <- gets stPlain
+ let titleblock = case True of
+ _ | isPlain ->
+ plainTitleBlock title' authors' date'
+ | isEnabled Ext_pandoc_title_block opts ->
+ pandocTitleBlock title' authors' date'
+ | isEnabled Ext_mmd_title_block opts ->
+ mmdTitleBlock title' authors' date'
+ | otherwise -> empty
let headerBlocks = filter isHeaderBlock blocks
let toc = if writerTableOfContents opts
then tableOfContents opts headerBlocks
@@ -113,11 +138,9 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do
let context = writerVariables opts ++
[ ("toc", render colwidth toc)
, ("body", main)
- , ("title", render colwidth title')
- , ("date", render colwidth date')
] ++
- [ ("titleblock", "yes") | titleblock ] ++
- [ ("author", render colwidth a) | a <- authors' ]
+ [ ("titleblock", render colwidth titleblock)
+ | not (null title && null authors && null date) ]
if writerStandalone opts
then return $ renderTemplate context $ writerTemplate opts
else return main