From acde1e82d2f070ceab8d0fd01ad3677c6c9e078c Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 25 Jul 2012 22:35:41 -0700 Subject: Changed reader parameters from ParserState to ReaderOptions. --- src/Text/Pandoc.hs | 35 ++++++++--------------------------- src/Text/Pandoc/Options.hs | 1 + src/Text/Pandoc/Readers/DocBook.hs | 4 ++-- src/Text/Pandoc/Readers/HTML.hs | 6 +++--- src/Text/Pandoc/Readers/LaTeX.hs | 4 ++-- src/Text/Pandoc/Readers/Markdown.hs | 7 ++++--- src/Text/Pandoc/Readers/RST.hs | 8 ++++---- src/Text/Pandoc/Readers/Textile.hs | 16 ++++++++-------- 8 files changed, 32 insertions(+), 49 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 95fec7360..c319b376a 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -43,8 +43,7 @@ inline links: > > markdownToRST :: String -> String > markdownToRST = -> (writeRST defaultWriterOptions {writerReferenceLinks = True}) . -> readMarkdown defaultParserState +> (writeRST def {writerReferenceLinks = True}) . readMarkdown def > > main = getContents >>= putStrLn . markdownToRST @@ -73,14 +72,6 @@ module Text.Pandoc , readTextile , readDocBook , readNative - -- * Parser state used in readers - , ParserState (..) - , defaultParserState - , ParserContext (..) - , QuoteContext (..) - , KeyTable - , NoteTable - , HeaderType (..) -- * Writers: converting /from/ Pandoc format , Writer (..) , writeNative @@ -118,8 +109,6 @@ module Text.Pandoc , rtfEmbedImage , jsonFilter , ToJsonFilter(..) - -- * From Data.Default - , def ) where import Text.Pandoc.Definition @@ -151,41 +140,33 @@ import Text.Pandoc.Writers.Textile import Text.Pandoc.Writers.Org import Text.Pandoc.Writers.AsciiDoc import Text.Pandoc.Templates -import Text.Pandoc.Parsing import Text.Pandoc.Shared import Text.Pandoc.Options import Data.ByteString.Lazy (ByteString) import Data.Version (showVersion) import Text.JSON.Generic import Paths_pandoc (version) -import Data.Default -- | Version number of pandoc library. pandocVersion :: String pandocVersion = showVersion version -- | Association list of formats and readers. -readers :: [(String, ParserState -> String -> Pandoc)] +readers :: [(String, ReaderOptions -> String -> Pandoc)] readers = [("native" , \_ -> readNative) ,("json" , \_ -> decodeJSON) ,("markdown" , readMarkdown) - ,("markdown+lhs" , \st -> - readMarkdown st{ stateOptions = - let oldopts = stateOptions st - in oldopts{ readerLiterateHaskell = True} }) + ,("markdown+lhs" , \opt -> + readMarkdown opt{ readerLiterateHaskell = True }) ,("rst" , readRST) - ,("rst+lhs" , \st -> - readRST st{ stateOptions = - let oldopts = stateOptions st - in oldopts{ readerLiterateHaskell = True} }) + ,("rst+lhs" , \opt -> + readRST opt{ readerLiterateHaskell = True }) ,("docbook" , readDocBook) ,("textile" , readTextile) -- TODO : textile+lhs ,("html" , readHtml) ,("latex" , readLaTeX) - ,("latex+lhs" , \st -> - readLaTeX st{ stateOptions = - let oldopts = stateOptions st - in oldopts{ readerLiterateHaskell = True} }) + ,("latex+lhs" , \opt -> + readLaTeX opt{ readerLiterateHaskell = True }) ] data Writer = PureStringWriter (WriterOptions -> Pandoc -> String) diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 189adfa24..88fdbfb00 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -30,6 +30,7 @@ options. -} module Text.Pandoc.Options ( Extension(..) , ReaderOptions(..) + , def ) where import Data.Set (Set) import qualified Data.Set as Set diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index 62f7c61a0..b8cddcab3 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -1,6 +1,6 @@ module Text.Pandoc.Readers.DocBook ( readDocBook ) where import Data.Char (toUpper, isDigit) -import Text.Pandoc.Parsing (ParserState(..)) +import Text.Pandoc.Options import Text.Pandoc.Definition import Text.Pandoc.Builder import Text.XML.Light @@ -503,7 +503,7 @@ data DBState = DBState{ dbSectionLevel :: Int , dbBook :: Bool } deriving Show -readDocBook :: ParserState -> String -> Pandoc +readDocBook :: ReaderOptions -> String -> Pandoc readDocBook _ inp = setTitle (dbDocTitle st') $ setAuthors (dbDocAuthors st') $ setDate (dbDocDate st') diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 8c64ebe57..96ad9ce20 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -55,11 +55,11 @@ isSpace '\n' = True isSpace _ = False -- | Convert HTML-formatted string to 'Pandoc' document. -readHtml :: ParserState -- ^ Parser state +readHtml :: ReaderOptions -- ^ Reader options -> String -- ^ String to parse (assumes @'\n'@ line endings) -> Pandoc -readHtml st inp = Pandoc meta blocks - where blocks = readWith parseBody st rest +readHtml opts inp = Pandoc meta blocks + where blocks = readWith parseBody def{ stateOptions = opts } rest tags = canonicalizeTags $ parseTagsOptions parseOptions{ optTagPosition = True } inp hasHeader = any (~== TagOpen "head" []) tags diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 6d4b9d29e..8d6c71746 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -50,10 +50,10 @@ import qualified Data.Map as M import qualified Control.Exception as E -- | Parse LaTeX from string and return 'Pandoc' document. -readLaTeX :: ParserState -- ^ Parser state, including options for parser +readLaTeX :: ReaderOptions -- ^ Reader options -> String -- ^ String to parse (assumes @'\n'@ line endings) -> Pandoc -readLaTeX = readWith parseLaTeX +readLaTeX opts = readWith parseLaTeX def{ stateOptions = opts } parseLaTeX :: LP Pandoc parseLaTeX = do diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 91f8e7c63..b51cee1a6 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -49,10 +49,11 @@ import Text.HTML.TagSoup import Text.HTML.TagSoup.Match (tagOpen) -- | Read markdown from an input string and return a Pandoc document. -readMarkdown :: ParserState -- ^ Parser state, including options for parser - -> String -- ^ String to parse (assuming @'\n'@ line endings) +readMarkdown :: ReaderOptions -- ^ Reader options + -> String -- ^ String to parse (assuming @'\n'@ line endings) -> Pandoc -readMarkdown state s = (readWith parseMarkdown) state (s ++ "\n\n") +readMarkdown opts s = + (readWith parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n") -- -- Constants and data structure definitions diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 11bcb7f0e..7b52993f9 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -27,7 +27,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Conversion from reStructuredText to 'Pandoc' document. -} -module Text.Pandoc.Readers.RST ( +module Text.Pandoc.Readers.RST ( readRST ) where import Text.Pandoc.Definition @@ -41,10 +41,10 @@ import Text.Printf ( printf ) import Data.Maybe ( catMaybes ) -- | Parse reStructuredText string and return Pandoc document. -readRST :: ParserState -- ^ Parser state, including options for parser - -> String -- ^ String to parse (assuming @'\n'@ line endings) +readRST :: ReaderOptions -- ^ Reader options + -> String -- ^ String to parse (assuming @'\n'@ line endings) -> Pandoc -readRST state s = (readWith parseRST) state (s ++ "\n\n") +readRST opts s = (readWith parseRST) def{ stateOptions = opts } (s ++ "\n\n") -- -- Constants and data structure definitions diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index e4537f33d..65aa144c2 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -56,7 +56,7 @@ TODO : refactor common patterns across readers : module Text.Pandoc.Readers.Textile ( readTextile) where import Text.Pandoc.Definition -import Text.Pandoc.Shared +import Text.Pandoc.Shared import Text.Pandoc.Options import Text.Pandoc.Parsing import Text.Pandoc.Readers.HTML ( htmlTag, isInlineTag, isBlockTag ) @@ -67,11 +67,11 @@ import Control.Monad ( guard, liftM ) import Control.Applicative ((<$>), (*>), (<*)) -- | Parse a Textile text and return a Pandoc document. -readTextile :: ParserState -- ^ Parser state, including options for parser - -> String -- ^ String to parse (assuming @'\n'@ line endings) - -> Pandoc -readTextile state s = - (readWith parseTextile) state (s ++ "\n\n") +readTextile :: ReaderOptions -- ^ Reader options + -> String -- ^ String to parse (assuming @'\n'@ line endings) + -> Pandoc +readTextile opts s = + (readWith parseTextile) def{ stateOptions = opts } (s ++ "\n\n") -- | Generate a Pandoc ADT from a textile document @@ -243,8 +243,8 @@ definitionListItem :: Parser [Char] ParserState ([Inline], [[Block]]) definitionListItem = try $ do string "- " term <- many1Till inline (try (whitespace >> string ":=")) - def <- inlineDef <|> multilineDef - return (term, def) + def' <- inlineDef <|> multilineDef + return (term, def') where inlineDef :: Parser [Char] ParserState [[Block]] inlineDef = liftM (\d -> [[Plain d]]) $ try (whitespace >> inlines) multilineDef :: Parser [Char] ParserState [[Block]] -- cgit v1.2.3