From fce48c392acd5c56141ce924f4aaa8fadd10085d Mon Sep 17 00:00:00 2001 From: fiddlosopher Date: Tue, 3 Nov 2009 06:50:17 +0000 Subject: 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 | 2 +- src/Text/Pandoc/Readers/Markdown.hs | 2 +- src/Text/Pandoc/Readers/RST.hs | 2 +- src/Text/Pandoc/Writers/HTML.hs | 3 ++- src/Text/Pandoc/Writers/LaTeX.hs | 3 ++- src/Text/Pandoc/Writers/Markdown.hs | 1 + src/Text/Pandoc/Writers/RST.hs | 3 ++- tests/lhs-test.native | 2 +- 8 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index c6e28cd45..0ae24a387 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/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 diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 3f2865d66..226252381 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/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 diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index b0f434933..89c30ff5d 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/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 diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 4b6ea5982..28d0daacc 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/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 diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index f3cbf1acb..a0f9e9004 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/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}" diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index b2c1dc175..a18e1ecd6 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/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 $ diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 728c78712..0bff38db7 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/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" diff --git a/tests/lhs-test.native b/tests/lhs-test.native index cd4f45bfa..0f54e2959 100644 --- a/tests/lhs-test.native +++ b/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:"] -- cgit v1.2.3