Specially mark code blocks that were "literate" in the input.

They can then be treated differently in the writers.  This allows
authors to distinguish bits of the literate program they are writing
from source code examples, even if the examples are marked as
Haskell for highlighting.

Resolves Issue #174.

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

src/Text/Pandoc/Readers/LaTeX.hs

@@ -207,7 +207,7 @@ lhsCodeBlock :: GenParser Char ParserState Block
 lhsCodeBlock = do
   failUnlessLHS
   (CodeBlock (_,_,_) cont) <- codeBlockWith "code"
-  return $ CodeBlock ("", ["sourceCode","haskell"], []) cont
+  return $ CodeBlock ("", ["sourceCode","literate","haskell"], []) cont
 
 --
 -- block quotes

src/Text/Pandoc/Readers/Markdown.hs

@@ -407,7 +407,7 @@ lhsCodeBlock :: GenParser Char ParserState Block
 lhsCodeBlock = do
   failUnlessLHS
   contents <- lhsCodeBlockBird <|> lhsCodeBlockLaTeX
-  return $ CodeBlock ("",["sourceCode","haskell"],[]) contents
+  return $ CodeBlock ("",["sourceCode","literate","haskell"],[]) contents
 
 lhsCodeBlockLaTeX :: GenParser Char ParserState String
 lhsCodeBlockLaTeX = try $ do

src/Text/Pandoc/Readers/RST.hs

@@ -342,7 +342,7 @@ lhsCodeBlock = try $ do
                 then map (drop 1) lns
                 else lns
   blanklines
-  return $ CodeBlock ("", ["sourceCode", "haskell"], []) $ intercalate "\n" lns'
+  return $ CodeBlock ("", ["sourceCode", "literate", "haskell"], []) $ intercalate "\n" lns'
 
 birdTrackLine :: GenParser Char st [Char]
 birdTrackLine = do

src/Text/Pandoc/Writers/HTML.hs

@@ -249,7 +249,8 @@ blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
 blockToHtml _ (RawHtml str) = return $ primHtml str
 blockToHtml _ (HorizontalRule) = return $ hr
 blockToHtml opts (CodeBlock (_,classes,_) rawCode) | "haskell" `elem` classes &&
-                                                          writerLiterateHaskell opts =
+                                                     "literate" `elem` classes &&
+                                                     writerLiterateHaskell opts =
   let classes' = map (\c -> if c == "haskell" then "literatehaskell" else c) classes
   in  blockToHtml opts $ CodeBlock ("",classes',[]) $ intercalate "\n" $ map ("> " ++) $ lines rawCode
 blockToHtml _ (CodeBlock attr@(_,classes,_) rawCode) = do

src/Text/Pandoc/Writers/LaTeX.hs

@@ -149,7 +149,8 @@ blockToLaTeX (BlockQuote lst) = do
   return $ text "\\begin{quote}" $$ contents $$ text "\\end{quote}"
 blockToLaTeX (CodeBlock (_,classes,_) str) = do
   st <- get
-  env <- if writerLiterateHaskell (stOptions st) && "haskell" `elem` classes
+  env <- if writerLiterateHaskell (stOptions st) && "haskell" `elem` classes &&
+                    "literate" `elem` classes
             then return "code"
             else if stInNote st
                     then do addToHeader "\\usepackage{fancyvrb}"

src/Text/Pandoc/Writers/Markdown.hs

@@ -198,6 +198,7 @@ blockToMarkdown opts (Header level inlines) = do
                             _  -> empty
      else return $ text ((replicate level '#') ++ " ") <> contents <> text "\n"
 blockToMarkdown opts (CodeBlock (_,classes,_) str) | "haskell" `elem` classes &&
+                                                     "literate" `elem` classes &&
                                                      writerLiterateHaskell opts =
   return $ (vcat $ map (text "> " <>) $ map text (lines str)) <> text "\n"
 blockToMarkdown opts (CodeBlock _ str) = return $

src/Text/Pandoc/Writers/RST.hs

@@ -183,7 +183,8 @@ blockToRST (Header level inlines) = do
 blockToRST (CodeBlock (_,classes,_) str) = do
   opts <- stOptions <$> get
   let tabstop = writerTabStop opts
-  if "haskell" `elem` classes && writerLiterateHaskell opts
+  if "haskell" `elem` classes && "literate" `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"

tests/lhs-test.native

@@ -1,7 +1,7 @@
 Pandoc (Meta [] [] "")
 [ Header 1 [Str "lhs",Space,Str "test"]
 , Para [Code "unsplit",Space,Str "is",Space,Str "an",Space,Str "arrow",Space,Str "that",Space,Str "takes",Space,Str "a",Space,Str "pair",Space,Str "of",Space,Str "values",Space,Str "and",Space,Str "combines",Space,Str "them",Space,Str "to",Space,Str "return",Space,Str "a",Space,Str "single",Space,Str "value:"]
-, CodeBlock ("",["sourceCode","haskell"],[]) "unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d\nunsplit = arr . uncurry       \n          -- arr (\\op (x,y) -> x `op` y) "
+, CodeBlock ("",["sourceCode","literate","haskell"],[]) "unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d\nunsplit = arr . uncurry       \n          -- arr (\\op (x,y) -> x `op` y) "
 , Para [Code "(***)",Space,Str "combines",Space,Str "two",Space,Str "arrows",Space,Str "into",Space,Str "a",Space,Str "new",Space,Str "arrow",Space,Str "by",Space,Str "running",Space,Str "the",Space,Str "two",Space,Str "arrows",Space,Str "on",Space,Str "a",Space,Str "pair",Space,Str "of",Space,Str "values",Space,Str "(one",Space,Str "arrow",Space,Str "on",Space,Str "the",Space,Str "first",Space,Str "item",Space,Str "of",Space,Str "the",Space,Str "pair",Space,Str "and",Space,Str "one",Space,Str "arrow",Space,Str "on",Space,Str "the",Space,Str "second",Space,Str "item",Space,Str "of",Space,Str "the",Space,Str "pair)",Str "."]
 , CodeBlock ("",[],[]) "f *** g = first f >>> second g"
 , Para [Str "Block",Space,Str "quote:"]