Added lhs support to RST writer.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1508 788f1e2b-df1e-0410-8736-df70ead52e1b

1 files changed, 8 insertions, 4 deletions

diff --git a/Text/Pandoc/Writers/RST.hs b/Text/Pandoc/Writers/RST.hs
index de65bcf0e..460a11852 100644
--- a/Text/Pandoc/Writers/RST.hs
+++ b/Text/Pandoc/Writers/RST.hs
@@ -36,6 +36,7 @@ import Text.Pandoc.Blocks
 import Data.List ( isPrefixOf, isSuffixOf, drop, intersperse )
 import Text.PrettyPrint.HughesPJ hiding ( Str )
 import Control.Monad.State
+import Control.Applicative ( (<$>) )
 
 data WriterState = 
   WriterState { stNotes     :: [[Block]]
@@ -176,10 +177,13 @@ blockToRST (Header level inlines) = do
   let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
   let border = text $ replicate headerLength headerChar
   return $ contents $+$ border <> text "\n"
-blockToRST (CodeBlock _ str) = do
-  tabstop <- get >>= (return . writerTabStop . stOptions)
-  return $ (text "::\n") $+$ 
-            (nest tabstop $ vcat $ map text (lines str)) <> text "\n"
+blockToRST (CodeBlock (_,classes,_) str) = do
+  opts <- stOptions <$> get
+  let tabstop = writerTabStop opts
+  if "haskell" `elem` classes && writerLiterateHaskell opts
+     then return $ (vcat $ map (text "> " <>) $ map text (lines str)) <> text "\n"
+     else return $ (text "::\n") $+$
+                   (nest tabstop $ vcat $ map text (lines str)) <> text "\n"
 blockToRST (BlockQuote blocks) = do
   tabstop <- get >>= (return . writerTabStop . stOptions)
   contents <- blockListToRST blocks