From dc8e5970bfeb6bc760bf57b87b5d99f1a2c2ad38 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Tue, 21 Aug 2012 20:11:10 -0700
Subject: Implemented Ext_backtick_code_blocks.

This is the variant github prefers.
---
 src/Text/Pandoc/Options.hs          |  2 ++
 src/Text/Pandoc/Readers/Markdown.hs | 38 ++++++++++++++++++++++---------------
 src/Text/Pandoc/Writers/Markdown.hs | 20 +++++++++++++------
 3 files changed, 39 insertions(+), 21 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs
index ea5ebf678..a9c8bf710 100644
--- a/src/Text/Pandoc/Options.hs
+++ b/src/Text/Pandoc/Options.hs
@@ -66,6 +66,7 @@ data Extension =
     | Ext_latex_macros        -- ^ Parse LaTeX macro definitions (for math only)
     | Ext_fenced_code_blocks  -- ^ Parse fenced code blocks
     | Ext_fenced_code_attributes  -- ^ Allow attributes on fenced code blocks
+    | Ext_backtick_code_blocks    -- ^ Github style ``` code blocks
     | Ext_inline_code_attributes  -- ^ Allow attributes on inline code
     | Ext_markdown_in_html_blocks -- ^ Interpret as markdown inside HTML blocks
     | Ext_markdown_attribute      -- ^ Interpret text inside HTML as markdown
@@ -107,6 +108,7 @@ pandocExtensions = Set.fromList
   , Ext_latex_macros
   , Ext_fenced_code_blocks
   , Ext_fenced_code_attributes
+  , Ext_backtick_code_blocks
   , Ext_inline_code_attributes
   , Ext_markdown_in_html_blocks
   , Ext_escaped_line_breaks
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index df3e7687b..2407e137c 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -307,6 +307,7 @@ parseBlocks = mconcat <$> manyTill block eof
 
 block :: Parser [Char] ParserState (F Blocks)
 block = choice [ codeBlockFenced
+               , codeBlockBackticks
                , guardEnabled Ext_latex_macros *> (mempty <$ macro)
                , header
                , rawTeXBlock
@@ -379,21 +380,13 @@ indentedLine = indentSpaces >> manyTill anyChar newline >>= return . (++ "\n")
 
 blockDelimiter :: (Char -> Bool)
                -> Maybe Int
-               -> Parser [Char] ParserState (Int, (String, [String], [(String, String)]), Char)
+               -> Parser [Char] st Int
 blockDelimiter f len = try $ do
   c <- lookAhead (satisfy f)
-  size <- case len of
-              Just l  -> count l (char c) >> many (char c) >> return l
-              Nothing -> count 3 (char c) >> many (char c) >>=
-                         return . (+ 3) . length
-  many spaceChar
-  attr <- option ([],[],[]) $ do
-            guardEnabled Ext_fenced_code_attributes
-            attributes                    -- ~~~ {.ruby}
-             <|> (many1 alphaNum >>= \x ->
-                    return ([],[x],[]))   -- github variant ```ruby
-  blankline
-  return (size, attr, c)
+  case len of
+      Just l  -> count l (char c) >> many (char c) >> return l
+      Nothing -> count 3 (char c) >> many (char c) >>=
+                 return . (+ 3) . length
 
 attributes :: Parser [Char] st (String, [String], [(String, String)])
 attributes = try $ do
@@ -440,11 +433,26 @@ keyValAttr = try $ do
 codeBlockFenced :: Parser [Char] ParserState (F Blocks)
 codeBlockFenced = try $ do
   guardEnabled Ext_fenced_code_blocks
-  (size, attr, c) <- blockDelimiter (\c -> c == '~' || c == '`') Nothing
-  contents <- manyTill anyLine (blockDelimiter (== c) (Just size))
+  size <- blockDelimiter (=='~') Nothing
+  skipMany spaceChar
+  attr <- option ([],[],[]) $
+            guardEnabled Ext_fenced_code_attributes >> attributes
+  blankline
+  contents <- manyTill anyLine (blockDelimiter (=='~') (Just size))
   blanklines
   return $ return $ B.codeBlockWith attr $ intercalate "\n" contents
 
+codeBlockBackticks :: Parser [Char] ParserState (F Blocks)
+codeBlockBackticks = try $ do
+  guardEnabled Ext_backtick_code_blocks
+  blockDelimiter (=='`') (Just 3)
+  skipMany spaceChar
+  cls <- many1 alphaNum
+  blankline
+  contents <- manyTill anyLine $ blockDelimiter (=='`') (Just 3)
+  blanklines
+  return $ return $ B.codeBlockWith ("",[cls],[]) $ intercalate "\n" contents
+
 codeBlockIndented :: Parser [Char] ParserState (F Blocks)
 codeBlockIndented = do
   contents <- many1 (indentedLine <|>
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index fc676a9bf..d88419feb 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -292,12 +292,20 @@ blockToMarkdown opts (CodeBlock (_,classes,_) str)
     isEnabled Ext_literate_haskell opts =
   return $ prefixed "> " (text str) <> blankline
 blockToMarkdown opts (CodeBlock attribs str) = return $
-  if isEnabled Ext_fenced_code_blocks opts && attribs /= nullAttr
-     then -- use fenced code block
-          (tildes <> space <> attrs <> cr <> text str <>
-                  cr <> tildes) <> blankline
-     else nest (writerTabStop opts) (text str) <> blankline
-   where tildes = text "~~~~"
+  case attribs of
+     x | x /= nullAttr && isEnabled Ext_fenced_code_blocks opts ->
+          tildes <> space <> attrs <> cr <> text str <>
+           cr <> tildes <> blankline
+     (_,(cls:_),_) | isEnabled Ext_backtick_code_blocks opts ->
+          backticks <> space <> text cls <> cr <> text str <>
+           cr <> backticks <> blankline
+     _ -> nest (writerTabStop opts) (text str) <> blankline
+   where tildes    = text $ case [ln | ln <- lines str, all (=='~') ln] of
+                               [] -> "~~~~"
+                               xs -> case maximum $ map length xs of
+                                          n | n < 3 -> "~~~~"
+                                            | otherwise -> replicate (n+1) '~'
+         backticks = text "```"
          attrs  = if isEnabled Ext_fenced_code_attributes opts
                      then attrsToMarkdown attribs
                      else empty
-- 
cgit v1.2.3