From 00dc1e715e6317ab499c864137bb2a6bf7a75364 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 26 Jul 2012 22:59:56 -0700 Subject: Moved WriterOptions and associated types Shared -> Options. --- MakeManPage.hs | 4 +- benchmark/benchmark-pandoc.hs | 4 +- src/Text/Pandoc.hs | 7 -- src/Text/Pandoc/Options.hs | 121 ++++++++++++++++++++++++++++++ src/Text/Pandoc/Shared.hs | 128 -------------------------------- src/Text/Pandoc/Writers/AsciiDoc.hs | 1 + src/Text/Pandoc/Writers/ConTeXt.hs | 1 + src/Text/Pandoc/Writers/Docbook.hs | 1 + src/Text/Pandoc/Writers/Docx.hs | 1 + src/Text/Pandoc/Writers/EPUB.hs | 7 +- src/Text/Pandoc/Writers/FB2.hs | 10 +-- src/Text/Pandoc/Writers/HTML.hs | 1 + src/Text/Pandoc/Writers/LaTeX.hs | 1 + src/Text/Pandoc/Writers/Man.hs | 1 + src/Text/Pandoc/Writers/Markdown.hs | 1 + src/Text/Pandoc/Writers/MediaWiki.hs | 1 + src/Text/Pandoc/Writers/Native.hs | 2 +- src/Text/Pandoc/Writers/ODT.hs | 2 +- src/Text/Pandoc/Writers/OpenDocument.hs | 2 +- src/Text/Pandoc/Writers/Org.hs | 1 + src/Text/Pandoc/Writers/RST.hs | 1 + src/Text/Pandoc/Writers/RTF.hs | 1 + src/Text/Pandoc/Writers/Texinfo.hs | 1 + src/Text/Pandoc/Writers/Textile.hs | 1 + src/pandoc.hs | 2 +- tests/Tests/Helpers.hs | 12 ++- tests/Tests/Old.hs | 5 +- tests/Tests/Readers/Markdown.hs | 2 +- tests/Tests/Writers/ConTeXt.hs | 5 +- tests/Tests/Writers/HTML.hs | 2 +- tests/Tests/Writers/LaTeX.hs | 2 +- tests/Tests/Writers/Markdown.hs | 2 +- tests/Tests/Writers/Native.hs | 4 +- 33 files changed, 167 insertions(+), 170 deletions(-) diff --git a/MakeManPage.hs b/MakeManPage.hs index 517386e7c..31d643e49 100644 --- a/MakeManPage.hs +++ b/MakeManPage.hs @@ -38,8 +38,8 @@ makeManPage verbose page meta blocks = do writeManPage :: FilePath -> String -> Pandoc -> IO () writeManPage page templ doc = do - let opts = defaultWriterOptions{ writerStandalone = True - , writerTemplate = templ } + let opts = def{ writerStandalone = True + , writerTemplate = templ } let manPage = writeMan opts $ bottomUp (concatMap removeLinks) $ bottomUp capitalizeHeaders doc diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs index 9e28dd30f..8c0c70a9b 100644 --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -11,7 +11,7 @@ readerBench doc (name, reader) = let writer = case lookup name writers of Just (PureStringWriter w) -> w _ -> error $ "Could not find writer for " ++ name - inp = writer defaultWriterOptions{ writerWrapText = True + inp = writer def{ writerWrapText = True , writerLiterateHaskell = "+lhs" `isSuffixOf` name } doc -- we compute the length to force full evaluation @@ -26,7 +26,7 @@ writerBench :: Pandoc -> (String, WriterOptions -> Pandoc -> String) -> Benchmark writerBench doc (name, writer) = bench (name ++ " writer") $ nf - (writer defaultWriterOptions{ + (writer def{ writerWrapText = True , writerLiterateHaskell = "+lhs" `isSuffixOf` name }) doc diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index c319b376a..15633b0e5 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -95,12 +95,6 @@ module Text.Pandoc , writeFB2 , writeOrg , writeAsciiDoc - -- * Writer options used in writers - , WriterOptions (..) - , HTMLSlideVariant (..) - , HTMLMathMethod (..) - , CiteMethod (..) - , defaultWriterOptions -- * Rendering templates and default templates , module Text.Pandoc.Templates -- * Version @@ -140,7 +134,6 @@ import Text.Pandoc.Writers.Textile import Text.Pandoc.Writers.Org import Text.Pandoc.Writers.AsciiDoc import Text.Pandoc.Templates -import Text.Pandoc.Shared import Text.Pandoc.Options import Data.ByteString.Lazy (ByteString) import Data.Version (showVersion) diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index cf1143067..ef4f18633 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -30,11 +30,17 @@ options. -} module Text.Pandoc.Options ( Extension(..) , ReaderOptions(..) + , HTMLMathMethod (..) + , CiteMethod (..) + , ObfuscationMethod (..) + , HTMLSlideVariant (..) + , WriterOptions (..) , def ) where import Data.Set (Set) import qualified Data.Set as Set import Data.Default +import Text.Pandoc.Highlighting (Style, pygments) -- | Individually selectable syntax extensions. data Extension = Ext_footnotes @@ -99,3 +105,118 @@ instance Default ReaderOptions , readerApplyMacros = True , readerIndentedCodeClasses = [] } + +-- +-- Writer options +-- + +data HTMLMathMethod = PlainMath + | LaTeXMathML (Maybe String) -- url of LaTeXMathML.js + | JsMath (Maybe String) -- url of jsMath load script + | GladTeX + | WebTeX String -- url of TeX->image script. + | MathML (Maybe String) -- url of MathMLinHTML.js + | MathJax String -- url of MathJax.js + deriving (Show, Read, Eq) + +data CiteMethod = Citeproc -- use citeproc to render them + | Natbib -- output natbib cite commands + | Biblatex -- output biblatex cite commands + deriving (Show, Read, Eq) + +-- | Methods for obfuscating email addresses in HTML. +data ObfuscationMethod = NoObfuscation + | ReferenceObfuscation + | JavascriptObfuscation + deriving (Show, Read, Eq) + +-- | Varieties of HTML slide shows. +data HTMLSlideVariant = S5Slides + | SlidySlides + | SlideousSlides + | DZSlides + | NoSlides + deriving (Show, Read, Eq) + +-- | Options for writers +{-# DEPRECATED writerXeTeX "writerXeTeX no longer does anything" #-} +data WriterOptions = WriterOptions + { writerStandalone :: Bool -- ^ Include header and footer + , writerTemplate :: String -- ^ Template to use in standalone mode + , writerVariables :: [(String, String)] -- ^ Variables to set in template + , writerEPUBMetadata :: String -- ^ Metadata to include in EPUB + , writerTabStop :: Int -- ^ Tabstop for conversion btw spaces and tabs + , writerTableOfContents :: Bool -- ^ Include table of contents + , writerSlideVariant :: HTMLSlideVariant -- ^ Are we writing S5, Slidy or Slideous? + , writerIncremental :: Bool -- ^ True if lists should be incremental + , writerXeTeX :: Bool -- ^ Create latex suitable for use by xetex + , writerHTMLMathMethod :: HTMLMathMethod -- ^ How to print math in HTML + , writerIgnoreNotes :: Bool -- ^ Ignore footnotes (used in making toc) + , writerNumberSections :: Bool -- ^ Number sections in LaTeX + , writerSectionDivs :: Bool -- ^ Put sections in div tags in HTML + , writerStrictMarkdown :: Bool -- ^ Use strict markdown syntax + , 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 + , writerUserDataDir :: Maybe FilePath -- ^ Path of user data directory + , writerCiteMethod :: CiteMethod -- ^ How to print cites + , writerBiblioFiles :: [FilePath] -- ^ Biblio files to use for citations + , writerHtml5 :: Bool -- ^ Produce HTML5 + , writerBeamer :: Bool -- ^ Produce beamer LaTeX slide show + , writerSlideLevel :: Maybe Int -- ^ Force header level of slides + , writerChapters :: Bool -- ^ Use "chapter" for top-level sects + , writerListings :: Bool -- ^ Use listings package for code + , writerHighlight :: Bool -- ^ Highlight source code + , writerHighlightStyle :: Style -- ^ Style to use for highlighting + , writerSetextHeaders :: Bool -- ^ Use setext headers for levels 1-2 in markdown + , writerTeXLigatures :: Bool -- ^ Use tex ligatures quotes, dashes in latex + , writerEpubStylesheet :: Maybe String -- ^ EPUB stylesheet specified at command line + , writerEpubFonts :: [FilePath] -- ^ Paths to fonts to embed + , writerReferenceODT :: Maybe FilePath -- ^ Path to reference ODT if specified + , writerReferenceDocx :: Maybe FilePath -- ^ Ptah to reference DOCX if specified + } deriving Show + +instance Default WriterOptions where + def = WriterOptions { writerStandalone = False + , writerTemplate = "" + , writerVariables = [] + , writerEPUBMetadata = "" + , writerTabStop = 4 + , writerTableOfContents = False + , writerSlideVariant = NoSlides + , writerIncremental = False + , writerXeTeX = False + , writerHTMLMathMethod = PlainMath + , writerIgnoreNotes = False + , writerNumberSections = False + , writerSectionDivs = False + , writerStrictMarkdown = False + , writerReferenceLinks = False + , writerWrapText = True + , writerColumns = 72 + , writerLiterateHaskell = False + , writerEmailObfuscation = JavascriptObfuscation + , writerIdentifierPrefix = "" + , writerSourceDirectory = "." + , writerUserDataDir = Nothing + , writerCiteMethod = Citeproc + , writerBiblioFiles = [] + , writerHtml5 = False + , writerBeamer = False + , writerSlideLevel = Nothing + , writerChapters = False + , writerListings = False + , writerHighlight = False + , writerHighlightStyle = pygments + , writerSetextHeaders = True + , writerTeXLigatures = True + , writerEpubStylesheet = Nothing + , writerEpubFonts = [] + , writerReferenceODT = Nothing + , writerReferenceDocx = Nothing + } + diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 724fa5cae..f3ec43a06 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -59,13 +59,6 @@ module Text.Pandoc.Shared ( uniqueIdent, isHeaderBlock, headerShift, - -- * Writer options - HTMLMathMethod (..), - CiteMethod (..), - ObfuscationMethod (..), - HTMLSlideVariant (..), - WriterOptions (..), - defaultWriterOptions, -- * File handling inDirectory, findDataFile, @@ -90,11 +83,9 @@ import Data.Generics (Typeable, Data) import qualified Control.Monad.State as S import Control.Monad (msum) import Paths_pandoc (getDataFileName) -import Text.Pandoc.Highlighting (Style, pygments) import Text.Pandoc.Pretty (charWidth) import System.Locale (defaultTimeLocale) import Data.Time -import Data.Default import System.IO (stderr) -- @@ -455,125 +446,6 @@ headerShift n = bottomUp shift shift (Header level inner) = Header (level + n) inner shift x = x --- --- Writer options --- - -data HTMLMathMethod = PlainMath - | LaTeXMathML (Maybe String) -- url of LaTeXMathML.js - | JsMath (Maybe String) -- url of jsMath load script - | GladTeX - | WebTeX String -- url of TeX->image script. - | MathML (Maybe String) -- url of MathMLinHTML.js - | MathJax String -- url of MathJax.js - deriving (Show, Read, Eq) - -data CiteMethod = Citeproc -- use citeproc to render them - | Natbib -- output natbib cite commands - | Biblatex -- output biblatex cite commands - deriving (Show, Read, Eq) - --- | Methods for obfuscating email addresses in HTML. -data ObfuscationMethod = NoObfuscation - | ReferenceObfuscation - | JavascriptObfuscation - deriving (Show, Read, Eq) - --- | Varieties of HTML slide shows. -data HTMLSlideVariant = S5Slides - | SlidySlides - | SlideousSlides - | DZSlides - | NoSlides - deriving (Show, Read, Eq) - --- | Options for writers -data WriterOptions = WriterOptions - { writerStandalone :: Bool -- ^ Include header and footer - , writerTemplate :: String -- ^ Template to use in standalone mode - , writerVariables :: [(String, String)] -- ^ Variables to set in template - , writerEPUBMetadata :: String -- ^ Metadata to include in EPUB - , writerTabStop :: Int -- ^ Tabstop for conversion btw spaces and tabs - , writerTableOfContents :: Bool -- ^ Include table of contents - , writerSlideVariant :: HTMLSlideVariant -- ^ Are we writing S5, Slidy or Slideous? - , writerIncremental :: Bool -- ^ True if lists should be incremental - , writerXeTeX :: Bool -- ^ Create latex suitable for use by xetex - , writerHTMLMathMethod :: HTMLMathMethod -- ^ How to print math in HTML - , writerIgnoreNotes :: Bool -- ^ Ignore footnotes (used in making toc) - , writerNumberSections :: Bool -- ^ Number sections in LaTeX - , writerSectionDivs :: Bool -- ^ Put sections in div tags in HTML - , writerStrictMarkdown :: Bool -- ^ Use strict markdown syntax - , 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 - , writerUserDataDir :: Maybe FilePath -- ^ Path of user data directory - , writerCiteMethod :: CiteMethod -- ^ How to print cites - , writerBiblioFiles :: [FilePath] -- ^ Biblio files to use for citations - , writerHtml5 :: Bool -- ^ Produce HTML5 - , writerBeamer :: Bool -- ^ Produce beamer LaTeX slide show - , writerSlideLevel :: Maybe Int -- ^ Force header level of slides - , writerChapters :: Bool -- ^ Use "chapter" for top-level sects - , writerListings :: Bool -- ^ Use listings package for code - , writerHighlight :: Bool -- ^ Highlight source code - , writerHighlightStyle :: Style -- ^ Style to use for highlighting - , writerSetextHeaders :: Bool -- ^ Use setext headers for levels 1-2 in markdown - , writerTeXLigatures :: Bool -- ^ Use tex ligatures quotes, dashes in latex - , writerEpubStylesheet :: Maybe String -- ^ EPUB stylesheet specified at command line - , writerEpubFonts :: [FilePath] -- ^ Paths to fonts to embed - , writerReferenceODT :: Maybe FilePath -- ^ Path to reference ODT if specified - , writerReferenceDocx :: Maybe FilePath -- ^ Ptah to reference DOCX if specified - } deriving Show - -instance Default WriterOptions where - def = defaultWriterOptions - -{-# DEPRECATED writerXeTeX "writerXeTeX no longer does anything" #-} --- | Default writer options. -defaultWriterOptions :: WriterOptions -defaultWriterOptions = - WriterOptions { writerStandalone = False - , writerTemplate = "" - , writerVariables = [] - , writerEPUBMetadata = "" - , writerTabStop = 4 - , writerTableOfContents = False - , writerSlideVariant = NoSlides - , writerIncremental = False - , writerXeTeX = False - , writerHTMLMathMethod = PlainMath - , writerIgnoreNotes = False - , writerNumberSections = False - , writerSectionDivs = False - , writerStrictMarkdown = False - , writerReferenceLinks = False - , writerWrapText = True - , writerColumns = 72 - , writerLiterateHaskell = False - , writerEmailObfuscation = JavascriptObfuscation - , writerIdentifierPrefix = "" - , writerSourceDirectory = "." - , writerUserDataDir = Nothing - , writerCiteMethod = Citeproc - , writerBiblioFiles = [] - , writerHtml5 = False - , writerBeamer = False - , writerSlideLevel = Nothing - , writerChapters = False - , writerListings = False - , writerHighlight = False - , writerHighlightStyle = pygments - , writerSetextHeaders = True - , writerTeXLigatures = True - , writerEpubStylesheet = Nothing - , writerEpubFonts = [] - , writerReferenceODT = Nothing - , writerReferenceDocx = Nothing - } - -- -- File handling -- diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 1ccfab6e6..e314cf70e 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -40,6 +40,7 @@ module Text.Pandoc.Writers.AsciiDoc (writeAsciiDoc) where import Text.Pandoc.Definition import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (blankline, space) import Data.List ( isPrefixOf, intersperse, intercalate ) import Text.Pandoc.Pretty diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index fb832c7f5..df11d79cc 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -31,6 +31,7 @@ Conversion of 'Pandoc' format into ConTeXt. module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where import Text.Pandoc.Definition import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.Generic (queryWith) import Text.Printf ( printf ) import Data.List ( intercalate ) diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 74bc0a366..b31eb976f 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -31,6 +31,7 @@ module Text.Pandoc.Writers.Docbook ( writeDocbook) where import Text.Pandoc.Definition import Text.Pandoc.XML import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Readers.TeXMath import Data.List ( isPrefixOf, intercalate, isSuffixOf ) diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 63329bb44..dc1aa34b8 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -43,6 +43,7 @@ import Text.Pandoc.Generic import System.Directory import Text.Pandoc.ImageSize import Text.Pandoc.Shared hiding (Element) +import Text.Pandoc.Options import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Highlighting ( highlight ) import Text.Highlighting.Kate.Types () diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 27356f072..9a6f9670f 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -38,6 +38,7 @@ import Data.ByteString.Lazy.UTF8 ( fromString ) import Codec.Archive.Zip import Data.Time.Clock.POSIX import Text.Pandoc.Shared hiding ( Element ) +import Text.Pandoc.Options import Text.Pandoc.Definition import Text.Pandoc.Generic import Control.Monad.State @@ -286,10 +287,8 @@ transformInlines _ sourceDir picsRef (Image lab (src,tit) : xs) = do transformInlines (MathML _) _ _ (x@(Math _ _) : xs) = do let writeHtmlInline opts z = removeTrailingSpace $ writeHtmlString opts $ Pandoc (Meta [] [] []) [Plain [z]] - mathml = writeHtmlInline defaultWriterOptions{ - writerHTMLMathMethod = MathML Nothing } x - fallback = writeHtmlInline defaultWriterOptions{ - writerHTMLMathMethod = PlainMath } x + mathml = writeHtmlInline def{writerHTMLMathMethod = MathML Nothing } x + fallback = writeHtmlInline def{writerHTMLMathMethod = PlainMath } x inOps = "" ++ "" ++ mathml ++ "" ++ fallback ++ "" ++ diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 0fbfb3968..301d80c54 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -43,8 +43,8 @@ import qualified Text.XML.Light as X import qualified Text.XML.Light.Cursor as XC import Text.Pandoc.Definition -import Text.Pandoc.Shared (WriterOptions(..), HTMLMathMethod(..)) -import Text.Pandoc.Shared (orderedListMarkers, defaultWriterOptions) +import Text.Pandoc.Options (WriterOptions(..), HTMLMathMethod(..), def) +import Text.Pandoc.Shared (orderedListMarkers) import Text.Pandoc.Generic (bottomUp) -- | Data to be written at the end of the document: @@ -63,7 +63,7 @@ type FBM = StateT FbRenderState IO newFB :: FbRenderState newFB = FbRenderState { footnotes = [], imagesToFetch = [] , parentListMarker = "", parentBulletLevel = 0 - , writerOptions = defaultWriterOptions } + , writerOptions = def } data ImageMode = NormalImage | InlineImage deriving (Eq) instance Show ImageMode where @@ -350,9 +350,9 @@ blockToXml (DefinitionList defs) = cMapM mkdef defs where mkdef (term, bss) = do - def <- cMapM (cMapM blockToXml . sep . paraToPlain . map indent) bss + def' <- cMapM (cMapM blockToXml . sep . paraToPlain . map indent) bss t <- wrap "strong" term - return [ el "p" t, el "p" def ] + return [ el "p" t, el "p" def' ] sep blocks = if all needsBreak blocks then blocks ++ [Plain [LineBreak]] diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index c7bab7260..a5f85921c 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -32,6 +32,7 @@ Conversion of 'Pandoc' documents to HTML. module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where import Text.Pandoc.Definition import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.Templates import Text.Pandoc.Generic import Text.Pandoc.Readers.TeXMath diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 7beee2d42..edd0bf9e2 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -32,6 +32,7 @@ module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where import Text.Pandoc.Definition import Text.Pandoc.Generic import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.Templates import Text.Printf ( printf ) import Network.URI ( isAbsoluteURI, unEscapeString ) diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index f6f570042..b3a4656a3 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -32,6 +32,7 @@ module Text.Pandoc.Writers.Man ( writeMan) where import Text.Pandoc.Definition import Text.Pandoc.Templates import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.Readers.TeXMath import Text.Printf ( printf ) import Data.List ( isPrefixOf, intersperse, intercalate ) diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 80f51dfc6..3a0f586db 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Generic import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.Parsing hiding (blankline, char, space) import Data.List ( group, isPrefixOf, find, intersperse, transpose ) import Text.Pandoc.Pretty diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index a9e2a2c69..6af2febf5 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -31,6 +31,7 @@ MediaWiki: -} module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where import Text.Pandoc.Definition +import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.XML ( escapeStringForXML ) diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 8b3148273..7fb304e86 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -34,7 +34,7 @@ metadata. -} module Text.Pandoc.Writers.Native ( writeNative ) where -import Text.Pandoc.Shared ( WriterOptions(..) ) +import Text.Pandoc.Options ( WriterOptions(..) ) import Data.List ( intersperse ) import Text.Pandoc.Definition import Text.Pandoc.Pretty diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index de397d817..0d68f4fdd 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -36,7 +36,7 @@ import Data.ByteString.Lazy.UTF8 ( fromString ) import Codec.Archive.Zip import Data.Time.Clock.POSIX import Paths_pandoc ( getDataFileName ) -import Text.Pandoc.Shared ( WriterOptions(..) ) +import Text.Pandoc.Options ( WriterOptions(..) ) import Text.Pandoc.ImageSize ( readImageSize, sizeInPoints ) import Text.Pandoc.MIME ( getMimeType ) import Text.Pandoc.Definition diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index a0317511a..027ddfda1 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -31,7 +31,7 @@ Conversion of 'Pandoc' documents to OpenDocument XML. -} module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where import Text.Pandoc.Definition -import Text.Pandoc.Shared +import Text.Pandoc.Options import Text.Pandoc.XML import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Readers.TeXMath diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 1bb4b5449..383a897b5 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -32,6 +32,7 @@ Org-Mode: -} module Text.Pandoc.Writers.Org ( writeOrg) where import Text.Pandoc.Definition +import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Pretty import Text.Pandoc.Templates (renderTemplate) diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index d04fe4113..0c46cb0bc 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -32,6 +32,7 @@ reStructuredText: -} module Text.Pandoc.Writers.RST ( writeRST) where import Text.Pandoc.Definition +import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Data.List ( isPrefixOf, intersperse, transpose ) diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 5ab71c8d6..1919eb3f2 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -29,6 +29,7 @@ Conversion of 'Pandoc' documents to RTF (rich text format). -} module Text.Pandoc.Writers.RTF ( writeRTF, rtfEmbedImage ) where import Text.Pandoc.Definition +import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Templates (renderTemplate) diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index e85013162..e0ff24f8c 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -29,6 +29,7 @@ Conversion of 'Pandoc' format into Texinfo. -} module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where import Text.Pandoc.Definition +import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Printf ( printf ) diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index e3711911b..5f3bb6bcd 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -31,6 +31,7 @@ Textile: -} module Text.Pandoc.Writers.Textile ( writeTextile ) where import Text.Pandoc.Definition +import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.XML ( escapeStringForXML ) diff --git a/src/pandoc.hs b/src/pandoc.hs index 196e1a146..2a7950fe7 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -33,7 +33,7 @@ module Main where import Text.Pandoc import Text.Pandoc.PDF (tex2pdf) import Text.Pandoc.Readers.LaTeX (handleIncludes) -import Text.Pandoc.Shared ( tabFilter, ObfuscationMethod (..), readDataFile, +import Text.Pandoc.Shared ( tabFilter, readDataFile, headerShift, findDataFile, normalize, err, warn ) import Text.Pandoc.XML ( toEntities, fromEntities ) import Text.Pandoc.SelfContained ( makeSelfContained ) diff --git a/tests/Tests/Helpers.hs b/tests/Tests/Helpers.hs index 66879efed..86a92fb0c 100644 --- a/tests/Tests/Helpers.hs +++ b/tests/Tests/Helpers.hs @@ -17,8 +17,8 @@ import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit (assertBool) -import Text.Pandoc.Shared (normalize, defaultWriterOptions, - WriterOptions(..), removeTrailingSpace) +import Text.Pandoc.Shared (normalize, removeTrailingSpace) +import Text.Pandoc.Options import Text.Pandoc.Writers.Native (writeNative) import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Language.Haskell.TH.Syntax (Q, runIO) @@ -85,18 +85,16 @@ class ToString a where toString :: a -> String instance ToString Pandoc where - toString d = writeNative defaultWriterOptions{ writerStandalone = s } - $ toPandoc d + toString d = writeNative def{ writerStandalone = s } $ toPandoc d where s = case d of (Pandoc (Meta [] [] []) _) -> False _ -> True instance ToString Blocks where - toString = writeNative defaultWriterOptions . toPandoc + toString = writeNative def . toPandoc instance ToString Inlines where - toString = removeTrailingSpace . writeNative defaultWriterOptions . - toPandoc + toString = removeTrailingSpace . writeNative def . toPandoc instance ToString String where toString = id diff --git a/tests/Tests/Old.hs b/tests/Tests/Old.hs index e60f390df..8899fef6f 100644 --- a/tests/Tests/Old.hs +++ b/tests/Tests/Old.hs @@ -10,7 +10,8 @@ import System.FilePath ( (), (<.>) ) import System.Directory import System.Exit import Data.Algorithm.Diff -import Text.Pandoc.Shared ( normalize, defaultWriterOptions ) +import Text.Pandoc.Shared ( normalize ) +import Text.Pandoc.Options import Text.Pandoc.Writers.Native ( writeNative ) import Text.Pandoc.Readers.Native ( readNative ) import Prelude hiding ( readFile ) @@ -142,7 +143,7 @@ lhsReaderTest :: String -> Test lhsReaderTest format = testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"] ("lhs-test" <.> format) "lhs-test.native" - where normalizer = writeNative defaultWriterOptions . normalize . readNative + where normalizer = writeNative def . normalize . readNative writerTests :: String -> [Test] writerTests format diff --git a/tests/Tests/Readers/Markdown.hs b/tests/Tests/Readers/Markdown.hs index 543802795..dbb96c15f 100644 --- a/tests/Tests/Readers/Markdown.hs +++ b/tests/Tests/Readers/Markdown.hs @@ -26,7 +26,7 @@ p_markdown_round_trip b = matches d' d'' where d' = normalize $ Pandoc (Meta [] [] []) [b] d'' = normalize $ readMarkdown def { readerSmart = True } - $ writeMarkdown defaultWriterOptions d' + $ writeMarkdown def d' matches (Pandoc _ [Plain []]) (Pandoc _ []) = True matches (Pandoc _ [Para []]) (Pandoc _ []) = True matches (Pandoc _ [Plain xs]) (Pandoc _ [Para xs']) = xs == xs' diff --git a/tests/Tests/Writers/ConTeXt.hs b/tests/Tests/Writers/ConTeXt.hs index beb6411f0..2cb8ececa 100644 --- a/tests/Tests/Writers/ConTeXt.hs +++ b/tests/Tests/Writers/ConTeXt.hs @@ -8,11 +8,10 @@ import Tests.Helpers import Tests.Arbitrary() context :: (ToString a, ToPandoc a) => a -> String -context = writeConTeXt defaultWriterOptions . toPandoc +context = writeConTeXt def . toPandoc context' :: (ToString a, ToPandoc a) => a -> String -context' = writeConTeXt defaultWriterOptions{ writerWrapText = False } - . toPandoc +context' = writeConTeXt def{ writerWrapText = False } . toPandoc {- "my test" =: X =?> Y diff --git a/tests/Tests/Writers/HTML.hs b/tests/Tests/Writers/HTML.hs index 8561aa421..5d6e301c5 100644 --- a/tests/Tests/Writers/HTML.hs +++ b/tests/Tests/Writers/HTML.hs @@ -9,7 +9,7 @@ import Tests.Arbitrary() import Text.Pandoc.Highlighting (languages) -- null if no hl support html :: (ToString a, ToPandoc a) => a -> String -html = writeHtmlString defaultWriterOptions{ writerWrapText = False } . toPandoc +html = writeHtmlString def{ writerWrapText = False } . toPandoc {- "my test" =: X =?> Y diff --git a/tests/Tests/Writers/LaTeX.hs b/tests/Tests/Writers/LaTeX.hs index 7987716f3..16e0c3f23 100644 --- a/tests/Tests/Writers/LaTeX.hs +++ b/tests/Tests/Writers/LaTeX.hs @@ -8,7 +8,7 @@ import Tests.Helpers import Tests.Arbitrary() latex :: (ToString a, ToPandoc a) => a -> String -latex = writeLaTeX defaultWriterOptions . toPandoc +latex = writeLaTeX def . toPandoc {- "my test" =: X =?> Y diff --git a/tests/Tests/Writers/Markdown.hs b/tests/Tests/Writers/Markdown.hs index d90dc83b1..22ce8b27c 100644 --- a/tests/Tests/Writers/Markdown.hs +++ b/tests/Tests/Writers/Markdown.hs @@ -8,7 +8,7 @@ import Tests.Helpers import Tests.Arbitrary() markdown :: (ToString a, ToPandoc a) => a -> String -markdown = writeMarkdown defaultWriterOptions . toPandoc +markdown = writeMarkdown def . toPandoc {- "my test" =: X =?> Y diff --git a/tests/Tests/Writers/Native.hs b/tests/Tests/Writers/Native.hs index 19740e0f4..e199cf94e 100644 --- a/tests/Tests/Writers/Native.hs +++ b/tests/Tests/Writers/Native.hs @@ -8,11 +8,11 @@ import Tests.Arbitrary() p_write_rt :: Pandoc -> Bool p_write_rt d = - read (writeNative defaultWriterOptions{ writerStandalone = True } d) == d + read (writeNative def{ writerStandalone = True } d) == d p_write_blocks_rt :: [Block] -> Bool p_write_blocks_rt bs = length bs > 20 || - read (writeNative defaultWriterOptions (Pandoc (Meta [] [] []) bs)) == + read (writeNative def (Pandoc (Meta [] [] []) bs)) == bs tests :: [Test] -- cgit v1.2.3