diff options
author | Jesse Rosenthal <jrosenthal@jhu.edu> | 2016-11-26 08:46:28 -0500 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2017-01-25 17:07:39 +0100 |
commit | 04487779b26458597fb751325b24c576b5088662 (patch) | |
tree | 0ee34da90dcfaee63b821ac68f8e0a40267d616a /src/Text | |
parent | b19f79f672c49322328584fa339215e4234d98af (diff) | |
download | pandoc-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')
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 |