From e8e8468d69b885a9e84435f29c4b553bb4d2417d Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sun, 12 Aug 2012 19:27:13 -0700
Subject: Implemented Ext_mmd_title_block in markdown reader & writer.

---
 src/Text/Pandoc/Options.hs          |  5 +++--
 src/Text/Pandoc/Readers/Markdown.hs | 28 +++++++++++++++++++++++++---
 src/Text/Pandoc/Writers/Markdown.hs | 35 +++++++++++++++++++++++++++++------
 3 files changed, 57 insertions(+), 11 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3