From ebe9ac50b0560614e542ed8b11cc2c974f346c47 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Tue, 2 Dec 2008 22:43:33 +0000
Subject: Added lhs support to RST reader.

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

(limited to 'Text/Pandoc/Readers')

diff --git a/Text/Pandoc/Readers/RST.hs b/Text/Pandoc/Readers/RST.hs
index 50075ae65..255054c10 100644
--- a/Text/Pandoc/Readers/RST.hs
+++ b/Text/Pandoc/Readers/RST.hs
@@ -33,6 +33,7 @@ module Text.Pandoc.Readers.RST (
 import Text.Pandoc.Definition
 import Text.Pandoc.Shared 
 import Text.ParserCombinators.Parsec
+import Control.Monad ( when )
 import Data.List ( findIndex, delete, intercalate )
 
 -- | Parse reStructuredText string and return Pandoc document.
@@ -126,6 +127,7 @@ block = choice [ codeBlock
                , hrule
                , list
                , lineBlock
+               , lhsCodeBlock
                , para
                , plain
                , nullBlock ] <?> "block"
@@ -328,6 +330,24 @@ codeBlock = try $ do
   result <- indentedBlock
   return $ CodeBlock ("",[],[]) $ stripTrailingNewlines result
 
+lhsCodeBlock :: GenParser Char ParserState Block
+lhsCodeBlock = try $ 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 ("", ["sourceCode", "haskell"], []) $ intercalate "\n" lns'
+
+birdTrackLine :: GenParser Char st [Char]
+birdTrackLine = do
+  char '>'
+  manyTill anyChar newline
+
 --
 -- raw html
 --
-- 
cgit v1.2.3