diff --git a/pandoc.hs b/pandoc.hs
index a032922be..662dd3e3b 100644
--- a/pandoc.hs
+++ b/pandoc.hs
@@ -77,6 +77,7 @@ import Text.Printf (printf)
import System.Posix.Terminal (queryTerminal)
import System.Posix.IO (stdOutput)
#endif
+import Text.Pandoc.Class (runIOorExplode, PandocIO)
type Transform = Pandoc -> Pandoc
@@ -914,7 +915,7 @@ options =
let allopts = unwords (concatMap optnames options)
UTF8.hPutStrLn stdout $ printf tpl allopts
(unwords (map fst readers))
- (unwords (map fst writers))
+ (unwords (map fst (writers' :: [(String, Writer' PandocIO)])))
(unwords $ map fst highlightingStyles)
ddir
exitSuccess ))
@@ -931,7 +932,7 @@ options =
, Option "" ["list-output-formats"]
(NoArg
(\_ -> do
- let writers'names = sort (map fst writers)
+ let writers'names = sort (map fst (writers' :: [(String, Writer' PandocIO)]))
mapM_ (UTF8.hPutStrLn stdout) writers'names
exitSuccess ))
""
@@ -1268,10 +1269,12 @@ convertWithOpts opts args = do
let laTeXInput = "latex" `isPrefixOf` readerName' ||
"beamer" `isPrefixOf` readerName'
+
+ -- disabling the custom writer for now
writer <- if ".lua" `isSuffixOf` format
-- note: use non-lowercased version writerName
- then return $ IOStringWriter $ writeCustom writerName
- else case getWriter writerName' of
+ then error "custom writers disabled for now"
+ else case getWriter' writerName' of
Left e -> err 9 $
if format == "pdf"
then e ++
@@ -1477,9 +1480,9 @@ convertWithOpts opts args = do
writerFn f = UTF8.writeFile f
case writer of
- IOStringWriter f -> f writerOptions doc' >>= writerFn outputFile
- IOByteStringWriter f -> f writerOptions doc' >>= writeFnBinary outputFile
- PureStringWriter f
+ -- StringWriter f -> f writerOptions doc' >>= writerFn outputFile
+ ByteStringWriter' f -> (runIOorExplode $ f writerOptions doc') >>= writeFnBinary outputFile
+ StringWriter' f
| pdfOutput -> do
-- make sure writer is latex or beamer or context or html5
unless (laTeXOutput || conTeXtOutput || html5Output) $
@@ -1503,14 +1506,14 @@ convertWithOpts opts args = do
B.hPutStr stderr err'
B.hPut stderr $ B.pack [10]
err 43 "Error producing PDF"
- | otherwise -> selfcontain (f writerOptions doc' ++
- ['\n' | not standalone'])
- >>= writerFn outputFile . handleEntities
- where htmlFormat = format `elem`
- ["html","html5","s5","slidy","slideous","dzslides","revealjs"]
- selfcontain = if selfContained && htmlFormat
- then makeSelfContained writerOptions
- else return
- handleEntities = if htmlFormat && ascii
- then toEntities
- else id
+ | otherwise -> do
+ let htmlFormat = format `elem`
+ ["html","html5","s5","slidy","slideous","dzslides","revealjs"]
+ selfcontain = if selfContained && htmlFormat
+ then makeSelfContained writerOptions
+ else return
+ handleEntities = if htmlFormat && ascii
+ then toEntities
+ else id
+ output <- runIOorExplode $ f writerOptions doc'
+ selfcontain (output ++ ['\n' | not standalone']) >>= writerFn outputFile . handleEntities
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 $
+ Just (StringWriter' r) -> Right $ StringWriter' $
\o -> r o{ writerExtensions = setExts $
getDefaultExtensions writerName }
- Just (IOStringWriter r) -> Right $ IOStringWriter $
- \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
+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 :: WriterOptions -> [Inline] -> Identity String
+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 []
+blocksToNodes :: PandocMonad m => [Block] -> m [Node]
+blocksToNodes = foldrM 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')
+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 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)
- let chapterEntries = zipWith chapToEntry [1..] chapters
+ 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