{-# OPTIONS_GHC -Wall #-}

module Text.Pandoc.Z.Writers where

import Control.Lens ( view, _Left, review, over )
import Data.ByteString.Lazy ( ByteString )
import Data.Set( Set )
import Data.Text ( Text )
import Text.Blaze.Html ( Html )
import Text.Pandoc.Class ( PandocMonad )
import Text.Pandoc.Options ( EPUBVersion )
import qualified Text.Pandoc.Writers.AsciiDoc as W
import qualified Text.Pandoc.Writers.BibTeX as W
import qualified Text.Pandoc.Writers.ChunkedHTML as W
import qualified Text.Pandoc.Writers.CommonMark as W
import qualified Text.Pandoc.Writers.ConTeXt as W
import qualified Text.Pandoc.Writers.CslJson as W
import qualified Text.Pandoc.Writers.Djot as W
import qualified Text.Pandoc.Writers.DocBook as W
import qualified Text.Pandoc.Writers.Docx as W
import qualified Text.Pandoc.Writers.DokuWiki as W
import qualified Text.Pandoc.Writers.EPUB as W
import qualified Text.Pandoc.Writers.FB2 as W
import qualified Text.Pandoc.Writers.HTML as W
import qualified Text.Pandoc.Writers.Haddock as W
import qualified Text.Pandoc.Writers.ICML as W
import qualified Text.Pandoc.Writers.Ipynb as W
import qualified Text.Pandoc.Writers.JATS as W
import qualified Text.Pandoc.Writers.Jira as W
import qualified Text.Pandoc.Writers.LaTeX as W
import qualified Text.Pandoc.Writers.Man as W
import qualified Text.Pandoc.Writers.Markdown as W
import qualified Text.Pandoc.Writers.Math as W
import qualified Text.Pandoc.Writers.MediaWiki as W
import qualified Text.Pandoc.Writers.Ms as W
import qualified Text.Pandoc.Writers.Muse as W
import qualified Text.Pandoc.Writers.Native as W
import qualified Text.Pandoc.Writers.ODT as W
import qualified Text.Pandoc.Writers.OPML as W
import qualified Text.Pandoc.Writers.OpenDocument as W
import qualified Text.Pandoc.Writers.Org as W
import qualified Text.Pandoc.Writers.Powerpoint as W
import qualified Text.Pandoc.Writers.RST as W
import qualified Text.Pandoc.Writers.RTF as W
import qualified Text.Pandoc.Writers.TEI as W
import qualified Text.Pandoc.Writers.Texinfo as W
import qualified Text.Pandoc.Writers.Textile as W
import qualified Text.Pandoc.Writers.Typst as W
import qualified Text.Pandoc.Writers.XWiki as W
import qualified Text.Pandoc.Writers.ZimWiki as W
import Text.Pandoc.Z.Definition
    ( Inline, MathType, Pandoc, isPandoc, isMathType, isInline )
import Text.Pandoc.Z.WriterOptions ( WriterOptions )
import Text.TeXMath.Types ( DisplayType, Exp )

-- $setup
-- >>> import Control.Lens
-- >>> import Data.Text as Text
-- >>> import Text.Pandoc.Z.Combinators
-- >>> import Text.Pandoc.Z.Definition
-- >>> import Text.Pandoc.Z.Util

-- |
--
-- >>> writePandocExtensions writeAsciiDoc mempty
-- Right ""
--
-- >>> writePandocExtensions writeAsciiDoc (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "**\n\nabc\n"
--
-- >>> writePandocExtensions writeAsciiDoc (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "[cols=\",,\",options=\"header\",]\n|===\n|abc |def |ghi\n|===\n"
--
-- >>> writePandocExtensions writeAsciiDoc (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "[cols=\",,\",options=\"header\",]\n|===\n|abc |def |ghi\n|jkl |mno |pqr\n|===\n"
writeAsciiDoc ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeAsciiDoc :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeAsciiDoc WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeAsciiDoc WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeAsciiDocLegacy mempty
-- Right ""
--
-- >>> writePandocExtensions writeAsciiDocLegacy (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "**\n\nabc\n"
--
-- >>> writePandocExtensions writeAsciiDocLegacy (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "[cols=\",,\",options=\"header\",]\n|===\n|abc |def |ghi\n|===\n"
--
-- >>> writePandocExtensions writeAsciiDocLegacy (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "[cols=\",,\",options=\"header\",]\n|===\n|abc |def |ghi\n|jkl |mno |pqr\n|===\n"
writeAsciiDocLegacy ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeAsciiDocLegacy :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeAsciiDocLegacy WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeAsciiDocLegacy WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeBibTeX ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeBibTeX :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBibTeX WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeBibTeX WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeBibLaTeX ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeBibLaTeX :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBibLaTeX WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeBibLaTeX WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeChunkedHTML ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m ByteString
writeChunkedHTML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeChunkedHTML WriterOptions
o =
  WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
W.writeChunkedHTML WriterOptions
o (Pandoc -> m ByteString)
-> (Pandoc -> Pandoc) -> Pandoc -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeCommonMark ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeCommonMark :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeCommonMark WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeCommonMark WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeConTeXt ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeConTeXt :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeConTeXt WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeConTeXt WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeCslJson ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeCslJson :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeCslJson WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeCslJson WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeDjot ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeDjot :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDjot WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeDjot WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeDocBook4 mempty
-- Right ""
--
-- >>> writePandocExtensions writeDocBook4 (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<emphasis role=\"strong\"></emphasis>\nabc"
--
-- >>> writePandocExtensions writeDocBook4 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<informaltable>\n  <tgroup cols=\"3\">\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <thead>\n      <row>\n        <entry>\n          abc\n        </entry>\n        <entry>\n          def\n        </entry>\n        <entry>\n          ghi\n        </entry>\n      </row>\n    </thead>\n    <tbody>\n    </tbody>\n  </tgroup>\n</informaltable>"
--
-- >>> writePandocExtensions writeDocBook4 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<informaltable>\n  <tgroup cols=\"3\">\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <thead>\n      <row>\n        <entry>\n          abc\n        </entry>\n        <entry>\n          def\n        </entry>\n        <entry>\n          ghi\n        </entry>\n      </row>\n    </thead>\n    <tbody>\n      <row>\n        <entry>\n          jkl\n        </entry>\n        <entry>\n          mno\n        </entry>\n        <entry>\n          pqr\n        </entry>\n      </row>\n    </tbody>\n  </tgroup>\n</informaltable>"
writeDocBook4 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeDocBook4 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDocBook4 WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeDocBook4 WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeDocBook5 mempty
-- Right ""
--
-- >>> writePandocExtensions writeDocBook5 (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<emphasis role=\"strong\"></emphasis>\nabc"
--
-- >>> writePandocExtensions writeDocBook5 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<informaltable>\n  <tgroup cols=\"3\">\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <thead>\n      <row>\n        <entry>\n          abc\n        </entry>\n        <entry>\n          def\n        </entry>\n        <entry>\n          ghi\n        </entry>\n      </row>\n    </thead>\n    <tbody>\n    </tbody>\n  </tgroup>\n</informaltable>"
--
-- >>> writePandocExtensions writeDocBook5 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<informaltable>\n  <tgroup cols=\"3\">\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <colspec align=\"left\" />\n    <thead>\n      <row>\n        <entry>\n          abc\n        </entry>\n        <entry>\n          def\n        </entry>\n        <entry>\n          ghi\n        </entry>\n      </row>\n    </thead>\n    <tbody>\n      <row>\n        <entry>\n          jkl\n        </entry>\n        <entry>\n          mno\n        </entry>\n        <entry>\n          pqr\n        </entry>\n      </row>\n    </tbody>\n  </tgroup>\n</informaltable>"
writeDocBook5 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeDocBook5 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDocBook5 WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeDocBook5 WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeDocx ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m ByteString
writeDocx :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeDocx WriterOptions
o =
  WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
W.writeDocx WriterOptions
o (Pandoc -> m ByteString)
-> (Pandoc -> Pandoc) -> Pandoc -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeDokuWiki mempty
-- Right ""
--
-- >>> writePandocExtensions writeDokuWiki (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "****\nabc"
--
-- >>> writePandocExtensions writeDokuWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "^abc^def^ghi^\n"
--
-- >>> writePandocExtensions writeDokuWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "^abc^def^ghi^\n|jkl|mno|pqr|\n"
writeDokuWiki ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeDokuWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDokuWiki WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeDokuWiki WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeEPUB2 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m ByteString
writeEPUB2 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeEPUB2 WriterOptions
o =
  WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
W.writeEPUB2 WriterOptions
o (Pandoc -> m ByteString)
-> (Pandoc -> Pandoc) -> Pandoc -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeEPUB3 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m ByteString
writeEPUB3 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeEPUB3 WriterOptions
o =
  WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
W.writeEPUB3 WriterOptions
o (Pandoc -> m ByteString)
-> (Pandoc -> Pandoc) -> Pandoc -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeFB2 mempty
-- Right "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\" xmlns:l=\"http://www.w3.org/1999/xlink\"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title></body></FictionBook>\n"
--
-- >>> writePandocExtensions writeFB2 (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\" xmlns:l=\"http://www.w3.org/1999/xlink\"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title><section><strong />abc</section></body></FictionBook>\n"
--
-- >>> writePandocExtensions writeFB2 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\" xmlns:l=\"http://www.w3.org/1999/xlink\"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title><section><table><tr><th align=\"left\">abc</th><th align=\"left\">def</th><th align=\"left\">ghi</th></tr></table><p><emphasis /></p></section></body></FictionBook>\n"
--
-- >>> writePandocExtensions writeFB2 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<FictionBook xmlns=\"http://www.gribuser.ru/xml/fictionbook/2.0\" xmlns:l=\"http://www.w3.org/1999/xlink\"><description><title-info><genre>unrecognised</genre></title-info><document-info><program-used>pandoc</program-used></document-info></description><body><title><p /></title><section><table><tr><th align=\"left\">abc</th><th align=\"left\">def</th><th align=\"left\">ghi</th></tr><tr><td align=\"left\">jkl</td><td align=\"left\">mno</td><td align=\"left\">pqr</td></tr></table><p><emphasis /></p></section></body></FictionBook>\n"
writeFB2 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeFB2 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeFB2 WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeFB2 WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeHtml4 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Html
writeHtml4 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
writeHtml4 WriterOptions
o =
  WriterOptions -> Pandoc -> m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
W.writeHtml4 WriterOptions
o (Pandoc -> m Html) -> (Pandoc -> Pandoc) -> Pandoc -> m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeHtml4String mempty
-- Right ""
--
-- >>> writePandocExtensions writeHtml4String (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<strong></strong>\nabc"
--
-- >>> writePandocExtensions writeHtml4String (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n</tbody>\n</table>"
--
-- >>> writePandocExtensions writeHtml4String (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n<tr>\n<td>jkl</td>\n<td>mno</td>\n<td>pqr</td>\n</tr>\n</tbody>\n</table>"
writeHtml4String ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeHtml4String :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml4String WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeHtml4String WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeHtml5 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Html
writeHtml5 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
writeHtml5 WriterOptions
o =
  WriterOptions -> Pandoc -> m Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
W.writeHtml5 WriterOptions
o (Pandoc -> m Html) -> (Pandoc -> Pandoc) -> Pandoc -> m Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeHtml5String mempty
-- Right ""
--
-- >>> writePandocExtensions writeHtml5String (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<strong></strong>\nabc"
--
-- >>> writePandocExtensions writeHtml5String (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n</tbody>\n</table>"
--
-- >>> writePandocExtensions writeHtml5String (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n<tr>\n<td>jkl</td>\n<td>mno</td>\n<td>pqr</td>\n</tr>\n</tbody>\n</table>"
writeHtml5String ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeHtml5String :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeHtml5String WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc
writeHtmlStringForEPUB ::
  PandocMonad m =>
  EPUBVersion
  -> WriterOptions
  -> Pandoc
  -> m Text
writeHtmlStringForEPUB :: forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
writeHtmlStringForEPUB EPUBVersion
v WriterOptions
o =
  EPUBVersion -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
EPUBVersion -> WriterOptions -> Pandoc -> m Text
W.writeHtmlStringForEPUB EPUBVersion
v WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeS5 mempty
-- Right "<div class=\"slide section level6\">\n\n</div>"
--
-- >>> writePandocExtensions writeS5 (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<div class=\"slide section level6\">\n\n<strong></strong>\nabc\n</div>"
--
-- >>> writePandocExtensions writeS5 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<div class=\"slide section level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</div>"
--
-- >>> writePandocExtensions writeS5 (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<div class=\"slide section level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n<tr>\n<td>jkl</td>\n<td>mno</td>\n<td>pqr</td>\n</tr>\n</tbody>\n</table>\n</div>"
writeS5 ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeS5 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeS5 WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeS5 WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeSlidy mempty
-- Right "<div class=\"slide section level6\">\n\n</div>"
--
-- >>> writePandocExtensions writeSlidy (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<div class=\"slide section level6\">\n\n<strong></strong>\nabc\n</div>"
--
-- >>> writePandocExtensions writeSlidy (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<div class=\"slide section level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</div>"
--
-- >>> writePandocExtensions writeSlidy (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<div class=\"slide section level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n<tr>\n<td>jkl</td>\n<td>mno</td>\n<td>pqr</td>\n</tr>\n</tbody>\n</table>\n</div>"
writeSlidy ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeSlidy :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeSlidy WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeSlidy WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeSlideous mempty
-- Right "<div class=\"slide section level6\">\n\n</div>"
--
-- >>> writePandocExtensions writeSlideous (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<div class=\"slide section level6\">\n\n<strong></strong>\nabc\n</div>"
--
-- >>> writePandocExtensions writeSlideous (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<div class=\"slide section level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</div>"
--
-- >>> writePandocExtensions writeSlideous (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<div class=\"slide section level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n<tr>\n<td>jkl</td>\n<td>mno</td>\n<td>pqr</td>\n</tr>\n</tbody>\n</table>\n</div>"
writeSlideous ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeSlideous :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeSlideous WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeSlideous WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeDZSlides mempty
-- Right "<section class=\"slide level6\">\n\n</section>"
--
-- >>> writePandocExtensions writeDZSlides (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<section class=\"slide level6\">\n\n<strong></strong>\nabc\n</section>"
--
-- >>> writePandocExtensions writeDZSlides (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<section class=\"slide level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</section>"
--
-- >>> writePandocExtensions writeDZSlides (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<section class=\"slide level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n<tr>\n<td>jkl</td>\n<td>mno</td>\n<td>pqr</td>\n</tr>\n</tbody>\n</table>\n</section>"
writeDZSlides ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeDZSlides :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDZSlides WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeDZSlides WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeRevealJs mempty
-- Right "<section class=\"slide level6\">\n\n</section>"
--
-- >>> writePandocExtensions writeRevealJs (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<section class=\"slide level6\">\n\n<strong></strong>\nabc\n</section>"
--
-- >>> writePandocExtensions writeRevealJs (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<section class=\"slide level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n</tbody>\n</table>\n</section>"
--
-- >>> writePandocExtensions writeRevealJs (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<section class=\"slide level6\">\n\n<table>\n<thead>\n<tr>\n<th>abc</th>\n<th>def</th>\n<th>ghi</th>\n</tr>\n</thead>\n<tbody>\n<tr>\n<td>jkl</td>\n<td>mno</td>\n<td>pqr</td>\n</tr>\n</tbody>\n</table>\n</section>"
writeRevealJs ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeRevealJs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRevealJs WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeRevealJs WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeHaddock mempty
-- Right ""
--
-- >>> writePandocExtensions writeHaddock (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "____\nabc\n"
--
-- >>> writePandocExtensions writeHaddock (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "+-----+-----+-----+\n| abc | def | ghi |\n+=====+=====+=====+\n+-----+-----+-----+\n"
--
-- >>> writePandocExtensions writeHaddock (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "+-----+-----+-----+\n| abc | def | ghi |\n+=====+=====+=====+\n| jkl | mno | pqr |\n+-----+-----+-----+\n"
writeHaddock ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeHaddock :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHaddock WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeHaddock WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeICML mempty
-- Right ""
--
-- >>> writePandocExtensions writeICML (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<ParagraphStyleRange AppliedParagraphStyle=\"\">\n</ParagraphStyleRange>\n<Br />\n<ParagraphStyleRange AppliedParagraphStyle=\"\">\n  <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n    <Content>abc</Content>\n  </CharacterStyleRange>\n</ParagraphStyleRange>"
--
-- >>> writePandocExtensions writeICML (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<Table AppliedTableStyle=\"TableStyle/Table\" HeaderRowCount=\"1\" BodyRowCount=\"0\" ColumnCount=\"0\">\n  <Cell Name=\"0:0\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar &gt; TableHeader\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>abc</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n  <Cell Name=\"1:0\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar &gt; TableHeader\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>def</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n  <Cell Name=\"2:0\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar &gt; TableHeader\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>ghi</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n</Table>\n<ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TableCaption\">\n</ParagraphStyleRange>"
--
-- >>> writePandocExtensions writeICML (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<Table AppliedTableStyle=\"TableStyle/Table\" HeaderRowCount=\"1\" BodyRowCount=\"1\" ColumnCount=\"3\">\n  <Column Name=\"0\" />\n  <Column Name=\"1\" />\n  <Column Name=\"2\" />\n  <Cell Name=\"0:0\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar &gt; TableHeader\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>abc</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n  <Cell Name=\"1:0\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar &gt; TableHeader\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>def</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n  <Cell Name=\"2:0\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar &gt; TableHeader\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>ghi</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n  <Cell Name=\"0:1\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>jkl</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n  <Cell Name=\"1:1\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>mno</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n  <Cell Name=\"2:1\" AppliedCellStyle=\"CellStyle/Cell\">\n    <ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TablePar\">\n      <CharacterStyleRange AppliedCharacterStyle=\"$ID/NormalCharacterStyle\">\n        <Content>pqr</Content>\n      </CharacterStyleRange>\n    </ParagraphStyleRange>\n  </Cell>\n</Table>\n<ParagraphStyleRange AppliedParagraphStyle=\"ParagraphStyle/TableCaption\">\n</ParagraphStyleRange>"
writeICML ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeICML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeICML WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeICML WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeIpynb ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeIpynb :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeIpynb WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeIpynb WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeJatsArchiving ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeJatsArchiving :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArchiving WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeJatsArchiving WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeJatsPublishing ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeJatsPublishing :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsPublishing WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeJatsPublishing WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeJatsArticleAuthoring ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeJatsArticleAuthoring :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArticleAuthoring WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeJatsPublishing WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeJira ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeJira :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJira WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeJira WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeLaTeX mempty
-- Right ""
--
-- >>> writePandocExtensions writeLaTeX (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "\\textbf{}\n\nabc"
--
-- >>> writePandocExtensions writeLaTeX (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "\\begin{longtable}[]{@{}lll@{}}\n\\toprule\\noalign{}\nabc & def & ghi \\\\\n\\midrule\\noalign{}\n\\endhead\n\\bottomrule\\noalign{}\n\\endlastfoot\n\\end{longtable}"
--
-- >>> writePandocExtensions writeLaTeX (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "\\begin{longtable}[]{@{}lll@{}}\n\\toprule\\noalign{}\nabc & def & ghi \\\\\n\\midrule\\noalign{}\n\\endhead\n\\bottomrule\\noalign{}\n\\endlastfoot\njkl & mno & pqr \\\\\n\\end{longtable}"
writeLaTeX ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeLaTeX :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeLaTeX WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeBeamer mempty
-- Right "\\begin{frame}\n\\end{frame}"
--
-- >>> writePandocExtensions writeBeamer (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "\\begin{frame}\n\\textbf{}\n\nabc\n\\end{frame}"
--
-- >>> writePandocExtensions writeBeamer (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "\\begin{frame}\n\\begin{longtable}[]{@{}lll@{}}\n\\toprule\\noalign{}\nabc & def & ghi \\\\\n\\midrule\\noalign{}\n\\endhead\n\\bottomrule\\noalign{}\n\\end{longtable}\n\\end{frame}"
--
-- >>> writePandocExtensions writeBeamer (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "\\begin{frame}\n\\begin{longtable}[]{@{}lll@{}}\n\\toprule\\noalign{}\nabc & def & ghi \\\\\n\\midrule\\noalign{}\n\\endhead\njkl & mno & pqr \\\\\n\\bottomrule\\noalign{}\n\\end{longtable}\n\\end{frame}"
writeBeamer ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeBeamer :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBeamer WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeBeamer WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeMan mempty
-- Right ""
--
-- >>> writePandocExtensions writeMan (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "\\textbf{}\n\nabc"
--
-- >>> writePandocExtensions writeMan (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right ".PP\n.TS\ntab(@);\nl l l.\nT{\nabc\nT}@T{\ndef\nT}@T{\nghi\nT}\n_\n.TE"
--
-- >>> writePandocExtensions writeMan (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right ".PP\n.TS\ntab(@);\nl l l.\nT{\nabc\nT}@T{\ndef\nT}@T{\nghi\nT}\n_\nT{\njkl\nT}@T{\nmno\nT}@T{\npqr\nT}\n.TE"
writeMan ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeMan :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMan WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeMan WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeMarkdown mempty
-- Right ""
--
-- >>> writePandocExtensions writeMarkdown (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "abc\n"
--
-- >>> writePandocExtensions writeMarkdown (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "  abc   def   ghi\n  ----- ----- -----\n"
--
-- >>> writePandocExtensions writeMarkdown (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "  abc   def   ghi\n  ----- ----- -----\n  jkl   mno   pqr\n"
writeMarkdown ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeMarkdown :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeMarkdown WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeMarkua ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeMarkua :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkua WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeMarkua WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writePlain mempty
-- Right ""
--
-- >>> writePandocExtensions writePlain (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "abc\n"
--
-- >>> writePandocExtensions writePlain (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "  abc   def   ghi\n  ----- ----- -----\n"
--
-- >>> writePandocExtensions writePlain (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "  abc   def   ghi\n  ----- ----- -----\n  jkl   mno   pqr\n"
writePlain ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writePlain :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writePlain WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

texMathToInlines ::
  PandocMonad m =>
  MathType
  -> Text
  -> m [Inline]
texMathToInlines :: forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
m Text
t =
  ([Inline] -> [Inline]) -> m [Inline] -> m [Inline]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AReview Inline Inline -> Inline -> Inline
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Inline Inline
Iso' Inline Inline
isInline)) (MathType -> Text -> m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
W.texMathToInlines (Getting MathType MathType MathType -> MathType -> MathType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MathType MathType MathType
Iso' MathType MathType
isMathType MathType
m) Text
t)

convertMath ::
  PandocMonad m =>
  (DisplayType -> [Exp] -> a)
  -> MathType
  -> Text
  -> m (Either Inline a)
convertMath :: forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> a
f MathType
m Text
t =
  (Either Inline a -> Either Inline a)
-> m (Either Inline a) -> m (Either Inline a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter (Either Inline a) (Either Inline a) Inline Inline
-> (Inline -> Inline) -> Either Inline a -> Either Inline a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Either Inline a) (Either Inline a) Inline Inline
forall a c b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either a c) (f (Either b c))
_Left (AReview Inline Inline -> Inline -> Inline
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview Inline Inline
Iso' Inline Inline
isInline)) ((DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
W.convertMath DisplayType -> [Exp] -> a
f (Getting MathType MathType MathType -> MathType -> MathType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MathType MathType MathType
Iso' MathType MathType
isMathType MathType
m) Text
t)

-- |
--
-- >>> writePandocExtensions writeMediaWiki mempty
-- Right ""
--
-- >>> writePandocExtensions writeMediaWiki (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "''''''\nabc"
--
-- >>> writePandocExtensions writeMediaWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "{| class=\"wikitable\"\n|-\n! abc\n! def\n! ghi\n|}\n"
--
-- >>> writePandocExtensions writeMediaWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "{| class=\"wikitable\"\n|-\n! abc\n! def\n! ghi\n|-\n| jkl\n| mno\n| pqr\n|}\n"
writeMediaWiki ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMediaWiki WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeMediaWiki WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

highlightingLangs ::
  Set Text
highlightingLangs :: Set Text
highlightingLangs =
  Set Text
W.highlightingLangs

-- |
--
-- >>> writePandocExtensions writeMs mempty
-- Right ""
--
-- >>> writePandocExtensions writeMs (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "\\f[B]\\f[R]\nabc"
--
-- >>> writePandocExtensions writeMs (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right ".PP\n.na\n.TS\ndelim(@@) tab(\t);\nl l l.\nT{\nabc\nT}\tT{\ndef\nT}\tT{\nghi\nT}\n_\n.TE\n.ad"
--
-- >>> writePandocExtensions writeMs (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right ".PP\n.na\n.TS\ndelim(@@) tab(\t);\nl l l.\nT{\nabc\nT}\tT{\ndef\nT}\tT{\nghi\nT}\n_\nT{\njkl\nT}\tT{\nmno\nT}\tT{\npqr\nT}\n.TE\n.ad"
writeMs ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeMs :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMs WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeMs WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeMuse mempty
-- Right ""
--
-- >>> writePandocExtensions writeMuse (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<strong></strong>\nabc\n"
--
-- >>> writePandocExtensions writeMuse (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right " abc || def || ghi\n"
--
-- >>> writePandocExtensions writeMuse (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right " abc || def || ghi\n jkl |  mno |  pqr\n"
writeMuse ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeMuse :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMuse WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeMuse WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeNative mempty
-- Right "[]"
--
-- >>> writePandocExtensions writeNative (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "[ Plain [ Strong [] ] , Plain [ Str \"abc\" ] ]"
--
-- >>> writePandocExtensions writeNative (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "[ Table\n    ( \"\" , [] , [] )\n    (Caption Nothing [])\n    [ ( AlignDefault , ColWidthDefault )\n    , ( AlignDefault , ColWidthDefault )\n    , ( AlignDefault , ColWidthDefault )\n    ]\n    (TableHead\n       ( \"\" , [] , [] )\n       [ Row\n           ( \"\" , [] , [] )\n           [ Cell\n               ( \"\" , [] , [] )\n               AlignDefault\n               (RowSpan 1)\n               (ColSpan 1)\n               [ Plain [ Str \"abc\" ] ]\n           , Cell\n               ( \"\" , [] , [] )\n               AlignDefault\n               (RowSpan 1)\n               (ColSpan 1)\n               [ Plain [ Str \"def\" ] ]\n           , Cell\n               ( \"\" , [] , [] )\n               AlignDefault\n               (RowSpan 1)\n               (ColSpan 1)\n               [ Plain [ Str \"ghi\" ] ]\n           ]\n       ])\n    [ TableBody ( \"\" , [] , [] ) (RowHeadColumns 0) [] [] ]\n    (TableFoot ( \"\" , [] , [] ) [])\n]"
--
-- >>> writePandocExtensions writeNative (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "[ Table\n    ( \"\" , [] , [] )\n    (Caption Nothing [])\n    [ ( AlignDefault , ColWidthDefault )\n    , ( AlignDefault , ColWidthDefault )\n    , ( AlignDefault , ColWidthDefault )\n    ]\n    (TableHead\n       ( \"\" , [] , [] )\n       [ Row\n           ( \"\" , [] , [] )\n           [ Cell\n               ( \"\" , [] , [] )\n               AlignDefault\n               (RowSpan 1)\n               (ColSpan 1)\n               [ Plain [ Str \"abc\" ] ]\n           , Cell\n               ( \"\" , [] , [] )\n               AlignDefault\n               (RowSpan 1)\n               (ColSpan 1)\n               [ Plain [ Str \"def\" ] ]\n           , Cell\n               ( \"\" , [] , [] )\n               AlignDefault\n               (RowSpan 1)\n               (ColSpan 1)\n               [ Plain [ Str \"ghi\" ] ]\n           ]\n       ])\n    [ TableBody\n        ( \"\" , [] , [] )\n        (RowHeadColumns 0)\n        []\n        [ Row\n            ( \"\" , [] , [] )\n            [ Cell\n                ( \"\" , [] , [] )\n                AlignDefault\n                (RowSpan 1)\n                (ColSpan 1)\n                [ Plain [ Str \"jkl\" ] ]\n            , Cell\n                ( \"\" , [] , [] )\n                AlignDefault\n                (RowSpan 1)\n                (ColSpan 1)\n                [ Plain [ Str \"mno\" ] ]\n            , Cell\n                ( \"\" , [] , [] )\n                AlignDefault\n                (RowSpan 1)\n                (ColSpan 1)\n                [ Plain [ Str \"pqr\" ] ]\n            ]\n        ]\n    ]\n    (TableFoot ( \"\" , [] , [] ) [])\n]"
writeNative ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeNative :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeNative WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeNative WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeODT ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m ByteString
writeODT :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeODT WriterOptions
o =
  WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
W.writeODT WriterOptions
o (Pandoc -> m ByteString)
-> (Pandoc -> Pandoc) -> Pandoc -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writeOPML ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeOPML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOPML WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeOPML WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeOpenDocument mempty
-- Right ""
--
-- >>> writePandocExtensions writeOpenDocument (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<text:p text:style-name=\"Text_20_body\"></text:p>\n<text:p text:style-name=\"Text_20_body\">abc</text:p>"
--
-- >>> writePandocExtensions writeOpenDocument (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<table:table table:name=\"Table1\" table:style-name=\"Table1\">\n  <table:table-column table:style-name=\"Table1.A\" />\n  <table:table-column table:style-name=\"Table1.B\" />\n  <table:table-column table:style-name=\"Table1.C\" />\n  <table:table-header-rows>\n    <table:table-row>\n      <table:table-cell table:style-name=\"TableHeaderRowCell\" office:value-type=\"string\">\n        <text:p text:style-name=\"Table_20_Heading\">abc</text:p>\n      </table:table-cell>\n      <table:table-cell table:style-name=\"TableHeaderRowCell\" office:value-type=\"string\">\n        <text:p text:style-name=\"Table_20_Heading\">def</text:p>\n      </table:table-cell>\n      <table:table-cell table:style-name=\"TableHeaderRowCell\" office:value-type=\"string\">\n        <text:p text:style-name=\"Table_20_Heading\">ghi</text:p>\n      </table:table-cell>\n    </table:table-row>\n  </table:table-header-rows>\n</table:table>"
--
-- >>> writePandocExtensions writeOpenDocument (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<table:table table:name=\"Table1\" table:style-name=\"Table1\">\n  <table:table-column table:style-name=\"Table1.A\" />\n  <table:table-column table:style-name=\"Table1.B\" />\n  <table:table-column table:style-name=\"Table1.C\" />\n  <table:table-header-rows>\n    <table:table-row>\n      <table:table-cell table:style-name=\"TableHeaderRowCell\" office:value-type=\"string\">\n        <text:p text:style-name=\"Table_20_Heading\">abc</text:p>\n      </table:table-cell>\n      <table:table-cell table:style-name=\"TableHeaderRowCell\" office:value-type=\"string\">\n        <text:p text:style-name=\"Table_20_Heading\">def</text:p>\n      </table:table-cell>\n      <table:table-cell table:style-name=\"TableHeaderRowCell\" office:value-type=\"string\">\n        <text:p text:style-name=\"Table_20_Heading\">ghi</text:p>\n      </table:table-cell>\n    </table:table-row>\n  </table:table-header-rows>\n  <table:table-row>\n    <table:table-cell table:style-name=\"TableRowCell\" office:value-type=\"string\">\n      <text:p text:style-name=\"Table_20_Contents\">jkl</text:p>\n    </table:table-cell>\n    <table:table-cell table:style-name=\"TableRowCell\" office:value-type=\"string\">\n      <text:p text:style-name=\"Table_20_Contents\">mno</text:p>\n    </table:table-cell>\n    <table:table-cell table:style-name=\"TableRowCell\" office:value-type=\"string\">\n      <text:p text:style-name=\"Table_20_Contents\">pqr</text:p>\n    </table:table-cell>\n  </table:table-row>\n</table:table>"
writeOpenDocument ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeOpenDocument :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOpenDocument WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeOpenDocument WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeOrg mempty
-- Right ""
--
-- >>> writePandocExtensions writeOrg (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "**\nabc"
--
-- >>> writePandocExtensions writeOrg (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "| abc | def | ghi |\n|-----+-----+-----|\n"
--
-- >>> writePandocExtensions writeOrg (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "| abc | def | ghi |\n|-----+-----+-----|\n| jkl | mno | pqr |\n"
writeOrg ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeOrg :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOrg WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeOrg WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

writePowerpoint ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m ByteString
writePowerpoint :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writePowerpoint WriterOptions
o =
  WriterOptions -> Pandoc -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
W.writePowerpoint WriterOptions
o (Pandoc -> m ByteString)
-> (Pandoc -> Pandoc) -> Pandoc -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeRST mempty
-- Right ""
--
-- >>> writePandocExtensions writeRST (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "abc"
--
-- >>> writePandocExtensions writeRST (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "=== === ===\nabc def ghi\n=== === ===\n=== === ===\n"
--
-- >>> writePandocExtensions writeRST (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "=== === ===\nabc def ghi\n=== === ===\njkl mno pqr\n=== === ===\n"
writeRST ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeRST :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRST WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeRST WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeRTF mempty
-- Right "\n"
--
-- >>> writePandocExtensions writeRTF (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "{\\pard \\ql \\f0 \\sa0 \\li0 \\fi0 {\\b }\\par}\n{\\pard \\ql \\f0 \\sa0 \\li0 \\fi0 abc\\par}\n"
--
-- >>> writePandocExtensions writeRTF (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "{\n\\trowd \\trgaph120\n\\clbrdrb\\brdrs\\cellx2880\\clbrdrb\\brdrs\\cellx5760\\clbrdrb\\brdrs\\cellx8640\n\\trkeep\\intbl\n{\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 abc\\par}\n\\cell}\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 def\\par}\n\\cell}\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 ghi\\par}\n\\cell}\n}\n\\intbl\\row}\n{\\pard \\ql \\f0 \\sa180 \\li0 \\fi0 \\par}\n"
--
-- >>> writePandocExtensions writeRTF (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "{\n\\trowd \\trgaph120\n\\clbrdrb\\brdrs\\cellx2880\\clbrdrb\\brdrs\\cellx5760\\clbrdrb\\brdrs\\cellx8640\n\\trkeep\\intbl\n{\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 abc\\par}\n\\cell}\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 def\\par}\n\\cell}\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 ghi\\par}\n\\cell}\n}\n\\intbl\\row}\n{\n\\trowd \\trgaph120\n\\cellx2880\\cellx5760\\cellx8640\n\\trkeep\\intbl\n{\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 jkl\\par}\n\\cell}\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 mno\\par}\n\\cell}\n{{\\pard\\intbl \\ql \\f0 \\sa0 \\li0 \\fi0 pqr\\par}\n\\cell}\n}\n\\intbl\\row}\n{\\pard \\ql \\f0 \\sa180 \\li0 \\fi0 \\par}\n"
writeRTF ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeRTF :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRTF WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeRTF WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeTEI mempty
-- Right ""
--
-- >>> writePandocExtensions writeTEI (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "<p><hi rendition=\"simple:bold\"></hi></p>\n<p>abc</p>"
--
-- >>> writePandocExtensions writeTEI (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "<table>\n  <row role=\"label\">\n    <cell><p>abc</p></cell>\n    <cell><p>def</p></cell>\n    <cell><p>ghi</p></cell>\n  </row>\n</table>"
--
-- >>> writePandocExtensions writeTEI (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "<table>\n  <row role=\"label\">\n    <cell><p>abc</p></cell>\n    <cell><p>def</p></cell>\n    <cell><p>ghi</p></cell>\n  </row>\n  <row>\n    <cell><p>jkl</p></cell>\n    <cell><p>mno</p></cell>\n    <cell><p>pqr</p></cell>\n  </row>\n</table>"
writeTEI ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTEI WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeTEI WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeTexinfo mempty
-- Right "@node Top\n@top Top\n"
--
-- >>> writePandocExtensions writeTexinfo (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "@node Top\n@top Top\n\n@strong{}\nabc"
--
-- >>> writePandocExtensions writeTexinfo (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "@node Top\n@top Top\n\n@multitable {abc} {def} {ghi} \n@headitem \nabc\n @tab def\n @tab ghi\n@end multitable\n"
--
-- >>> writePandocExtensions writeTexinfo (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "@node Top\n@top Top\n\n@multitable {jkl} {mno} {pqr} \n@headitem \nabc\n @tab def\n @tab ghi\n@item \njkl\n @tab mno\n @tab pqr\n@end multitable\n"
writeTexinfo ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeTexinfo :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTexinfo WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeTexinfo WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeTextile mempty
-- Right ""
--
-- >>> writePandocExtensions writeTextile (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "**\nabc"
--
-- >>> writePandocExtensions writeTextile (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "|_. abc|_. def|_. ghi|\n"
--
-- >>> writePandocExtensions writeTextile (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "|_. abc|_. def|_. ghi|\n|jkl|mno|pqr|\n"
writeTextile ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeTextile :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTextile WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeTextile WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeTypst mempty
-- Right ""
--
-- >>> writePandocExtensions writeTypst (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "#strong[]\nabc"
--
-- >>> writePandocExtensions writeTypst (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "#figure(\n  align(center)[#table(\n    columns: 3,\n    align: (auto,auto,auto,),\n    table.header([abc], [def], [ghi],),\n    table.hline(),\n  )]\n  , kind: table\n  )\n"
--
-- >>> writePandocExtensions writeTypst (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "#figure(\n  align(center)[#table(\n    columns: 3,\n    align: (auto,auto,auto,),\n    table.header([abc], [def], [ghi],),\n    table.hline(),\n    [jkl], [mno], [pqr],\n  )]\n  , kind: table\n  )\n"
writeTypst ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeTypst :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTypst WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeTypst WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeXWiki mempty
-- Right ""
--
-- >>> writePandocExtensions writeXWiki (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "****\nabc"
--
-- >>> writePandocExtensions writeXWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "|=abc |=def |=ghi\n"
--
-- >>> writePandocExtensions writeXWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "|=abc |=def |=ghi\n|jkl |mno |pqr\n"
writeXWiki ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeXWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeXWiki WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeXWiki WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc

-- |
--
-- >>> writePandocExtensions writeZimWiki mempty
-- Right ""
--
-- >>> writePandocExtensions writeZimWiki (Pandoc mempty [Plain [Strong []],Plain [Str (Text.pack "abc")]])
-- Right "****\nabc"
--
-- >>> writePandocExtensions writeZimWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ tableHeadRows .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "abc"],cellXY 1 1 & blocks .~ [plainStr "def"],cellXY 1 1 & blocks .~ [plainStr "ghi"]]] & tableBodies .~ [mempty])])
-- Right "|abc|def|ghi|\n|---|---|---|\n"
--
-- >>> writePandocExtensions writeZimWiki (blocks .~~ [TableBlock (tableColSpecs .~~ [mempty, mempty, mempty] & tableHead .~ (tableHeadRows .~~ [Row mempty [cellXY 1 1 & blocks .~ [plainStr "abc"], cellXY 1 1 & blocks .~ [plainStr "def"], cellXY 1 1 & blocks .~ [plainStr "ghi"]]]) & tableBodies .~ [tableBodyRows2 .~~ [rowCells .~~ [cellXY 1 1 & blocks .~ [plainStr "jkl"], cellXY 1 1 & blocks .~ [plainStr "mno"], cellXY 1 1 & blocks .~ [plainStr "pqr"]]]])])
-- Right "|abc|def|ghi|\n|---|---|---|\n|jkl|mno|pqr|\n"
writeZimWiki ::
  PandocMonad m =>
  WriterOptions
  -> Pandoc
  -> m Text
writeZimWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeZimWiki WriterOptions
o =
  WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
W.writeZimWiki WriterOptions
o (Pandoc -> m Text) -> (Pandoc -> Pandoc) -> Pandoc -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Pandoc Pandoc Pandoc -> Pandoc -> Pandoc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Pandoc Pandoc Pandoc
Iso' Pandoc Pandoc
isPandoc