From dfa19061abc24a3e95b9b37e4f9484d902110899 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 25 Jul 2012 11:08:06 -0700 Subject: Options -> ReaderOptions. Better to keep reader and writer options separate. --- src/Text/Pandoc/Options.hs | 20 ++++++++++---------- src/Text/Pandoc/Parsing.hs | 6 +++--- src/Text/Pandoc/Readers/HTML.hs | 4 ++-- src/Text/Pandoc/Readers/Markdown.hs | 20 ++++++++++---------- src/Text/Pandoc/Readers/Textile.hs | 2 +- 5 files changed, 26 insertions(+), 26 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index d5bd11ba5..3f228aaa3 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -29,7 +29,7 @@ Data structures and functions for representing parser and writer options. -} module Text.Pandoc.Options ( Extension(..) - , Options(..) + , ReaderOptions(..) ) where import Data.Set (Set) import qualified Data.Set as Set @@ -50,15 +50,15 @@ data Extension = Footnotes | Significant_bullets deriving (Show, Read, Enum, Eq, Ord, Bounded) -data Options = Options{ - optionExtensions :: Set Extension - , optionSmart :: Bool - , optionStrict :: Bool -- FOR TRANSITION ONLY +data ReaderOptions = ReaderOptions{ + readerExtensions :: Set Extension + , readerSmart :: Bool + , readerStrict :: Bool -- FOR TRANSITION ONLY } deriving (Show, Read) -instance Default Options - where def = Options{ - optionExtensions = Set.fromList [minBound..maxBound] - , optionSmart = False - , optionStrict = False +instance Default ReaderOptions + where def = ReaderOptions{ + readerExtensions = Set.fromList [minBound..maxBound] + , readerSmart = False + , readerStrict = False } diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 2d0fef7c3..3ed2644ba 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -392,7 +392,7 @@ nullBlock = anyChar >> return Null failIfStrict :: Parsec [a] ParserState () failIfStrict = do state <- getState - if optionStrict (stateOptions state) then fail "strict mode" else return () + if readerStrict (stateOptions state) then fail "strict mode" else return () -- | Fail unless we're in literate haskell mode. failUnlessLHS :: Parsec [tok] ParserState () @@ -689,7 +689,7 @@ testStringWith parser str = UTF8.putStrLn $ show $ -- | Parsing options. data ParserState = ParserState - { stateOptions :: Options, -- ^ User options + { stateOptions :: ReaderOptions, -- ^ User options stateParseRaw :: Bool, -- ^ Parse raw HTML and LaTeX? stateParserContext :: ParserContext, -- ^ Inside list? stateQuoteContext :: QuoteContext, -- ^ Inside quoted environment? @@ -795,7 +795,7 @@ lookupKeySrc table key = case M.lookup key table of -- | Fail unless we're in "smart typography" mode. failUnlessSmart :: Parsec [tok] ParserState () -failUnlessSmart = getState >>= guard . optionSmart . stateOptions +failUnlessSmart = getState >>= guard . readerSmart . stateOptions smartPunctuation :: Parsec [Char] ParserState Inline -> Parsec [Char] ParserState Inline diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 9510f3a30..aa96f3e9e 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -126,7 +126,7 @@ pOrderedList :: TagParser [Block] pOrderedList = try $ do TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" []) st <- getState - let (start, style) = if optionStrict (stateOptions st) + let (start, style) = if readerStrict (stateOptions st) then (1, DefaultStyle) else (sta', sty') where sta = fromMaybe "1" $ @@ -281,7 +281,7 @@ pCodeBlock = try $ do let attribsClasses = words $ fromMaybe "" $ lookup "class" attr let attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr st <- getState - let attribs = if optionStrict (stateOptions st) + let attribs = if readerStrict (stateOptions st) then ("",[],[]) else (attribsId, attribsClasses, attribsKV) return [CodeBlock attribs result] diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index d668bb2ab..d2d168d98 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -182,7 +182,7 @@ parseMarkdown = do -- docMinusKeys is the raw document with blanks where the keys/notes were... st <- getState let firstPassParser = referenceKey - <|> (if optionStrict (stateOptions st) then mzero else noteBlock) + <|> (if readerStrict (stateOptions st) then mzero else noteBlock) <|> liftM snd (withRaw codeBlockDelimited) <|> lineClump docMinusKeys <- liftM concat $ manyTill firstPassParser eof @@ -293,7 +293,7 @@ parseBlocks = manyTill block eof block :: Parser [Char] ParserState Block block = do st <- getState - choice (if optionStrict (stateOptions st) + choice (if readerStrict (stateOptions st) then [ header , codeBlockIndented , blockQuote @@ -534,7 +534,7 @@ anyOrderedListStart = try $ do skipNonindentSpaces notFollowedBy $ string "p." >> spaceChar >> digit -- page number state <- getState - if optionStrict (stateOptions state) + if readerStrict (stateOptions state) then do many1 digit char '.' spaceChar @@ -695,7 +695,7 @@ para = try $ do option (Plain result) $ try $ do newline blanklines <|> - (getState >>= guard . optionStrict . stateOptions >> + (getState >>= guard . readerStrict . stateOptions >> lookAhead (blockQuote <|> header) >> return "") return $ Para result @@ -1009,7 +1009,7 @@ escapedChar' :: Parser [Char] ParserState Char escapedChar' = try $ do char '\\' state <- getState - if optionStrict (stateOptions state) + if readerStrict (stateOptions state) then oneOf "\\`*_{}[]()>#+-.!~" else satisfy (not . isAlphaNum) @@ -1024,7 +1024,7 @@ escapedChar = do ltSign :: Parser [Char] ParserState Inline ltSign = do st <- getState - if optionStrict (stateOptions st) + if readerStrict (stateOptions st) then char '<' else notFollowedBy' rawHtmlBlocks >> char '<' -- unless it starts html return $ Str ['<'] @@ -1160,7 +1160,7 @@ nonEndline = satisfy (/='\n') str :: Parser [Char] ParserState Inline str = do - smart <- (optionSmart . stateOptions) `fmap` getState + smart <- (readerSmart . stateOptions) `fmap` getState a <- alphaNum as <- many $ alphaNum <|> (try $ char '_' >>~ lookAhead alphaNum) @@ -1201,7 +1201,7 @@ endline = try $ do newline notFollowedBy blankline st <- getState - when (optionStrict (stateOptions st)) $ do + when (readerStrict (stateOptions st)) $ do notFollowedBy emailBlockQuoteStart notFollowedBy (char '#') -- atx header -- parse potential list-starts differently if in a list: @@ -1283,7 +1283,7 @@ autoLink = try $ do (orig, src) <- uri <|> emailAddress char '>' st <- getState - return $ if optionStrict (stateOptions st) + return $ if readerStrict (stateOptions st) then Link [Str orig] (src, "") else Link [Code ("",["url"],[]) orig] (src, "") @@ -1344,7 +1344,7 @@ inBrackets parser = do rawHtmlInline :: Parser [Char] ParserState Inline rawHtmlInline = do st <- getState - (_,result) <- if optionStrict (stateOptions st) + (_,result) <- if readerStrict (stateOptions st) then htmlTag (not . isTextTag) else htmlTag isInlineTag return $ RawInline "html" result diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 5373672b0..4522a7d95 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -80,7 +80,7 @@ parseTextile = do -- textile allows raw HTML and does smart punctuation by default oldOpts <- stateOptions `fmap` getState updateState $ \state -> state { stateParseRaw = True - , stateOptions = oldOpts{ optionSmart = True } + , stateOptions = oldOpts{ readerSmart = True } } many blankline startPos <- getPosition -- cgit v1.2.3