aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2016-11-26 08:46:28 -0500
committerJohn MacFarlane <jgm@berkeley.edu>2017-01-25 17:07:39 +0100
commit04487779b26458597fb751325b24c576b5088662 (patch)
tree0ee34da90dcfaee63b821ac68f8e0a40267d616a /src/Text
parentb19f79f672c49322328584fa339215e4234d98af (diff)
downloadpandoc-04487779b26458597fb751325b24c576b5088662.tar.gz
Convert all writers to use PandocMonad.
Since PandocMonad is an instance of MonadError, this will allow us, in a future commit, to change all invocations of `error` to `throwError`, which will be preferable for the pure versions. At the moment, we're disabling the lua custom writers (this is temporary). This requires changing the type of the Writer in Text.Pandoc. Right now, we run `runIOorExplode` in pandoc.hs, to make the conversion easier. We can switch it to the safer `runIO` in the future. Note that this required a change to Text.Pandoc.PDF as well. Since running an external program is necessarily IO, we can be clearer about using PandocIO.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc.hs216
-rw-r--r--src/Text/Pandoc/PDF.hs9
-rw-r--r--src/Text/Pandoc/Writers/AsciiDoc.hs5
-rw-r--r--src/Text/Pandoc/Writers/CommonMark.hs134
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs5
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs5
-rw-r--r--src/Text/Pandoc/Writers/DokuWiki.hs5
-rw-r--r--src/Text/Pandoc/Writers/EPUB.hs44
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs9
-rw-r--r--src/Text/Pandoc/Writers/Haddock.hs5
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs5
-rw-r--r--src/Text/Pandoc/Writers/Man.hs5
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs89
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs5
-rw-r--r--src/Text/Pandoc/Writers/Native.hs5
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs2
-rw-r--r--src/Text/Pandoc/Writers/OPML.hs50
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs5
-rw-r--r--src/Text/Pandoc/Writers/Org.hs5
-rw-r--r--src/Text/Pandoc/Writers/RST.hs5
-rw-r--r--src/Text/Pandoc/Writers/TEI.hs5
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs5
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs5
-rw-r--r--src/Text/Pandoc/Writers/ZimWiki.hs5
24 files changed, 375 insertions, 258 deletions
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs
index 703d0a002..5bb015fc2 100644
--- a/src/Text/Pandoc.hs
+++ b/src/Text/Pandoc.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, GADTs #-}
{-
Copyright (C) 2006-2016 John MacFarlane <jgm@berkeley.edu>
@@ -63,7 +63,8 @@ module Text.Pandoc
, module Text.Pandoc.Error
-- * Lists of readers and writers
, readers
- , writers
+ -- , writers
+ , writers'
-- * Readers: converting /to/ Pandoc format
, Reader (..)
, mkStringReader
@@ -87,7 +88,8 @@ module Text.Pandoc
, readTxt2TagsNoMacros
, readEPUB
-- * Writers: converting /from/ Pandoc format
- , Writer (..)
+ -- , Writer (..)
+ , Writer'(..)
, writeNative
, writeJSON
, writeMarkdown
@@ -122,7 +124,8 @@ module Text.Pandoc
, module Text.Pandoc.Templates
-- * Miscellaneous
, getReader
- , getWriter
+ -- , getWriter
+ , getWriter'
, getDefaultExtensions
, ToJsonFilter(..)
, pandocVersion
@@ -180,7 +183,7 @@ import Text.Pandoc.Options
import Text.Pandoc.Shared (safeRead, warn, mapLeft, pandocVersion)
import Text.Pandoc.MediaBag (MediaBag)
import Text.Pandoc.Error
-import Text.Pandoc.Class (runIOorExplode)
+import Text.Pandoc.Class (PandocMonad)
import Data.Aeson
import qualified Data.ByteString.Lazy as BL
import Data.List (intercalate)
@@ -262,74 +265,137 @@ readers = [ ("native" , StringReader $ \_ s -> return $ readNative s)
,("epub" , mkBSReader readEPUB)
]
-data Writer = PureStringWriter (WriterOptions -> Pandoc -> String)
- | IOStringWriter (WriterOptions -> Pandoc -> IO String)
- | IOByteStringWriter (WriterOptions -> Pandoc -> IO BL.ByteString)
+-- data Writer = PureStringWriter (WriterOptions -> Pandoc -> String)
+-- | IOStringWriter (WriterOptions -> Pandoc -> IO String)
+-- | IOByteStringWriter (WriterOptions -> Pandoc -> IO BL.ByteString)
+
+-- -- | Association list of formats and writers.
+-- writers :: [ ( String, Writer ) ]
+-- writers = [
+-- ("native" , PureStringWriter writeNative)
+-- ,("json" , PureStringWriter writeJSON)
+-- ,("docx" , IOByteStringWriter $ \o doc ->
+-- runIOorExplode $ writeDocx o doc)
+-- ,("odt" , IOByteStringWriter $ \o doc ->
+-- runIOorExplode $ writeODT o doc)
+-- ,("epub" , IOByteStringWriter $ \o doc ->
+-- runIOorExplode $
+-- writeEPUB o{ writerEpubVersion = Just EPUB2 } doc)
+-- ,("epub3" , IOByteStringWriter $ \o doc ->
+-- runIOorExplode $
+-- writeEPUB o{ writerEpubVersion = Just EPUB3 } doc)
+-- ,("fb2" , IOStringWriter $ \o doc ->
+-- runIOorExplode $ writeFB2 o doc)
+-- ,("html" , PureStringWriter writeHtmlString)
+-- ,("html5" , PureStringWriter $ \o ->
+-- writeHtmlString o{ writerHtml5 = True })
+-- ,("icml" , IOStringWriter $ \o doc ->
+-- runIOorExplode $ writeICML o doc)
+-- ,("s5" , PureStringWriter $ \o ->
+-- writeHtmlString o{ writerSlideVariant = S5Slides
+-- , writerTableOfContents = False })
+-- ,("slidy" , PureStringWriter $ \o ->
+-- writeHtmlString o{ writerSlideVariant = SlidySlides })
+-- ,("slideous" , PureStringWriter $ \o ->
+-- writeHtmlString o{ writerSlideVariant = SlideousSlides })
+-- ,("dzslides" , PureStringWriter $ \o ->
+-- writeHtmlString o{ writerSlideVariant = DZSlides
+-- , writerHtml5 = True })
+-- ,("revealjs" , PureStringWriter $ \o ->
+-- writeHtmlString o{ writerSlideVariant = RevealJsSlides
+-- , writerHtml5 = True })
+-- ,("docbook" , PureStringWriter writeDocbook)
+-- ,("docbook5" , PureStringWriter $ \o ->
+-- writeDocbook o{ writerDocbook5 = True })
+-- ,("opml" , PureStringWriter writeOPML)
+-- ,("opendocument" , PureStringWriter writeOpenDocument)
+-- ,("latex" , PureStringWriter writeLaTeX)
+-- ,("beamer" , PureStringWriter $ \o ->
+-- writeLaTeX o{ writerBeamer = True })
+-- ,("context" , PureStringWriter writeConTeXt)
+-- ,("texinfo" , PureStringWriter writeTexinfo)
+-- ,("man" , PureStringWriter writeMan)
+-- ,("markdown" , PureStringWriter writeMarkdown)
+-- ,("markdown_strict" , PureStringWriter writeMarkdown)
+-- ,("markdown_phpextra" , PureStringWriter writeMarkdown)
+-- ,("markdown_github" , PureStringWriter writeMarkdown)
+-- ,("markdown_mmd" , PureStringWriter writeMarkdown)
+-- ,("plain" , PureStringWriter writePlain)
+-- ,("rst" , PureStringWriter writeRST)
+-- ,("mediawiki" , PureStringWriter writeMediaWiki)
+-- ,("dokuwiki" , PureStringWriter writeDokuWiki)
+-- ,("zimwiki" , PureStringWriter writeZimWiki)
+-- ,("textile" , PureStringWriter writeTextile)
+-- ,("rtf" , IOStringWriter $ \o doc ->
+-- runIOorExplode $ writeRTFWithEmbeddedImages o doc)
+-- ,("org" , PureStringWriter writeOrg)
+-- ,("asciidoc" , PureStringWriter writeAsciiDoc)
+-- ,("haddock" , PureStringWriter writeHaddock)
+-- ,("commonmark" , PureStringWriter writeCommonMark)
+-- ,("tei" , PureStringWriter writeTEI)
+-- ]
+
+data Writer' m = StringWriter' (WriterOptions -> Pandoc -> m String)
+ | ByteStringWriter' (WriterOptions -> Pandoc -> m BL.ByteString)
-- | Association list of formats and writers.
-writers :: [ ( String, Writer ) ]
-writers = [
- ("native" , PureStringWriter writeNative)
- ,("json" , PureStringWriter writeJSON)
- ,("docx" , IOByteStringWriter $ \o doc ->
- runIOorExplode $ writeDocx o doc)
- ,("odt" , IOByteStringWriter $ \o doc ->
- runIOorExplode $ writeODT o doc)
- ,("epub" , IOByteStringWriter $ \o doc ->
- runIOorExplode $
- writeEPUB o{ writerEpubVersion = Just EPUB2 } doc)
- ,("epub3" , IOByteStringWriter $ \o doc ->
- runIOorExplode $
- writeEPUB o{ writerEpubVersion = Just EPUB3 } doc)
- ,("fb2" , IOStringWriter $ \o doc ->
- runIOorExplode $ writeFB2 o doc)
- ,("html" , PureStringWriter writeHtmlString)
- ,("html5" , PureStringWriter $ \o ->
+writers' :: PandocMonad m => [ ( String, Writer' m) ]
+writers' = [
+ ("native" , StringWriter' writeNative)
+ ,("json" , StringWriter' $ \o d -> return $ writeJSON o d)
+ ,("docx" , ByteStringWriter' writeDocx)
+ ,("odt" , ByteStringWriter' writeODT)
+ ,("epub" , ByteStringWriter' $ \o ->
+ writeEPUB o{ writerEpubVersion = Just EPUB2 })
+ ,("epub3" , ByteStringWriter' $ \o ->
+ writeEPUB o{ writerEpubVersion = Just EPUB3 })
+ ,("fb2" , StringWriter' writeFB2)
+ ,("html" , StringWriter' writeHtmlString)
+ ,("html5" , StringWriter' $ \o ->
writeHtmlString o{ writerHtml5 = True })
- ,("icml" , IOStringWriter $ \o doc ->
- runIOorExplode $ writeICML o doc)
- ,("s5" , PureStringWriter $ \o ->
+ ,("icml" , StringWriter' writeICML)
+ ,("s5" , StringWriter' $ \o ->
writeHtmlString o{ writerSlideVariant = S5Slides
, writerTableOfContents = False })
- ,("slidy" , PureStringWriter $ \o ->
+ ,("slidy" , StringWriter' $ \o ->
writeHtmlString o{ writerSlideVariant = SlidySlides })
- ,("slideous" , PureStringWriter $ \o ->
+ ,("slideous" , StringWriter' $ \o ->
writeHtmlString o{ writerSlideVariant = SlideousSlides })
- ,("dzslides" , PureStringWriter $ \o ->
+ ,("dzslides" , StringWriter' $ \o ->
writeHtmlString o{ writerSlideVariant = DZSlides
, writerHtml5 = True })
- ,("revealjs" , PureStringWriter $ \o ->
+ ,("revealjs" , StringWriter' $ \o ->
writeHtmlString o{ writerSlideVariant = RevealJsSlides
, writerHtml5 = True })
- ,("docbook" , PureStringWriter writeDocbook)
- ,("docbook5" , PureStringWriter $ \o ->
+ ,("docbook" , StringWriter' writeDocbook)
+ ,("docbook5" , StringWriter' $ \o ->
writeDocbook o{ writerDocbook5 = True })
- ,("opml" , PureStringWriter writeOPML)
- ,("opendocument" , PureStringWriter writeOpenDocument)
- ,("latex" , PureStringWriter writeLaTeX)
- ,("beamer" , PureStringWriter $ \o ->
+ ,("opml" , StringWriter' writeOPML)
+ ,("opendocument" , StringWriter' writeOpenDocument)
+ ,("latex" , StringWriter' writeLaTeX)
+ ,("beamer" , StringWriter' $ \o ->
writeLaTeX o{ writerBeamer = True })
- ,("context" , PureStringWriter writeConTeXt)
- ,("texinfo" , PureStringWriter writeTexinfo)
- ,("man" , PureStringWriter writeMan)
- ,("markdown" , PureStringWriter writeMarkdown)
- ,("markdown_strict" , PureStringWriter writeMarkdown)
- ,("markdown_phpextra" , PureStringWriter writeMarkdown)
- ,("markdown_github" , PureStringWriter writeMarkdown)
- ,("markdown_mmd" , PureStringWriter writeMarkdown)
- ,("plain" , PureStringWriter writePlain)
- ,("rst" , PureStringWriter writeRST)
- ,("mediawiki" , PureStringWriter writeMediaWiki)
- ,("dokuwiki" , PureStringWriter writeDokuWiki)
- ,("zimwiki" , PureStringWriter writeZimWiki)
- ,("textile" , PureStringWriter writeTextile)
- ,("rtf" , IOStringWriter $ \o doc ->
- runIOorExplode $ writeRTFWithEmbeddedImages o doc)
- ,("org" , PureStringWriter writeOrg)
- ,("asciidoc" , PureStringWriter writeAsciiDoc)
- ,("haddock" , PureStringWriter writeHaddock)
- ,("commonmark" , PureStringWriter writeCommonMark)
- ,("tei" , PureStringWriter writeTEI)
+ ,("context" , StringWriter' writeConTeXt)
+ ,("texinfo" , StringWriter' writeTexinfo)
+ ,("man" , StringWriter' writeMan)
+ ,("markdown" , StringWriter' writeMarkdown)
+ ,("markdown_strict" , StringWriter' writeMarkdown)
+ ,("markdown_phpextra" , StringWriter' writeMarkdown)
+ ,("markdown_github" , StringWriter' writeMarkdown)
+ ,("markdown_mmd" , StringWriter' writeMarkdown)
+ ,("plain" , StringWriter' writePlain)
+ ,("rst" , StringWriter' writeRST)
+ ,("mediawiki" , StringWriter' writeMediaWiki)
+ ,("dokuwiki" , StringWriter' writeDokuWiki)
+ ,("zimwiki" , StringWriter' writeZimWiki)
+ ,("textile" , StringWriter' writeTextile)
+ ,("rtf" , StringWriter' $ \o ->
+ writeRTFWithEmbeddedImages o)
+ ,("org" , StringWriter' writeOrg)
+ ,("asciidoc" , StringWriter' writeAsciiDoc)
+ ,("haddock" , StringWriter' writeHaddock)
+ ,("commonmark" , StringWriter' writeCommonMark)
+ ,("tei" , StringWriter' writeTEI)
]
getDefaultExtensions :: String -> Set Extension
@@ -368,20 +434,34 @@ getReader s =
getDefaultExtensions readerName }
-- | Retrieve writer based on formatSpec (format+extensions).
-getWriter :: String -> Either String Writer
-getWriter s
+-- getWriter :: String -> Either String Writer
+-- getWriter s
+-- = case parseFormatSpec s of
+-- Left e -> Left $ intercalate "\n" [m | Message m <- errorMessages e]
+-- Right (writerName, setExts) ->
+-- case lookup writerName writers of
+-- Nothing -> Left $ "Unknown writer: " ++ writerName
+-- Just (PureStringWriter r) -> Right $ PureStringWriter $
+-- \o -> r o{ writerExtensions = setExts $
+-- getDefaultExtensions writerName }
+-- Just (IOStringWriter r) -> Right $ IOStringWriter $
+-- \o -> r o{ writerExtensions = setExts $
+-- getDefaultExtensions writerName }
+-- Just (IOByteStringWriter r) -> Right $ IOByteStringWriter $
+-- \o -> r o{ writerExtensions = setExts $
+-- getDefaultExtensions writerName }
+
+getWriter' :: PandocMonad m => String -> Either String (Writer' m)
+getWriter' s
= case parseFormatSpec s of
Left e -> Left $ intercalate "\n" [m | Message m <- errorMessages e]
Right (writerName, setExts) ->
- case lookup writerName writers of
+ case lookup writerName writers' of
Nothing -> Left $ "Unknown writer: " ++ writerName
- Just (PureStringWriter r) -> Right $ PureStringWriter $
- \o -> r o{ writerExtensions = setExts $
- getDefaultExtensions writerName }
- Just (IOStringWriter r) -> Right $ IOStringWriter $
+ Just (StringWriter' r) -> Right $ StringWriter' $
\o -> r o{ writerExtensions = setExts $
getDefaultExtensions writerName }
- Just (IOByteStringWriter r) -> Right $ IOByteStringWriter $
+ Just (ByteStringWriter' r) -> Right $ ByteStringWriter' $
\o -> r o{ writerExtensions = setExts $
getDefaultExtensions writerName }
diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs
index 9faff1816..7aaa257fa 100644
--- a/src/Text/Pandoc/PDF.hs
+++ b/src/Text/Pandoc/PDF.hs
@@ -60,6 +60,7 @@ import qualified Codec.Picture as JP
#ifdef _WINDOWS
import Data.List (intercalate)
#endif
+import Text.Pandoc.Class (PandocIO, runIOorExplode)
#ifdef _WINDOWS
changePathSeparators :: FilePath -> FilePath
@@ -68,7 +69,7 @@ changePathSeparators = intercalate "/" . splitDirectories
makePDF :: String -- ^ pdf creator (pdflatex, lualatex,
-- xelatex, context, wkhtmltopdf)
- -> (WriterOptions -> Pandoc -> String) -- ^ writer
+ -> (WriterOptions -> Pandoc -> PandocIO String) -- ^ writer
-> WriterOptions -- ^ options
-> Pandoc -- ^ document
-> IO (Either ByteString ByteString)
@@ -93,12 +94,12 @@ makePDF "wkhtmltopdf" writer opts doc@(Pandoc meta _) = do
,("margin-left", fromMaybe (Just "1.25in")
(getField "margin-left" meta'))
]
- let source = writer opts doc
+ source <- runIOorExplode $ writer opts doc
html2pdf (writerVerbose opts) args source
makePDF program writer opts doc = withTempDir "tex2pdf." $ \tmpdir -> do
doc' <- handleImages opts tmpdir doc
- let source = writer opts doc'
- args = writerLaTeXArgs opts
+ source <- runIOorExplode $ writer opts doc'
+ let args = writerLaTeXArgs opts
case takeBaseName program of
"context" -> context2pdf (writerVerbose opts) tmpdir source
prog | prog `elem` ["pdflatex", "lualatex", "xelatex"]
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index 88fab171f..eed6183b4 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -52,6 +52,7 @@ import qualified Data.Map as M
import Data.Aeson (Value(String), fromJSON, toJSON, Result(..))
import qualified Data.Text as T
import Data.Char (isSpace, isPunctuation)
+import Text.Pandoc.Class (PandocMonad)
data WriterState = WriterState { defListMarker :: String
, orderedListLevel :: Int
@@ -60,8 +61,8 @@ data WriterState = WriterState { defListMarker :: String
}
-- | Convert Pandoc to AsciiDoc.
-writeAsciiDoc :: WriterOptions -> Pandoc -> String
-writeAsciiDoc opts document =
+writeAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeAsciiDoc opts document = return $
evalState (pandocToAsciiDoc opts document) WriterState{
defListMarker = "::"
, orderedListLevel = 1
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs
index e0591de83..b6ff35bbe 100644
--- a/src/Text/Pandoc/Writers/CommonMark.hs
+++ b/src/Text/Pandoc/Writers/CommonMark.hs
@@ -39,26 +39,27 @@ import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
import CMark
import qualified Data.Text as T
-import Control.Monad.Identity (runIdentity, Identity)
import Control.Monad.State (runState, State, modify, get)
import Text.Pandoc.Walk (walkM)
+import Text.Pandoc.Class (PandocMonad)
+import Data.Foldable (foldrM)
-- | Convert Pandoc to CommonMark.
-writeCommonMark :: WriterOptions -> Pandoc -> String
-writeCommonMark opts (Pandoc meta blocks) = rendered
- where main = runIdentity $ blocksToCommonMark opts (blocks' ++ notes')
- (blocks', notes) = runState (walkM processNotes blocks) []
- notes' = if null notes
- then []
- else [OrderedList (1, Decimal, Period) $ reverse notes]
- metadata = runIdentity $ metaToJSON opts
- (blocksToCommonMark opts)
- (inlinesToCommonMark opts)
- meta
- context = defField "body" main $ metadata
- rendered = case writerTemplate opts of
- Nothing -> main
- Just tpl -> renderTemplate' tpl context
+writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeCommonMark opts (Pandoc meta blocks) = do
+ let (blocks', notes) = runState (walkM processNotes blocks) []
+ notes' = if null notes
+ then []
+ else [OrderedList (1, Decimal, Period) $ reverse notes]
+ main <- blocksToCommonMark opts (blocks' ++ notes')
+ metadata <- metaToJSON opts
+ (blocksToCommonMark opts)
+ (inlinesToCommonMark opts)
+ meta
+ let context = defField "body" main $ metadata
+ return $ case writerTemplate opts of
+ Nothing -> main
+ Just tpl -> renderTemplate' tpl context
processNotes :: Inline -> State [[Block]] Inline
processNotes (Note bs) = do
@@ -70,16 +71,19 @@ processNotes x = return x
node :: NodeType -> [Node] -> Node
node = Node Nothing
-blocksToCommonMark :: WriterOptions -> [Block] -> Identity String
-blocksToCommonMark opts bs = return $
- T.unpack $ nodeToCommonmark cmarkOpts colwidth
- $ node DOCUMENT (blocksToNodes bs)
- where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
- colwidth = if writerWrapText opts == WrapAuto
- then Just $ writerColumns opts
- else Nothing
-
-inlinesToCommonMark :: WriterOptions -> [Inline] -> Identity String
+blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m String
+blocksToCommonMark opts bs = do
+ let cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
+ colwidth = if writerWrapText opts == WrapAuto
+ then Just $ writerColumns opts
+ else Nothing
+ nodes <- blocksToNodes bs
+ return $
+ T.unpack $
+ nodeToCommonmark cmarkOpts colwidth $
+ node DOCUMENT nodes
+
+inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m String
inlinesToCommonMark opts ils = return $
T.unpack $ nodeToCommonmark cmarkOpts colwidth
$ node PARAGRAPH (inlinesToNodes ils)
@@ -88,39 +92,44 @@ inlinesToCommonMark opts ils = return $
then Just $ writerColumns opts
else Nothing
-blocksToNodes :: [Block] -> [Node]
-blocksToNodes = foldr blockToNodes []
-
-blockToNodes :: Block -> [Node] -> [Node]
-blockToNodes (Plain xs) = (node PARAGRAPH (inlinesToNodes xs) :)
-blockToNodes (Para xs) = (node PARAGRAPH (inlinesToNodes xs) :)
-blockToNodes (LineBlock lns) = blockToNodes $ linesToPara lns
-blockToNodes (CodeBlock (_,classes,_) xs) =
- (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] :)
-blockToNodes (RawBlock fmt xs)
- | fmt == Format "html" = (node (HTML_BLOCK (T.pack xs)) [] :)
- | otherwise = (node (CUSTOM_BLOCK (T.pack xs) (T.empty)) [] :)
-blockToNodes (BlockQuote bs) =
- (node BLOCK_QUOTE (blocksToNodes bs) :)
-blockToNodes (BulletList items) =
- (node (LIST ListAttributes{
- listType = BULLET_LIST,
- listDelim = PERIOD_DELIM,
- listTight = isTightList items,
- listStart = 1 }) (map (node ITEM . blocksToNodes) items) :)
-blockToNodes (OrderedList (start, _sty, delim) items) =
- (node (LIST ListAttributes{
- listType = ORDERED_LIST,
- listDelim = case delim of
- OneParen -> PAREN_DELIM
- TwoParens -> PAREN_DELIM
- _ -> PERIOD_DELIM,
- listTight = isTightList items,
- listStart = start }) (map (node ITEM . blocksToNodes) items) :)
-blockToNodes HorizontalRule = (node THEMATIC_BREAK [] :)
-blockToNodes (Header lev _ ils) = (node (HEADING lev) (inlinesToNodes ils) :)
-blockToNodes (Div _ bs) = (blocksToNodes bs ++)
-blockToNodes (DefinitionList items) = blockToNodes (BulletList items')
+blocksToNodes :: PandocMonad m => [Block] -> m [Node]
+blocksToNodes = foldrM blockToNodes []
+
+blockToNodes :: PandocMonad m => Block -> [Node] -> m [Node]
+blockToNodes (Plain xs) ns = return (node PARAGRAPH (inlinesToNodes xs) : ns)
+blockToNodes (Para xs) ns = return (node PARAGRAPH (inlinesToNodes xs) : ns)
+blockToNodes (LineBlock lns) ns = blockToNodes (linesToPara lns) ns
+blockToNodes (CodeBlock (_,classes,_) xs) ns = return $
+ (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] : ns)
+blockToNodes (RawBlock fmt xs) ns
+ | fmt == Format "html" = return (node (HTML_BLOCK (T.pack xs)) [] : ns)
+ | otherwise = return (node (CUSTOM_BLOCK (T.pack xs) (T.empty)) [] : ns)
+blockToNodes (BlockQuote bs) ns = do
+ nodes <- blocksToNodes bs
+ return (node BLOCK_QUOTE nodes : ns)
+blockToNodes (BulletList items) ns = do
+ nodes <- mapM blocksToNodes items
+ return (node (LIST ListAttributes{
+ listType = BULLET_LIST,
+ listDelim = PERIOD_DELIM,
+ listTight = isTightList items,
+ listStart = 1 }) (map (node ITEM) nodes) : ns)
+blockToNodes (OrderedList (start, _sty, delim) items) ns = do
+ nodes <- mapM blocksToNodes items
+ return (node (LIST ListAttributes{
+ listType = ORDERED_LIST,
+ listDelim = case delim of
+ OneParen -> PAREN_DELIM
+ TwoParens -> PAREN_DELIM
+ _ -> PERIOD_DELIM,
+ listTight = isTightList items,
+ listStart = start }) (map (node ITEM) nodes) : ns)
+blockToNodes HorizontalRule ns = return (node THEMATIC_BREAK [] : ns)
+blockToNodes (Header lev _ ils) ns = return (node (HEADING lev) (inlinesToNodes ils) : ns)
+blockToNodes (Div _ bs) ns = do
+ nodes <- blocksToNodes bs
+ return (nodes ++ ns)
+blockToNodes (DefinitionList items) ns = blockToNodes (BulletList items') ns
where items' = map dlToBullet items
dlToBullet (term, ((Para xs : ys) : zs)) =
Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs
@@ -128,9 +137,10 @@ blockToNodes (DefinitionList items) = blockToNodes (BulletList items')
Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
dlToBullet (term, xs) =
Para term : concat xs
-blockToNodes t@(Table _ _ _ _ _) =
- (node (HTML_BLOCK (T.pack $! writeHtmlString def $! Pandoc nullMeta [t])) [] :)
-blockToNodes Null = id
+blockToNodes t@(Table _ _ _ _ _) ns = do
+ s <- writeHtmlString def $! Pandoc nullMeta [t]
+ return (node (HTML_BLOCK (T.pack $! s)) [] : ns)
+blockToNodes Null ns = return ns
inlinesToNodes :: [Inline] -> [Node]
inlinesToNodes = foldr inlineToNodes []
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index ee2cc3f34..c8a4abfd5 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -43,6 +43,7 @@ import Text.Pandoc.Pretty
import Text.Pandoc.ImageSize
import Text.Pandoc.Templates ( renderTemplate' )
import Network.URI ( isURI, unEscapeString )
+import Text.Pandoc.Class (PandocMonad)
data WriterState =
WriterState { stNextRef :: Int -- number of next URL reference
@@ -54,8 +55,8 @@ orderedListStyles :: [Char]
orderedListStyles = cycle "narg"
-- | Convert Pandoc to ConTeXt.
-writeConTeXt :: WriterOptions -> Pandoc -> String
-writeConTeXt options document =
+writeConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeConTeXt options document = return $
let defaultWriterState = WriterState { stNextRef = 1
, stOrderedListLevel = 0
, stOptions = options
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 5c03d449d..74e3bff3d 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -47,6 +47,7 @@ import qualified Text.Pandoc.Builder as B
import Text.TeXMath
import qualified Text.XML.Light as Xml
import Data.Generics (everywhere, mkT)
+import Text.Pandoc.Class (PandocMonad)
-- | Convert list of authors to a docbook <author> section
authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines
@@ -73,8 +74,8 @@ authorToDocbook opts name' =
inTagsSimple "surname" (text $ escapeStringForXML lastname)
-- | Convert Pandoc document to string in Docbook format.
-writeDocbook :: WriterOptions -> Pandoc -> String
-writeDocbook opts (Pandoc meta blocks) =
+writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeDocbook opts (Pandoc meta blocks) = return $
let elements = hierarchicalize blocks
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs
index c90dc9078..c7a09fe50 100644
--- a/src/Text/Pandoc/Writers/DokuWiki.hs
+++ b/src/Text/Pandoc/Writers/DokuWiki.hs
@@ -55,6 +55,7 @@ import Network.URI ( isURI )
import Control.Monad ( zipWithM )
import Control.Monad.State ( modify, State, get, evalState )
import Control.Monad.Reader ( ReaderT, runReaderT, ask, local )
+import Text.Pandoc.Class (PandocMonad)
data WriterState = WriterState {
stNotes :: Bool -- True if there are notes
@@ -77,8 +78,8 @@ instance Default WriterEnvironment where
type DokuWiki = ReaderT WriterEnvironment (State WriterState)
-- | Convert Pandoc to DokuWiki.
-writeDokuWiki :: WriterOptions -> Pandoc -> String
-writeDokuWiki opts document =
+writeDokuWiki :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeDokuWiki opts document = return $
runDokuWiki (pandocToDokuWiki opts $ normalize document)
runDokuWiki :: DokuWiki a -> a
diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs
index 397aa5847..298561db6 100644
--- a/src/Text/Pandoc/Writers/EPUB.hs
+++ b/src/Text/Pandoc/Writers/EPUB.hs
@@ -55,7 +55,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Walk (walk, walkM, query)
import Text.Pandoc.UUID (getUUID)
import Control.Monad.State (modify, get, gets, State, StateT, put, evalState, evalStateT, lift)
-import Control.Monad (mplus, when)
+import Control.Monad (mplus, when, zipWithM)
import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
, strContent, lookupAttr, Node(..), QName(..), parseXML
, onlyElems, node, ppElement)
@@ -374,17 +374,17 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
Nothing -> return ([],[])
Just img -> do
let coverImage = "media/" ++ takeFileName img
- let cpContent = renderHtml $ writeHtml
+ cpContent <- renderHtml <$> (lift $ writeHtml
opts'{ writerVariables = ("coverpage","true"):vars }
- (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
+ (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"]))
imgContent <- lift $ P.readFileLazy img
return ( [mkEntry "cover.xhtml" cpContent]
, [mkEntry coverImage imgContent] )
-- title page
- let tpContent = renderHtml $ writeHtml opts'{
- writerVariables = ("titlepage","true"):vars }
- (Pandoc meta [])
+ tpContent <- renderHtml <$> (lift $ writeHtml opts'{
+ writerVariables = ("titlepage","true"):vars }
+ (Pandoc meta []))
let tpEntry = mkEntry "title_page.xhtml" tpContent
-- handle pictures
@@ -482,20 +482,20 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
Chapter mbnum $ walk fixInternalReferences bs)
chapters'
- let chapToEntry :: Int -> Chapter -> Entry
- chapToEntry num (Chapter mbnum bs) = mkEntry (showChapter num)
- $ renderHtml
- $ writeHtml opts'{ writerNumberOffset =
- fromMaybe [] mbnum }
- $ case bs of
- (Header _ _ xs : _) ->
- -- remove notes or we get doubled footnotes
- Pandoc (setMeta "title" (walk removeNote $ fromList xs)
- nullMeta) bs
- _ ->
- Pandoc nullMeta bs
-
- let chapterEntries = zipWith chapToEntry [1..] chapters
+ let chapToEntry :: PandocMonad m => Int -> Chapter -> m Entry
+ chapToEntry num (Chapter mbnum bs) =
+ (mkEntry (showChapter num) . renderHtml) <$>
+ (writeHtml opts'{ writerNumberOffset =
+ fromMaybe [] mbnum }
+ $ case bs of
+ (Header _ _ xs : _) ->
+ -- remove notes or we get doubled footnotes
+ Pandoc (setMeta "title" (walk removeNote $ fromList xs)
+ nullMeta) bs
+ _ ->
+ Pandoc nullMeta bs)
+
+ chapterEntries <- lift $ zipWithM chapToEntry [1..] chapters
-- incredibly inefficient (TODO):
let containsMathML ent = epub3 &&
@@ -679,11 +679,11 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
]
]
else []
- let navData = renderHtml $ writeHtml
+ navData <- renderHtml <$> (lift $ writeHtml
opts'{ writerVariables = ("navpage","true"):vars }
(Pandoc (setMeta "title"
(walk removeNote $ fromList $ docTitle' meta) nullMeta)
- (navBlocks ++ landmarks))
+ (navBlocks ++ landmarks)))
let navEntry = mkEntry "nav.xhtml" navData
-- mimetype
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index e0b0234fb..6f25939f0 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -68,6 +68,7 @@ import Text.XML.Light (unode, elChildren, unqual)
import qualified Text.XML.Light as XML
import System.FilePath (takeExtension)
import Data.Aeson (Value)
+import Text.Pandoc.Class (PandocMonad)
data WriterState = WriterState
{ stNotes :: [Html] -- ^ List of notes
@@ -99,8 +100,8 @@ nl opts = if writerWrapText opts == WrapNone
else preEscapedString "\n"
-- | Convert Pandoc document to Html string.
-writeHtmlString :: WriterOptions -> Pandoc -> String
-writeHtmlString opts d =
+writeHtmlString :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeHtmlString opts d = return $
let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
in case writerTemplate opts of
Nothing -> renderHtml body
@@ -108,8 +109,8 @@ writeHtmlString opts d =
defField "body" (renderHtml body) context
-- | Convert Pandoc document to Html structure.
-writeHtml :: WriterOptions -> Pandoc -> Html
-writeHtml opts d =
+writeHtml :: PandocMonad m => WriterOptions -> Pandoc -> m Html
+writeHtml opts d = return $
let (body, context) = evalState (pandocToHtml opts d) defaultWriterState
in case writerTemplate opts of
Nothing -> body
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 4e93cc4e4..03ce8c0eb 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -42,6 +42,7 @@ import Control.Monad.State
import Text.Pandoc.Readers.TeXMath (texMathToInlines)
import Network.URI (isURI)
import Data.Default
+import Text.Pandoc.Class (PandocMonad)
type Notes = [[Block]]
data WriterState = WriterState { stNotes :: Notes }
@@ -49,8 +50,8 @@ instance Default WriterState
where def = WriterState{ stNotes = [] }
-- | Convert Pandoc to Haddock.
-writeHaddock :: WriterOptions -> Pandoc -> String
-writeHaddock opts document =
+writeHaddock :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeHaddock opts document = return $
evalState (pandocToHaddock opts{
writerWrapText = writerWrapText opts } document) def
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 50e99fe15..dbb8e4326 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -54,6 +54,7 @@ import Text.Pandoc.Slides
import Text.Pandoc.Highlighting (highlight, styleToLaTeX,
formatLaTeXInline, formatLaTeXBlock,
toListingsLanguage)
+import Text.Pandoc.Class (PandocMonad)
data WriterState =
WriterState { stInNote :: Bool -- true if we're in a note
@@ -78,8 +79,8 @@ data WriterState =
}
-- | Convert Pandoc to LaTeX.
-writeLaTeX :: WriterOptions -> Pandoc -> String
-writeLaTeX options document =
+writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeLaTeX options document = return $
evalState (pandocToLaTeX options document) $
WriterState { stInNote = False, stInQuote = False,
stInMinipage = False, stInHeading = False,
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 304995ec8..75c026463 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -41,14 +41,15 @@ import Data.Maybe (fromMaybe)
import Text.Pandoc.Pretty
import Text.Pandoc.Builder (deleteMeta)
import Control.Monad.State
+import Text.Pandoc.Class (PandocMonad)
type Notes = [[Block]]
data WriterState = WriterState { stNotes :: Notes
, stHasTables :: Bool }
-- | Convert Pandoc to Man.
-writeMan :: WriterOptions -> Pandoc -> String
-writeMan opts document = evalState (pandocToMan opts document) (WriterState [] False)
+writeMan :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeMan opts document = return $ evalState (pandocToMan opts document) (WriterState [] False)
-- | Return groff man representation of document.
pandocToMan :: WriterOptions -> Pandoc -> State WriterState String
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index f9c7c326e..787db10f9 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -57,15 +57,16 @@ import qualified Data.Vector as V
import qualified Data.Text as T
import qualified Data.Set as Set
import Network.HTTP ( urlEncode )
+import Text.Pandoc.Class (PandocMonad)
type Notes = [[Block]]
type Ref = ([Inline], Target, Attr)
type Refs = [Ref]
-type MD = ReaderT WriterEnv (State WriterState)
+type MD m = ReaderT WriterEnv (StateT WriterState m)
-evalMD :: MD a -> WriterEnv -> WriterState -> a
-evalMD md env st = evalState (runReaderT md env) st
+evalMD :: PandocMonad m => MD m a -> WriterEnv -> WriterState -> m a
+evalMD md env st = evalStateT (runReaderT md env) st
data WriterEnv = WriterEnv { envInList :: Bool
, envPlain :: Bool
@@ -96,7 +97,7 @@ instance Default WriterState
}
-- | Convert Pandoc to Markdown.
-writeMarkdown :: WriterOptions -> Pandoc -> String
+writeMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeMarkdown opts document =
evalMD (pandocToMarkdown opts{
writerWrapText = if isEnabled Ext_hard_line_breaks opts
@@ -106,7 +107,7 @@ writeMarkdown opts document =
-- | Convert Pandoc to plain text (like markdown, but without links,
-- pictures, or inline formatting).
-writePlain :: WriterOptions -> Pandoc -> String
+writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m String
writePlain opts document =
evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
@@ -171,7 +172,7 @@ jsonToYaml (Number n) = text $ show n
jsonToYaml _ = empty
-- | Return markdown representation of document.
-pandocToMarkdown :: WriterOptions -> Pandoc -> MD String
+pandocToMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> MD m String
pandocToMarkdown opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
@@ -196,9 +197,9 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
| otherwise -> empty
Nothing -> empty
let headerBlocks = filter isHeaderBlock blocks
- let toc = if writerTableOfContents opts
- then tableOfContents opts headerBlocks
- else empty
+ toc <- if writerTableOfContents opts
+ then lift $ lift $ tableOfContents opts headerBlocks
+ else return empty
-- Strip off final 'references' header if markdown citations enabled
let blocks' = if isEnabled Ext_citations opts
then case reverse blocks of
@@ -221,13 +222,14 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
Just tpl -> return $ renderTemplate' tpl context
-- | Return markdown representation of reference key table.
-refsToMarkdown :: WriterOptions -> Refs -> MD Doc
+refsToMarkdown :: PandocMonad m => WriterOptions -> Refs -> MD m Doc
refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat
-- | Return markdown representation of a reference key.
-keyToMarkdown :: WriterOptions
+keyToMarkdown :: PandocMonad m
+ => WriterOptions
-> Ref
- -> MD Doc
+ -> MD m Doc
keyToMarkdown opts (label, (src, tit), attr) = do
label' <- inlineListToMarkdown opts label
let tit' = if null tit
@@ -238,7 +240,7 @@ keyToMarkdown opts (label, (src, tit), attr) = do
<> linkAttributes opts attr
-- | Return markdown representation of notes.
-notesToMarkdown :: WriterOptions -> [[Block]] -> MD Doc
+notesToMarkdown :: PandocMonad m => WriterOptions -> [[Block]] -> MD m Doc
notesToMarkdown opts notes = do
n <- gets stNoteNum
notes' <- mapM (\(num, note) -> noteToMarkdown opts num note) (zip [n..] notes)
@@ -246,7 +248,7 @@ notesToMarkdown opts notes = do
return $ vsep notes'
-- | Return markdown representation of a note.
-noteToMarkdown :: WriterOptions -> Int -> [Block] -> MD Doc
+noteToMarkdown :: PandocMonad m => WriterOptions -> Int -> [Block] -> MD m Doc
noteToMarkdown opts num blocks = do
contents <- blockListToMarkdown opts blocks
let num' = text $ writerIdentifierPrefix opts ++ show num
@@ -279,7 +281,7 @@ escapeString opts = escapeStringUsing markdownEscapes
"\\`*_[]#"
-- | Construct table of contents from list of header blocks.
-tableOfContents :: WriterOptions -> [Block] -> Doc
+tableOfContents :: PandocMonad m => WriterOptions -> [Block] -> m Doc
tableOfContents opts headers =
let opts' = opts { writerIgnoreNotes = True }
contents = BulletList $ map (elementToListItem opts) $ hierarchicalize headers
@@ -334,7 +336,7 @@ beginsWithOrderedListMarker str =
Left _ -> False
Right _ -> True
-notesAndRefs :: WriterOptions -> MD Doc
+notesAndRefs :: PandocMonad m => WriterOptions -> MD m Doc
notesAndRefs opts = do
notes' <- reverse <$> gets stNotes >>= notesToMarkdown opts
modify $ \s -> s { stNotes = [] }
@@ -352,9 +354,10 @@ notesAndRefs opts = do
endSpacing
-- | Convert Pandoc block element to markdown.
-blockToMarkdown :: WriterOptions -- ^ Options
+blockToMarkdown :: PandocMonad m
+ => WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> MD Doc
+ -> MD m Doc
blockToMarkdown opts blk =
local (\env -> env {envBlockLevel = envBlockLevel env + 1}) $
do doc <- blockToMarkdown' opts blk
@@ -363,9 +366,10 @@ blockToMarkdown opts blk =
then notesAndRefs opts >>= (\d -> return $ doc <> d)
else return doc
-blockToMarkdown' :: WriterOptions -- ^ Options
- -> Block -- ^ Block element
- -> MD Doc
+blockToMarkdown' :: PandocMonad m
+ => WriterOptions -- ^ Options
+ -> Block -- ^ Block element
+ -> MD m Doc
blockToMarkdown' _ Null = return empty
blockToMarkdown' opts (Div attrs ils) = do
contents <- blockListToMarkdown opts ils
@@ -526,8 +530,8 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
gridTable opts (all null headers) aligns widths
rawHeaders rawRows
| isEnabled Ext_raw_html opts -> fmap (id,) $
- return $ text $ writeHtmlString def
- $ Pandoc nullMeta [t]
+ text <$>
+ (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [t])
| otherwise -> return $ (id, text "[TABLE]")
return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
blockToMarkdown' opts (BulletList items) = do
@@ -550,7 +554,7 @@ blockToMarkdown' opts (DefinitionList items) = do
contents <- inList $ mapM (definitionListItemToMarkdown opts) items
return $ cat contents <> blankline
-inList :: MD a -> MD a
+inList :: Monad m => MD m a -> MD m a
inList p = local (\env -> env {envInList = True}) p
addMarkdownAttribute :: String -> String
@@ -562,7 +566,7 @@ addMarkdownAttribute s =
x /= "markdown"]
_ -> s
-pipeTable :: Bool -> [Alignment] -> [Doc] -> [[Doc]] -> MD Doc
+pipeTable :: PandocMonad m => Bool -> [Alignment] -> [Doc] -> [[Doc]] -> MD m Doc
pipeTable headless aligns rawHeaders rawRows = do
let sp = text " "
let blockFor AlignLeft x y = lblock (x + 2) (sp <> y) <> lblock 0 empty
@@ -590,8 +594,8 @@ pipeTable headless aligns rawHeaders rawRows = do
let body = vcat $ map torow rawRows
return $ header $$ border $$ body
-pandocTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> MD Doc
+pandocTable :: PandocMonad m => WriterOptions -> Bool -> [Alignment] -> [Double]
+ -> [Doc] -> [[Doc]] -> MD m Doc
pandocTable opts headless aligns widths rawHeaders rawRows = do
let isSimple = all (==0) widths
let alignHeader alignment = case alignment of
@@ -642,8 +646,8 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
else border
return $ head'' $$ underline $$ body $$ bottom
-gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> MD Doc
+gridTable :: PandocMonad m => WriterOptions -> Bool -> [Alignment] -> [Double]
+ -> [Doc] -> [[Doc]] -> MD m Doc
gridTable opts headless aligns widths headers' rawRows = do
let numcols = length headers'
let widths' = if all (==0) widths
@@ -697,7 +701,7 @@ itemEndsWithTightList bs =
_ -> False
-- | Convert bullet list item (list of blocks) to markdown.
-bulletListItemToMarkdown :: WriterOptions -> [Block] -> MD Doc
+bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m Doc
bulletListItemToMarkdown opts bs = do
contents <- blockListToMarkdown opts bs
let sps = replicate (writerTabStop opts - 2) ' '
@@ -709,10 +713,11 @@ bulletListItemToMarkdown opts bs = do
return $ hang (writerTabStop opts) start $ contents' <> cr
-- | Convert ordered list item (a list of blocks) to markdown.
-orderedListItemToMarkdown :: WriterOptions -- ^ options
+orderedListItemToMarkdown :: PandocMonad m
+ => WriterOptions -- ^ options
-> String -- ^ list item marker
-> [Block] -- ^ list item (list of blocks)
- -> MD Doc
+ -> MD m Doc
orderedListItemToMarkdown opts marker bs = do
contents <- blockListToMarkdown opts bs
let sps = case length marker - writerTabStop opts of
@@ -726,9 +731,10 @@ orderedListItemToMarkdown opts marker bs = do
return $ hang (writerTabStop opts) start $ contents' <> cr
-- | Convert definition list item (label, list of blocks) to markdown.
-definitionListItemToMarkdown :: WriterOptions
+definitionListItemToMarkdown :: PandocMonad m
+ => WriterOptions
-> ([Inline],[[Block]])
- -> MD Doc
+ -> MD m Doc
definitionListItemToMarkdown opts (label, defs) = do
labelText <- inlineListToMarkdown opts label
defs' <- mapM (mapM (blockToMarkdown opts)) defs
@@ -758,9 +764,10 @@ definitionListItemToMarkdown opts (label, defs) = do
vsep (map vsep defs') <> blankline
-- | Convert list of Pandoc block elements to markdown.
-blockListToMarkdown :: WriterOptions -- ^ Options
+blockListToMarkdown :: PandocMonad m
+ => WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> MD Doc
+ -> MD m Doc
blockListToMarkdown opts blocks =
mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
-- insert comment between list and indented code block, or the
@@ -787,7 +794,7 @@ blockListToMarkdown opts blocks =
-- | Get reference for target; if none exists, create unique one and return.
-- Prefer label if possible; otherwise, generate a unique key.
-getReference :: Attr -> [Inline] -> Target -> MD [Inline]
+getReference :: PandocMonad m => Attr -> [Inline] -> Target -> MD m [Inline]
getReference attr label target = do
st <- get
case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of
@@ -805,7 +812,7 @@ getReference attr label target = do
return label'
-- | Convert list of Pandoc inline elements to markdown.
-inlineListToMarkdown :: WriterOptions -> [Inline] -> MD Doc
+inlineListToMarkdown :: PandocMonad m => WriterOptions -> [Inline] -> MD m Doc
inlineListToMarkdown opts lst = do
inlist <- asks envInList
go (if inlist then avoidBadWrapsInList lst else lst)
@@ -866,7 +873,7 @@ isRight (Right _) = True
isRight (Left _) = False
-- | Convert Pandoc inline element to markdown.
-inlineToMarkdown :: WriterOptions -> Inline -> MD Doc
+inlineToMarkdown :: PandocMonad m => WriterOptions -> Inline -> MD m Doc
inlineToMarkdown opts (Span attrs ils) = do
plain <- asks envPlain
contents <- inlineListToMarkdown opts ils
@@ -1053,7 +1060,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
| isEnabled Ext_raw_html opts &&
not (isEnabled Ext_link_attributes opts) &&
attr /= nullAttr = -- use raw HTML
- return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]]
+ (text . trim) <$> (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]])
| otherwise = do
plain <- asks envPlain
linktext <- inlineListToMarkdown opts txt
@@ -1092,7 +1099,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
| isEnabled Ext_raw_html opts &&
not (isEnabled Ext_link_attributes opts) &&
attr /= nullAttr = -- use raw HTML
- return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [img]]
+ (text . trim) <$> (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [Plain [img]])
| otherwise = do
plain <- asks envPlain
let txt = if null alternate || alternate == [Str source]
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index 95b649dd2..774139c43 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -42,6 +42,7 @@ import Data.List ( intersect, intercalate )
import Network.URI ( isURI )
import Control.Monad.Reader
import Control.Monad.State
+import Text.Pandoc.Class (PandocMonad)
data WriterState = WriterState {
stNotes :: Bool -- True if there are notes
@@ -57,8 +58,8 @@ data WriterReader = WriterReader {
type MediaWikiWriter = ReaderT WriterReader (State WriterState)
-- | Convert Pandoc to MediaWiki.
-writeMediaWiki :: WriterOptions -> Pandoc -> String
-writeMediaWiki opts document =
+writeMediaWiki :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeMediaWiki opts document = return $
let initialState = WriterState { stNotes = False, stOptions = opts }
env = WriterReader { options = opts, listLevel = [], useTags = False }
in evalState (runReaderT (pandocToMediaWiki document) env) initialState
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index 87e23aeeb..2421fd94d 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -34,6 +34,7 @@ import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) )
import Data.List ( intersperse )
import Text.Pandoc.Definition
import Text.Pandoc.Pretty
+import Text.Pandoc.Class (PandocMonad)
prettyList :: [Doc] -> Doc
prettyList ds =
@@ -66,8 +67,8 @@ prettyBlock (Div attr blocks) =
prettyBlock block = text $ show block
-- | Prettyprint Pandoc document.
-writeNative :: WriterOptions -> Pandoc -> String
-writeNative opts (Pandoc meta blocks) =
+writeNative :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeNative opts (Pandoc meta blocks) = return $
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 8013763c2..02e84e26e 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -83,7 +83,7 @@ pandocToODT opts doc@(Pandoc meta _) = do
-- handle formulas and pictures
-- picEntriesRef <- P.newIORef ([] :: [Entry])
doc' <- walkM (transformPicMath opts) $ walk fixDisplayMath doc
- let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc'
+ newContents <- lift $ writeOpenDocument opts{writerWrapText = WrapNone} doc'
epochtime <- floor `fmap` (lift P.getPOSIXTime)
let contentEntry = toEntry "content.xml" epochtime
$ fromStringLazy newContents
diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs
index 20c2c5cbc..ce415264d 100644
--- a/src/Text/Pandoc/Writers/OPML.hs
+++ b/src/Text/Pandoc/Writers/OPML.hs
@@ -40,29 +40,30 @@ import Text.Pandoc.Writers.Markdown (writeMarkdown)
import Text.Pandoc.Pretty
import Text.Pandoc.Compat.Time
import qualified Text.Pandoc.Builder as B
+import Text.Pandoc.Class (PandocMonad)
-- | Convert Pandoc document to string in OPML format.
-writeOPML :: WriterOptions -> Pandoc -> String
-writeOPML opts (Pandoc meta blocks) =
+writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeOPML opts (Pandoc meta blocks) = do
let elements = hierarchicalize blocks
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
- Just metadata = metaToJSON opts
- (Just . writeMarkdown def . Pandoc nullMeta)
- (Just . trimr . writeMarkdown def . Pandoc nullMeta .
- (\ils -> [Plain ils]))
- meta'
- main = render colwidth $ vcat (map (elementToOPML opts) elements)
- context = defField "body" main metadata
- in case writerTemplate opts of
- Nothing -> main
- Just tpl -> renderTemplate' tpl context
+ metadata <- metaToJSON opts
+ (writeMarkdown def . Pandoc nullMeta)
+ (\ils -> trimr <$> (writeMarkdown def $ Pandoc nullMeta [Plain ils]))
+ meta'
+ main <- (render colwidth . vcat) <$> (mapM (elementToOPML opts) elements)
+ let context = defField "body" main metadata
+ return $ case writerTemplate opts of
+ Nothing -> main
+ Just tpl -> renderTemplate' tpl context
-writeHtmlInlines :: [Inline] -> String
-writeHtmlInlines ils = trim $ writeHtmlString def
- $ Pandoc nullMeta [Plain ils]
+
+writeHtmlInlines :: PandocMonad m => [Inline] -> m String
+writeHtmlInlines ils =
+ trim <$> (writeHtmlString def $ Pandoc nullMeta [Plain ils])
-- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT
showDateTimeRFC822 :: UTCTime -> String
@@ -78,17 +79,18 @@ convertDate ils = maybe "" showDateTimeRFC822 $
defaultTimeLocale "%F" =<< (normalizeDate $ stringify ils)
-- | Convert an Element to OPML.
-elementToOPML :: WriterOptions -> Element -> Doc
-elementToOPML _ (Blk _) = empty
-elementToOPML opts (Sec _ _num _ title elements) =
+elementToOPML :: PandocMonad m => WriterOptions -> Element -> m Doc
+elementToOPML _ (Blk _) = return empty
+elementToOPML opts (Sec _ _num _ title elements) = do
let isBlk (Blk _) = True
isBlk _ = False
fromBlk (Blk x) = x
fromBlk _ = error "fromBlk called on non-block"
(blocks, rest) = span isBlk elements
- attrs = [("text", writeHtmlInlines title)] ++
- [("_note", writeMarkdown def (Pandoc nullMeta
- (map fromBlk blocks)))
- | not (null blocks)]
- in inTags True "outline" attrs $
- vcat (map (elementToOPML opts) rest)
+ htmlIls <- writeHtmlInlines title
+ md <- if null blocks
+ then return []
+ else writeMarkdown def $ Pandoc nullMeta $ map fromBlk blocks
+ let attrs = [("text", htmlIls)] ++ [("_note", md)]
+ o <- mapM (elementToOPML opts) rest
+ return $ inTags True "outline" attrs $ vcat o
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 444a09587..903c94828 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -47,6 +47,7 @@ import qualified Data.Map as Map
import Text.Pandoc.Writers.Shared
import Data.List (sortBy)
import Data.Ord (comparing)
+import Text.Pandoc.Class (PandocMonad)
-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
@@ -190,8 +191,8 @@ handleSpaces s
rm [] = empty
-- | Convert Pandoc document to string in OpenDocument format.
-writeOpenDocument :: WriterOptions -> Pandoc -> String
-writeOpenDocument opts (Pandoc meta blocks) =
+writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeOpenDocument opts (Pandoc meta blocks) = return $
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 330f24b0b..febb2e98f 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -42,6 +42,7 @@ import Text.Pandoc.Templates (renderTemplate')
import Data.Char ( isAlphaNum, toLower )
import Data.List ( isPrefixOf, intersect, intersperse, partition, transpose )
import Control.Monad.State
+import Text.Pandoc.Class (PandocMonad)
data WriterState =
WriterState { stNotes :: [[Block]]
@@ -52,8 +53,8 @@ data WriterState =
}
-- | Convert Pandoc to Org.
-writeOrg :: WriterOptions -> Pandoc -> String
-writeOrg opts document =
+writeOrg :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeOrg opts document = return $
let st = WriterState { stNotes = [], stLinks = False,
stImages = False, stHasMath = False,
stOptions = opts }
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index c170889cc..438407cce 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -44,6 +44,7 @@ import Network.URI (isURI)
import Text.Pandoc.Pretty
import Control.Monad.State
import Data.Char (isSpace, toLower)
+import Text.Pandoc.Class (PandocMonad)
type Refs = [([Inline], Target)]
@@ -58,8 +59,8 @@ data WriterState =
}
-- | Convert Pandoc to RST.
-writeRST :: WriterOptions -> Pandoc -> String
-writeRST opts document =
+writeRST :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeRST opts document = return $
let st = WriterState { stNotes = [], stLinks = [],
stImages = [], stHasMath = False,
stHasRawTeX = False, stOptions = opts,
diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs
index 27a2819a0..0a22ae085 100644
--- a/src/Text/Pandoc/Writers/TEI.hs
+++ b/src/Text/Pandoc/Writers/TEI.hs
@@ -41,6 +41,7 @@ import Text.Pandoc.Highlighting ( languages, languagesByExtension )
import Text.Pandoc.Pretty
import Text.Pandoc.ImageSize
import qualified Text.Pandoc.Builder as B
+import Text.Pandoc.Class ( PandocMonad )
-- | Convert list of authors to a docbook <author> section
authorToTEI :: WriterOptions -> [Inline] -> B.Inlines
@@ -53,8 +54,8 @@ authorToTEI opts name' =
inTagsSimple "author" (text $ escapeStringForXML name)
-- | Convert Pandoc document to string in Docbook format.
-writeTEI :: WriterOptions -> Pandoc -> String
-writeTEI opts (Pandoc meta blocks) =
+writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeTEI opts (Pandoc meta blocks) = return $
let elements = hierarchicalize blocks
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index 993e6fbfd..fac7f02ab 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -44,6 +44,7 @@ import Text.Pandoc.ImageSize
import Network.URI ( isURI, unEscapeString )
import System.FilePath
import qualified Data.Set as Set
+import Text.Pandoc.Class ( PandocMonad )
data WriterState =
WriterState { stStrikeout :: Bool -- document contains strikeout
@@ -60,8 +61,8 @@ data WriterState =
-}
-- | Convert Pandoc to Texinfo.
-writeTexinfo :: WriterOptions -> Pandoc -> String
-writeTexinfo options document =
+writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeTexinfo options document = return $
evalState (pandocToTexinfo options $ wrapTop document) $
WriterState { stStrikeout = False, stSuperscript = False,
stEscapeComma = False, stSubscript = False,
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 4283e29cc..9691b7705 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -41,6 +41,7 @@ import Text.Pandoc.XML ( escapeStringForXML )
import Data.List ( intercalate )
import Control.Monad.State
import Data.Char ( isSpace )
+import Text.Pandoc.Class ( PandocMonad )
data WriterState = WriterState {
stNotes :: [String] -- Footnotes
@@ -50,8 +51,8 @@ data WriterState = WriterState {
}
-- | Convert Pandoc to Textile.
-writeTextile :: WriterOptions -> Pandoc -> String
-writeTextile opts document =
+writeTextile :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeTextile opts document = return $
evalState (pandocToTextile opts document)
WriterState { stNotes = [], stListLevel = [], stStartNum = Nothing,
stUseTags = False }
diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs
index 56a5d5455..f15b290e4 100644
--- a/src/Text/Pandoc/Writers/ZimWiki.hs
+++ b/src/Text/Pandoc/Writers/ZimWiki.hs
@@ -45,6 +45,7 @@ import Network.URI ( isURI )
import Control.Monad ( zipWithM )
import Control.Monad.State ( modify, State, get, evalState )
--import Control.Monad.Reader ( ReaderT, runReaderT, ask, local )
+import Text.Pandoc.Class ( PandocMonad )
data WriterState = WriterState {
stItemNum :: Int,
@@ -55,8 +56,8 @@ instance Default WriterState where
def = WriterState { stItemNum = 1, stIndent = "" }
-- | Convert Pandoc to ZimWiki.
-writeZimWiki :: WriterOptions -> Pandoc -> String
-writeZimWiki opts document = evalState (pandocToZimWiki opts document) (WriterState 1 "")
+writeZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeZimWiki opts document = return $ evalState (pandocToZimWiki opts document) (WriterState 1 "")
-- | Return ZimWiki representation of document.
pandocToZimWiki :: WriterOptions -> Pandoc -> State WriterState String