From dfa4b76630837560189844eb79c83abcb619b0f6 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 8 Aug 2012 23:18:19 -0700 Subject: Changes to literate haskell options. - Removed writerLiterateHaskell from WriterOptions. - Removed readerLiterateHaskell from ReaderOptions. - Added Ext_literate_haskell to Extensions. Test for this instead of the above. - Removed failUnlessLHS from Shared. Note: At this point, +lhs and .lhs extension no longer has any effect. Need to fix. --- benchmark/benchmark-pandoc.hs | 13 +++---------- pandoc.cabal | 1 + src/Text/Pandoc.hs | 19 ------------------- src/Text/Pandoc/Options.hs | 9 +++++---- src/Text/Pandoc/Parsing.hs | 5 ----- src/Text/Pandoc/Readers/LaTeX.hs | 4 ++-- src/Text/Pandoc/Readers/Markdown.hs | 2 +- src/Text/Pandoc/Readers/RST.hs | 2 +- src/Text/Pandoc/Writers/HTML.hs | 2 +- src/Text/Pandoc/Writers/LaTeX.hs | 2 +- src/Text/Pandoc/Writers/Markdown.hs | 9 +++------ src/Text/Pandoc/Writers/RST.hs | 2 +- src/pandoc.hs | 4 ---- tests/Tests/Readers/Markdown.hs | 4 +++- 14 files changed, 22 insertions(+), 56 deletions(-) diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs index 7dbd29bed..728e45b56 100644 --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -2,7 +2,6 @@ import Text.Pandoc import Text.Pandoc.Shared (readDataFile, normalize) import Criterion.Main import Criterion.Config -import Data.List (isSuffixOf) import Text.JSON.Generic import System.Environment (getArgs) import Data.Monoid @@ -14,24 +13,18 @@ readerBench doc (name, reader) = let writer = case lookup name writers of Just (PureStringWriter w) -> w _ -> error $ "Could not find writer for " ++ name - inp = writer def{ writerWrapText = True - , writerLiterateHaskell = - "+lhs" `isSuffixOf` name } doc + inp = writer def{ writerWrapText = True } doc -- we compute the length to force full evaluation getLength (Pandoc (Meta a b c) d) = length a + length b + length c + length d in bench (name ++ " reader") $ whnf (getLength . - reader def{ readerSmart = True - , readerLiterateHaskell = "+lhs" `isSuffixOf` name - }) inp + reader def{ readerSmart = True }) inp writerBench :: Pandoc -> (String, WriterOptions -> Pandoc -> String) -> Benchmark writerBench doc (name, writer) = bench (name ++ " writer") $ nf - (writer def{ - writerWrapText = True - , writerLiterateHaskell = "+lhs" `isSuffixOf` name }) doc + (writer def{ writerWrapText = True }) doc normalizeBench :: Pandoc -> [Benchmark] normalizeBench doc = [ bench "normalize - with" $ nf (encodeJSON . normalize) doc diff --git a/pandoc.cabal b/pandoc.cabal index 83288bae2..e999f1b80 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -392,6 +392,7 @@ Test-Suite test-pandoc QuickCheck >= 2.4 && < 2.6, HUnit >= 1.2 && < 1.3, template-haskell >= 2.4 && < 2.8, + containers >= 0.1 && < 0.5, ansi-terminal == 0.5.* Other-Modules: Tests.Old Tests.Helpers diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 15633b0e5..e12aa055c 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -149,17 +149,11 @@ readers :: [(String, ReaderOptions -> String -> Pandoc)] readers = [("native" , \_ -> readNative) ,("json" , \_ -> decodeJSON) ,("markdown" , readMarkdown) - ,("markdown+lhs" , \opt -> - readMarkdown opt{ readerLiterateHaskell = True }) ,("rst" , readRST) - ,("rst+lhs" , \opt -> - readRST opt{ readerLiterateHaskell = True }) ,("docbook" , readDocBook) ,("textile" , readTextile) -- TODO : textile+lhs ,("html" , readHtml) ,("latex" , readLaTeX) - ,("latex+lhs" , \opt -> - readLaTeX opt{ readerLiterateHaskell = True }) ] data Writer = PureStringWriter (WriterOptions -> Pandoc -> String) @@ -178,11 +172,6 @@ writers = [ ,("html" , PureStringWriter writeHtmlString) ,("html5" , PureStringWriter $ \o -> writeHtmlString o{ writerHtml5 = True }) - ,("html+lhs" , PureStringWriter $ \o -> - writeHtmlString o{ writerLiterateHaskell = True }) - ,("html5+lhs" , PureStringWriter $ \o -> - writeHtmlString o{ writerLiterateHaskell = True, - writerHtml5 = True }) ,("s5" , PureStringWriter $ \o -> writeHtmlString o{ writerSlideVariant = S5Slides , writerTableOfContents = False }) @@ -196,22 +185,14 @@ writers = [ ,("docbook" , PureStringWriter writeDocbook) ,("opendocument" , PureStringWriter writeOpenDocument) ,("latex" , PureStringWriter writeLaTeX) - ,("latex+lhs" , PureStringWriter $ \o -> - writeLaTeX o{ writerLiterateHaskell = True }) ,("beamer" , PureStringWriter $ \o -> writeLaTeX o{ writerBeamer = True }) - ,("beamer+lhs" , PureStringWriter $ \o -> - writeLaTeX o{ writerBeamer = True, writerLiterateHaskell = True }) ,("context" , PureStringWriter writeConTeXt) ,("texinfo" , PureStringWriter writeTexinfo) ,("man" , PureStringWriter writeMan) ,("markdown" , PureStringWriter writeMarkdown) - ,("markdown+lhs" , PureStringWriter $ \o -> - writeMarkdown o{ writerLiterateHaskell = True }) ,("plain" , PureStringWriter writePlain) ,("rst" , PureStringWriter writeRST) - ,("rst+lhs" , PureStringWriter $ \o -> - writeRST o{ writerLiterateHaskell = True }) ,("mediawiki" , PureStringWriter writeMediaWiki) ,("textile" , PureStringWriter writeTextile) ,("rtf" , PureStringWriter writeRTF) diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index e3dc29215..01a171508 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -38,6 +38,7 @@ module Text.Pandoc.Options ( Extension(..) , HTMLSlideVariant (..) , WriterOptions (..) , def + , isEnabled ) where import Data.Set (Set) import qualified Data.Set as Set @@ -77,6 +78,7 @@ data Extension = Ext_footnotes | Ext_superscript | Ext_subscript | Ext_hard_line_breaks + | Ext_literate_haskell deriving (Show, Read, Enum, Eq, Ord, Bounded) pandocExtensions :: Set Extension @@ -128,7 +130,6 @@ data ReaderOptions = ReaderOptions{ , readerOldDashes :: Bool -- ^ Use pandoc <= 1.8.2.1 behavior -- in parsing dashes; -- is em-dash; -- - before numerial is en-dash - , readerLiterateHaskell :: Bool -- ^ Interpret as literate Haskell , readerCitations :: [String] -- ^ List of available citations , readerApplyMacros :: Bool -- ^ Apply macros to TeX math , readerIndentedCodeClasses :: [String] -- ^ Default classes for @@ -145,7 +146,6 @@ instance Default ReaderOptions , readerColumns = 80 , readerTabStop = 4 , readerOldDashes = False - , readerLiterateHaskell = False , readerCitations = [] , readerApplyMacros = True , readerIndentedCodeClasses = [] @@ -201,7 +201,6 @@ data WriterOptions = WriterOptions , writerReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst , writerWrapText :: Bool -- ^ Wrap text to line length , writerColumns :: Int -- ^ Characters in a line (for text wrapping) - , writerLiterateHaskell :: Bool -- ^ Write as literate haskell , writerEmailObfuscation :: ObfuscationMethod -- ^ How to obfuscate emails , writerIdentifierPrefix :: String -- ^ Prefix for section & note ids in HTML , writerSourceDirectory :: FilePath -- ^ Directory path of 1st source file @@ -240,7 +239,6 @@ instance Default WriterOptions where , writerReferenceLinks = False , writerWrapText = True , writerColumns = 72 - , writerLiterateHaskell = False , writerEmailObfuscation = JavascriptObfuscation , writerIdentifierPrefix = "" , writerSourceDirectory = "." @@ -262,3 +260,6 @@ instance Default WriterOptions where , writerReferenceDocx = Nothing } +-- | Returns True if the given extension is enabled. +isEnabled :: Extension -> WriterOptions -> Bool +isEnabled ext opts = ext `Set.member` (writerExtensions opts) diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 2eb07beec..50691f409 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -49,7 +49,6 @@ module Text.Pandoc.Parsing ( (>>~), withHorizDisplacement, withRaw, nullBlock, - failUnlessLHS, escaped, characterReference, updateLastStrPos, @@ -421,10 +420,6 @@ withRaw parser = do nullBlock :: Parser [Char] st Block nullBlock = anyChar >> return Null --- | Fail unless we're in literate haskell mode. -failUnlessLHS :: Parser [tok] ParserState () -failUnlessLHS = getOption readerLiterateHaskell >>= guard - -- | Parses backslash, then applies character parser. escaped :: Parser [Char] st Char -- ^ Parser for character to escape -> Parser [Char] st Char diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 8d6c71746..4a5a14d6a 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -187,7 +187,7 @@ inline = (mempty <$ comment) <|> (mathInline $ char '$' *> mathChars <* char '$') <|> (superscript <$> (char '^' *> tok)) <|> (subscript <$> (char '_' *> tok)) - <|> (failUnlessLHS *> char '|' *> doLHSverb) + <|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb) <|> (str <$> count 1 tildeEscape) <|> (str <$> string "]") <|> (str <$> string "#") -- TODO print warning? @@ -737,7 +737,7 @@ environments = M.fromList , ("itemize", bulletList <$> listenv "itemize" (many item)) , ("description", definitionList <$> listenv "description" (many descItem)) , ("enumerate", ordered_list) - , ("code", failUnlessLHS *> + , ("code", guardEnabled Ext_literate_haskell *> (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$> verbEnv "code")) , ("verbatim", codeBlock <$> (verbEnv "verbatim")) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index e21646446..0205e4603 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -422,7 +422,7 @@ codeBlockIndented = do lhsCodeBlock :: Parser [Char] ParserState (F Blocks) lhsCodeBlock = do - failUnlessLHS + guardEnabled Ext_literate_haskell (return . B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$> (lhsCodeBlockBird <|> lhsCodeBlockLaTeX)) <|> (return . B.codeBlockWith ("",["sourceCode","haskell"],[]) <$> diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 6bbb2fbd2..9fb976903 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -407,7 +407,7 @@ mathBlockMultiline = try $ do lhsCodeBlock :: Parser [Char] ParserState Block lhsCodeBlock = try $ do - getOption readerLiterateHaskell >>= guard + guardEnabled Ext_literate_haskell optional codeBlockStart pos <- getPosition when (sourceColumn pos /= 1) $ fail "Not in first column" diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 9a15e4bd3..c6c4a8fd7 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -397,7 +397,7 @@ blockToHtml _ (RawBlock "html" str) = return $ preEscapedString str blockToHtml _ (RawBlock _ _) = return mempty blockToHtml opts (HorizontalRule) = return $ if writerHtml5 opts then H5.hr else H.hr blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do - let tolhs = writerLiterateHaskell opts && + let tolhs = isEnabled Ext_literate_haskell opts && any (\c -> map toLower c == "haskell") classes && any (\c -> map toLower c == "literate") classes classes' = if tolhs diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index e4788ab06..abbbd4d01 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -290,7 +290,7 @@ blockToLaTeX (BlockQuote lst) = do blockToLaTeX (CodeBlock (_,classes,keyvalAttr) str) = do opts <- gets stOptions case () of - _ | writerLiterateHaskell opts && "haskell" `elem` classes && + _ | isEnabled Ext_literate_haskell opts && "haskell" `elem` classes && "literate" `elem` classes -> lhsCodeBlock | writerListings opts -> listingsCodeBlock | writerHighlight opts && not (null classes) -> highlightedCodeBlock diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 8e608ea3d..52805c1aa 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -49,9 +49,6 @@ data WriterState = WriterState { stNotes :: Notes , stRefs :: Refs , stPlain :: Bool } -isEnabled :: Extension -> WriterOptions -> Bool -isEnabled ext opts = ext `Set.member` (writerExtensions opts) - -- | Convert Pandoc to Markdown. writeMarkdown :: WriterOptions -> Pandoc -> String writeMarkdown opts document = @@ -255,12 +252,12 @@ blockToMarkdown opts (Header level inlines) = do contents <> cr <> text (replicate (offset contents) '-') <> blankline -- ghc interprets '#' characters in column 1 as linenum specifiers. - _ | stPlain st || writerLiterateHaskell opts -> + _ | stPlain st || isEnabled Ext_literate_haskell opts -> contents <> blankline _ -> text (replicate level '#') <> space <> contents <> blankline blockToMarkdown opts (CodeBlock (_,classes,_) str) | "haskell" `elem` classes && "literate" `elem` classes && - writerLiterateHaskell opts = + isEnabled Ext_literate_haskell opts = return $ prefixed "> " (text str) <> blankline blockToMarkdown opts (CodeBlock attribs str) = return $ if isEnabled Ext_delimited_code_blocks opts && attribs /= nullAttr @@ -274,7 +271,7 @@ blockToMarkdown opts (BlockQuote blocks) = do st <- get -- if we're writing literate haskell, put a space before the bird tracks -- so they won't be interpreted as lhs... - let leader = if writerLiterateHaskell opts + let leader = if isEnabled Ext_literate_haskell opts then " > " else if stPlain st then " " diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 0c46cb0bc..5b0b5a414 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -164,7 +164,7 @@ blockToRST (CodeBlock (_,classes,_) str) = do opts <- stOptions <$> get let tabstop = writerTabStop opts if "haskell" `elem` classes && "literate" `elem` classes && - writerLiterateHaskell opts + isEnabled Ext_literate_haskell opts then return $ prefixed "> " (text str) $$ blankline else return $ "::" $+$ nest tabstop (text str) $$ blankline blockToRST (BlockQuote blocks) = do diff --git a/src/pandoc.hs b/src/pandoc.hs index 50dfb59f3..e7a378826 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -980,9 +980,6 @@ main = do , readerColumns = columns , readerTabStop = tabStop , readerOldDashes = oldDashes - , readerLiterateHaskell = - "+lhs" `isSuffixOf` readerName' || - lhsExtension sources , readerCitations = map CSL.refId refs , readerIndentedCodeClasses = codeBlockClasses , readerApplyMacros = not laTeXOutput @@ -1005,7 +1002,6 @@ main = do writerReferenceLinks = referenceLinks, writerWrapText = wrap, writerColumns = columns, - writerLiterateHaskell = False, writerEmailObfuscation = if strict then ReferenceObfuscation else obfuscationMethod, diff --git a/tests/Tests/Readers/Markdown.hs b/tests/Tests/Readers/Markdown.hs index dbb96c15f..8d0b567e9 100644 --- a/tests/Tests/Readers/Markdown.hs +++ b/tests/Tests/Readers/Markdown.hs @@ -6,6 +6,7 @@ import Test.Framework import Tests.Helpers import Tests.Arbitrary() import Text.Pandoc.Builder +import qualified Data.Set as Set -- import Text.Pandoc.Shared ( normalize ) import Text.Pandoc @@ -91,7 +92,8 @@ tests = [ testGroup "inline code" =?> para (note (para "See [^1]")) ] , testGroup "lhs" - [ test (readMarkdown def{ readerLiterateHaskell = True }) + [ test (readMarkdown def{ readerExtensions = Set.insert + Ext_literate_haskell $ readerExtensions def }) "inverse bird tracks and html" $ "> a\n\n< b\n\n
\n" =?> codeBlockWith ("",["sourceCode","literate","haskell"],[]) "a" -- cgit v1.2.3