From 42ba781b3dcb15a3a8fd4169fa03eeb316f05125 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Tue, 2 Dec 2008 22:41:51 +0000
Subject: Added literate haskell support for markdown reader.

+ Added stateLiterateHaskell to parser state.
+ Added parser for lhsCodeBlock to Markdown reader.
+ Added --lhs-in option, to treat input as literate haskell.
+ If first source has extension .lhs, assume --lhs-in.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1497 788f1e2b-df1e-0410-8736-df70ead52e1b
---
 Text/Pandoc/Readers/Markdown.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

(limited to 'Text/Pandoc/Readers')

diff --git a/Text/Pandoc/Readers/Markdown.hs b/Text/Pandoc/Readers/Markdown.hs
index e9f19e817..b2e0928c9 100644
--- a/Text/Pandoc/Readers/Markdown.hs
+++ b/Text/Pandoc/Readers/Markdown.hs
@@ -45,6 +45,7 @@ import Text.Pandoc.Readers.HTML ( rawHtmlBlock, anyHtmlBlockTag,
                                   htmlBlockElement, unsanitaryURI )
 import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
 import Text.ParserCombinators.Parsec
+import Control.Monad (when)
 
 -- | Read markdown from an input string and return a Pandoc document.
 readMarkdown :: ParserState -> String -> Pandoc
@@ -102,6 +103,12 @@ failUnlessSmart = do
   state <- getState
   if stateSmart state then return () else fail "Smart typography feature"
 
+-- | Fail unless we're in literate haskell mode.
+failUnlessLHS :: GenParser tok ParserState ()
+failUnlessLHS = do
+  state <- getState
+  if stateLiterateHaskell state then return () else fail "Literate haskell feature"
+
 -- | Parse a sequence of inline elements between square brackets,
 -- including inlines between balanced pairs of square brackets.
 inlinesInBalancedBrackets :: GenParser Char ParserState Inline
@@ -268,6 +275,7 @@ block = do
                    , header 
                    , table
                    , codeBlockIndented
+                   , lhsCodeBlock
                    , blockQuote
                    , hrule
                    , bulletList
@@ -393,6 +401,25 @@ codeBlockIndented = do
   optional blanklines
   return $ CodeBlock ("",[],[]) $ stripTrailingNewlines $ concat contents
 
+lhsCodeBlock :: GenParser Char ParserState Block
+lhsCodeBlock = do
+  failUnlessLHS
+  pos <- getPosition
+  when (sourceColumn pos /= 1) $ fail "Not in first column"
+  lns <- many1 birdTrackLine
+  -- if (as is normal) there is always a space after >, drop it
+  let lns' = if all (\ln -> null ln || take 1 ln == " ") lns
+                then map (drop 1) lns
+                else lns
+  blanklines
+  return $ CodeBlock ("",["haskell"],[]) $ intercalate "\n" lns'
+
+birdTrackLine :: GenParser Char st [Char]
+birdTrackLine = do
+  char '>'
+  manyTill anyChar newline
+
+
 --
 -- block quotes
 --
-- 
cgit v1.2.3