Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Switched Writer types to use Text.

Browse source 
* XML.toEntities: changed type to Text -> Text.
* Shared.tabFilter -- fixed so it strips out CRs as before.
* Modified writers to take Text.
* Updated tests, benchmarks, trypandoc.

[API change]

Closes #3731.
This commit is contained in:
John MacFarlane 2017-06-10 23:39:49 +02:00
parent 0c2a509dfb
commit fa719d0264
48 changed files with 292 additions and 210 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
benchmark/benchmark-pandoc.hs
View file

@ -33,15 +33,15 @@ readerBench :: Pandoc
-> Maybe Benchmark
readerBench doc (name, reader) =
case lookup name writers of
Just (StringWriter writer) ->
let inp = either (error . show) pack $ runPure
Just (TextWriter writer) ->
let inp = either (error . show) id $ runPure
$ writer def{ writerWrapText = WrapAuto} doc
in return $ bench (name ++ " reader") $ nf
(reader def) inp
_ -> trace ("\nCould not find writer for " ++ name ++ "\n") Nothing
writerBench :: Pandoc
-> (String, WriterOptions -> Pandoc -> String)
-> (String, WriterOptions -> Pandoc -> Text)
-> Benchmark
writerBench doc (name, writer) = bench (name ++ " writer") $ nf
(writer def{ writerWrapText = WrapAuto }) doc
@ -55,7 +55,7 @@ main = do
[x] -> x == n
(x:y:_) -> x == n && y == "reader"
matchReader (_, _) = False
let matchWriter (n, StringWriter _) =
let matchWriter (n, TextWriter _) =
case args of
[] -> True
[x] -> x == n
@ -81,7 +81,7 @@ main = do
$ filter (\(n,_) -> n /="haddock") readers'
let writers' = [(n, \o d ->
either (error . show) id $ runPure $ setupFakeFiles >> w o d)
| (n, StringWriter w) <- matchedWriters]
| (n, TextWriter w) <- matchedWriters]
let writerBs = map (writerBench doc)
$ writers'
defaultMainWith defaultConfig{ timeLimit = 6.0 }

8
benchmark/weigh-pandoc.hs
View file

@ -1,6 +1,6 @@
import Weigh
import Text.Pandoc
import Data.Text (Text, pack)
import Data.Text (Text)
main :: IO ()
main = do
@ -24,14 +24,14 @@ main = do
,("commonmark", writeCommonMark)
]
weighWriter :: Pandoc -> String -> (Pandoc -> String) -> Weigh ()
weighWriter :: Pandoc -> String -> (Pandoc -> Text) -> Weigh ()
weighWriter doc name writer = func (name ++ " writer") writer doc
weighReader :: Pandoc -> String -> (Text -> Pandoc) -> Weigh ()
weighReader doc name reader = do
case lookup name writers of
Just (StringWriter writer) ->
let inp = either (error . show) pack $ runPure $ writer def{ writerWrapText = WrapAuto} doc
Just (TextWriter writer) ->
let inp = either (error . show) id $ runPure $ writer def{ writerWrapText = WrapAuto} doc
in func (name ++ " reader") reader inp
_ -> return () -- no writer for reader

29
src/Text/Pandoc/App.hs
View file

@ -43,6 +43,7 @@ import qualified Control.Exception as E
import Control.Monad
import Control.Monad.Except (throwError)
import Control.Monad.Trans
import Data.Monoid
import Data.Aeson (FromJSON (..), ToJSON (..), defaultOptions, eitherDecode',
encode, genericToEncoding)
import qualified Data.ByteString as BS
@ -183,7 +184,7 @@ convertWithOpts opts = do
-- disabling the custom writer for now
writer <- if ".lua" `isSuffixOf` format
-- note: use non-lowercased version writerName
then return (StringWriter
then return (TextWriter
(\o d -> liftIO $ writeCustom writerName o d)
:: Writer PandocIO)
else case getWriter writerName of
@ -442,7 +443,7 @@ convertWithOpts opts = do
case writer of
ByteStringWriter f -> f writerOptions doc >>= writeFnBinary outputFile
StringWriter f
TextWriter f
| pdfOutput -> do
-- make sure writer is latex, beamer, context, html5 or ms
unless (laTeXOutput || conTeXtOutput || html5Output ||
@ -469,18 +470,23 @@ convertWithOpts opts = do
| otherwise -> do
let htmlFormat = format `elem`
["html","html4","html5","s5","slidy","slideous","dzslides","revealjs"]
selfcontain = if optSelfContained opts && htmlFormat
then makeSelfContained writerOptions
else return
handleEntities = if (htmlFormat ||
format == "docbook4" ||
format == "docbook5" ||
format == "docbook") && optAscii opts
then toEntities
else id
output <- f writerOptions doc
selfcontain (output ++ ['\n' | not standalone]) >>=
writerFn eol outputFile . handleEntities
addNl = if standalone
then id
else (<> T.singleton '\n')
output <- (addNl . handleEntities) <$> f writerOptions doc
writerFn eol outputFile =<<
if optSelfContained opts && htmlFormat
-- TODO not maximally efficient; change type
-- of makeSelfContained so it works w/ Text
then T.pack <$> makeSelfContained writerOptions
(T.unpack output)
else return output
type Transform = Pandoc -> Pandoc
@ -810,9 +816,10 @@ writeFnBinary :: MonadIO m => FilePath -> B.ByteString -> m ()
writeFnBinary "-" = liftIO . B.putStr
writeFnBinary f = liftIO . B.writeFile (UTF8.encodePath f)
writerFn :: MonadIO m => IO.Newline -> FilePath -> String -> m ()
writerFn eol "-" = liftIO . UTF8.putStrWith eol
writerFn eol f = liftIO . UTF8.writeFileWith eol f
writerFn :: MonadIO m => IO.Newline -> FilePath -> Text -> m ()
-- TODO this implementation isn't maximally efficient:
writerFn eol "-" = liftIO . UTF8.putStrWith eol . T.unpack
writerFn eol f = liftIO . UTF8.writeFileWith eol f . T.unpack
lookupHighlightStyle :: Maybe String -> IO (Maybe Style)
lookupHighlightStyle Nothing = return Nothing

27
src/Text/Pandoc/PDF.hs
View file

@ -36,12 +36,13 @@ import qualified Codec.Picture as JP
import qualified Control.Exception as E
import Control.Monad (unless, when)
import Control.Monad.Trans (MonadIO (..))
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BC
import Data.List (isInfixOf)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import System.Directory
@ -74,7 +75,7 @@ changePathSeparators = intercalate "/" . splitDirectories
makePDF :: String -- ^ pdf creator (pdflatex, lualatex,
-- xelatex, context, wkhtmltopdf, pdfroff)
-> (WriterOptions -> Pandoc -> PandocIO String) -- ^ writer
-> (WriterOptions -> Pandoc -> PandocIO Text) -- ^ writer
-> WriterOptions -- ^ options
-> Verbosity -- ^ verbosity level
-> MediaBag -- ^ media
@ -178,10 +179,10 @@ tex2pdf' :: Verbosity -- ^ Verbosity level
-> [String] -- ^ Arguments to the latex-engine
-> FilePath -- ^ temp directory for output
-> String -- ^ tex program
-> String -- ^ tex source
-> Text -- ^ tex source
-> IO (Either ByteString ByteString)
tex2pdf' verbosity args tmpDir program source = do
let numruns = if "\\tableofcontents" `isInfixOf` source
let numruns = if "\\tableofcontents" `T.isInfixOf` source
then 3 -- to get page numbers
else 2 -- 1 run won't give you PDF bookmarks
(exit, log', mbPdf) <- runTeXProgram verbosity program args 1 numruns tmpDir source
@ -223,11 +224,11 @@ extractConTeXtMsg log' = do
-- contents of stdout, contents of produced PDF if any). Rerun
-- a fixed number of times to resolve references.
runTeXProgram :: Verbosity -> String -> [String] -> Int -> Int -> FilePath
-> String -> IO (ExitCode, ByteString, Maybe ByteString)
-> Text -> IO (ExitCode, ByteString, Maybe ByteString)
runTeXProgram verbosity program args runNumber numRuns tmpDir source = do
let file = tmpDir </> "input.tex"
exists <- doesFileExist file
unless exists $ UTF8.writeFile file source
unless exists $ BS.writeFile file $ UTF8.fromText source
#ifdef _WINDOWS
-- note: we want / even on Windows, for TexLive
let tmpDir' = changePathSeparators tmpDir
@ -276,7 +277,7 @@ runTeXProgram verbosity program args runNumber numRuns tmpDir source = do
ms2pdf :: Verbosity
-> [String]
-> String
-> Text
-> IO (Either ByteString ByteString)
ms2pdf verbosity args source = do
env' <- getEnvironment
@ -288,10 +289,10 @@ ms2pdf verbosity args source = do
mapM_ print env'
putStr "\n"
putStrLn $ "[makePDF] Contents:\n"
putStr source
putStr $ T.unpack source
putStr "\n"
(exit, out) <- pipeProcess (Just env') "pdfroff" args
(UTF8.fromStringLazy source)
(BL.fromStrict $ UTF8.fromText source)
when (verbosity >= INFO) $ do
B.hPutStr stdout out
putStr "\n"
@ -301,12 +302,12 @@ ms2pdf verbosity args source = do
html2pdf :: Verbosity -- ^ Verbosity level
-> [String] -- ^ Args to wkhtmltopdf
-> String -- ^ HTML5 source
-> Text -- ^ HTML5 source
-> IO (Either ByteString ByteString)
html2pdf verbosity args source = do
file <- withTempFile "." "html2pdf.html" $ \fp _ -> return fp
pdfFile <- withTempFile "." "html2pdf.pdf" $ \fp _ -> return fp
UTF8.writeFile file source
BS.writeFile file $ UTF8.fromText source
let programArgs = args ++ [file, pdfFile]
env' <- getEnvironment
when (verbosity >= INFO) $ do
@ -341,11 +342,11 @@ html2pdf verbosity args source = do
context2pdf :: Verbosity -- ^ Verbosity level
-> FilePath -- ^ temp directory for output
-> String -- ^ ConTeXt source
-> Text -- ^ ConTeXt source
-> IO (Either ByteString ByteString)
context2pdf verbosity tmpDir source = inDirectory tmpDir $ do
let file = "input.tex"
UTF8.writeFile file source
BS.writeFile file $ UTF8.fromText source
#ifdef _WINDOWS
-- note: we want / even on Windows, for TexLive
let tmpDir' = changePathSeparators tmpDir

4
src/Text/Pandoc/Shared.hs
View file

@ -284,8 +284,8 @@ escapeURI = escapeURIString (not . needsEscaping)
tabFilter :: Int -- ^ Tab stop
-> T.Text -- ^ Input
-> T.Text
tabFilter tabStop =
T.unlines . (if tabStop == 0 then id else map go) . T.lines
tabFilter tabStop = T.filter (/= '\r') . T.unlines .
(if tabStop == 0 then id else map go) . T.lines
where go s =
let (s1, s2) = T.break (== '\t') s
in if T.null s2

11
src/Text/Pandoc/Writers/AsciiDoc.hs
View file

@ -43,6 +43,7 @@ import Data.Char (isPunctuation, isSpace)
import Data.List (intercalate, intersperse, stripPrefix)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@ -62,7 +63,7 @@ data WriterState = WriterState { defListMarker :: String
}
-- | Convert Pandoc to AsciiDoc.
writeAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeAsciiDoc opts document =
evalStateT (pandocToAsciiDoc opts document) WriterState{
defListMarker = "::"
@ -74,16 +75,18 @@ writeAsciiDoc opts document =
type ADW = StateT WriterState
-- | Return asciidoc representation of document.
pandocToAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> ADW m String
pandocToAsciiDoc :: PandocMonad m => WriterOptions -> Pandoc -> ADW m Text
pandocToAsciiDoc opts (Pandoc meta blocks) = do
let titleblock = not $ null (docTitle meta) && null (docAuthors meta) &&
null (docDate meta)
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON opts
(fmap (render colwidth) . blockListToAsciiDoc opts)
(fmap (render colwidth) . inlineListToAsciiDoc opts)
(fmap render' . blockListToAsciiDoc opts)
(fmap render' . inlineListToAsciiDoc opts)
meta
let addTitleLine (String t) = String $
t <> "\n" <> T.replicate (T.length t) "="

13
src/Text/Pandoc/Writers/CommonMark.hs
View file

@ -34,6 +34,7 @@ module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
import CMark
import Control.Monad.State (State, get, modify, runState)
import Data.Foldable (foldrM)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
@ -45,7 +46,7 @@ import Text.Pandoc.Writers.HTML (writeHtml5String)
import Text.Pandoc.Writers.Shared
-- | Convert Pandoc to CommonMark.
writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeCommonMark opts (Pandoc meta blocks) = do
let (blocks', notes) = runState (walkM processNotes blocks) []
notes' = if null notes
@ -71,7 +72,7 @@ processNotes x = return x
node :: NodeType -> [Node] -> Node
node = Node Nothing
blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m String
blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m Text
blocksToCommonMark opts bs = do
let cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
colwidth = if writerWrapText opts == WrapAuto
@ -79,14 +80,12 @@ blocksToCommonMark opts bs = do
else Nothing
nodes <- blocksToNodes bs
return $
T.unpack $
nodeToCommonmark cmarkOpts colwidth $
node DOCUMENT nodes
inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m String
inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m Text
inlinesToCommonMark opts ils = return $
T.unpack $ nodeToCommonmark cmarkOpts colwidth
$ node PARAGRAPH (inlinesToNodes ils)
nodeToCommonmark cmarkOpts colwidth $ node PARAGRAPH (inlinesToNodes ils)
where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
@ -139,7 +138,7 @@ blockToNodes (DefinitionList items) ns = blockToNodes (BulletList items') ns
Para term : concat xs
blockToNodes t@(Table _ _ _ _ _) ns = do
s <- writeHtml5String def $! Pandoc nullMeta [t]
return (node (HTML_BLOCK (T.pack $! s)) [] : ns)
return (node (HTML_BLOCK s) [] : ns)
blockToNodes Null ns = return ns
inlinesToNodes :: [Inline] -> [Node]

13
src/Text/Pandoc/Writers/ConTeXt.hs
View file

@ -33,6 +33,7 @@ import Control.Monad.State
import Data.Char (ord)
import Data.List (intercalate, intersperse)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Network.URI (unEscapeString)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Logging
@ -56,7 +57,7 @@ orderedListStyles :: [Char]
orderedListStyles = cycle "narg"
-- | Convert Pandoc to ConTeXt.
writeConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeConTeXt options document =
let defaultWriterState = WriterState { stNextRef = 1
, stOrderedListLevel = 0
@ -66,17 +67,19 @@ writeConTeXt options document =
type WM = StateT WriterState
pandocToConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> WM m String
pandocToConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> WM m Text
pandocToConTeXt options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON options
(fmap (render colwidth) . blockListToConTeXt)
(fmap (render colwidth) . inlineListToConTeXt)
(fmap render' . blockListToConTeXt)
(fmap render' . inlineListToConTeXt)
meta
body <- mapM (elementToConTeXt options) $ hierarchicalize blocks
let main = (render colwidth . vcat) body
let main = (render' . vcat) body
let layoutFromMargins = intercalate [','] $ catMaybes $
map (\(x,y) ->
((x ++ "=") ++) <$> getField y metadata)

8
src/Text/Pandoc/Writers/Custom.hs
View file

@ -41,6 +41,7 @@ import Control.Monad (when)
import Data.Char (toLower)
import Data.List (intersperse)
import qualified Data.Map as M
import Data.Text (Text, pack)
import Data.Typeable
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Scripting.Lua (LuaState, StackValue, callfunc)
@ -116,7 +117,7 @@ data PandocLuaException = PandocLuaException String
instance Exception PandocLuaException
-- | Convert Pandoc to custom markup.
writeCustom :: FilePath -> WriterOptions -> Pandoc -> IO String
writeCustom :: FilePath -> WriterOptions -> Pandoc -> IO Text
writeCustom luaFile opts doc@(Pandoc meta _) = do
luaScript <- UTF8.readFile luaFile
enc <- getForeignEncoding
@ -139,8 +140,9 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
setForeignEncoding enc
let body = rendered
case writerTemplate opts of
Nothing -> return body
Just tpl -> return $ renderTemplate' tpl $ setField "body" body context
Nothing -> return $ pack body
Just tpl -> return $ pack $
renderTemplate' tpl $ setField "body" body context
docToCustom :: LuaState -> WriterOptions -> Pandoc -> IO String
docToCustom lua opts (Pandoc (Meta metamap) blocks) = do

14
src/Text/Pandoc/Writers/Docbook.hs
View file

@ -32,6 +32,7 @@ Conversion of 'Pandoc' documents to Docbook XML.
module Text.Pandoc.Writers.Docbook ( writeDocbook4, writeDocbook5 ) where
import Control.Monad.Reader
import Data.Char (toLower)
import Data.Text (Text)
import Data.Generics (everywhere, mkT)
import Data.List (intercalate, isPrefixOf, isSuffixOf, stripPrefix)
import Data.Monoid (Any (..))
@ -81,22 +82,23 @@ authorToDocbook opts name' = do
in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$
inTagsSimple "surname" (text $ escapeStringForXML lastname)
writeDocbook4 :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeDocbook4 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocbook4 opts d =
runReaderT (writeDocbook opts d) DocBook4
writeDocbook5 :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeDocbook5 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocbook5 opts d =
runReaderT (writeDocbook opts d) DocBook5
-- | Convert Pandoc document to string in Docbook format.
writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> DB m String
writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text
writeDocbook opts (Pandoc meta blocks) = do
let elements = hierarchicalize blocks
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' = render colwidth
let render' :: Doc -> Text
render' = render colwidth
let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr)
(writerTemplate opts) &&
TopLevelDefault == writerTopLevelDivision opts)
@ -111,10 +113,10 @@ writeDocbook opts (Pandoc meta blocks) = do
auths' <- mapM (authorToDocbook opts) $ docAuthors meta
let meta' = B.setMeta "author" auths' meta
metadata <- metaToJSON opts
(fmap (render colwidth . vcat) .
(fmap (render' . vcat) .
(mapM (elementToDocbook opts' startLvl) .
hierarchicalize))
(fmap (render colwidth) . inlinesToDocbook opts')
(fmap render' . inlinesToDocbook opts')
meta'
main <- (render' . vcat) <$> (mapM (elementToDocbook opts' startLvl) elements)
let context = defField "body" main

7
src/Text/Pandoc/Writers/DokuWiki.hs
View file

@ -44,6 +44,7 @@ import Control.Monad.Reader (ReaderT, ask, local, runReaderT)
import Control.Monad.State (StateT, evalStateT, gets, modify)
import Data.Default (Default (..))
import Data.List (intercalate, intersect, isPrefixOf, transpose)
import Data.Text (Text, pack)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Logging
import Text.Pandoc.Definition
@ -75,7 +76,7 @@ instance Default WriterEnvironment where
type DokuWiki m = ReaderT WriterEnvironment (StateT WriterState m)
-- | Convert Pandoc to DokuWiki.
writeDokuWiki :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeDokuWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDokuWiki opts document =
runDokuWiki (pandocToDokuWiki opts document)
@ -84,7 +85,7 @@ runDokuWiki = flip evalStateT def . flip runReaderT def
-- | Return DokuWiki representation of document.
pandocToDokuWiki :: PandocMonad m
=> WriterOptions -> Pandoc -> DokuWiki m String
=> WriterOptions -> Pandoc -> DokuWiki m Text
pandocToDokuWiki opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts
(fmap trimr . blockListToDokuWiki opts)
@ -96,7 +97,7 @@ pandocToDokuWiki opts (Pandoc meta blocks) = do
then "" -- TODO Was "\n<references />" Check whether I can really remove this:
-- if it is definitely to do with footnotes, can remove this whole bit
else ""
let main = body ++ notes
let main = pack $ body ++ notes
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts)
$ metadata

5
src/Text/Pandoc/Writers/EPUB.hs
View file

@ -40,6 +40,7 @@ import Control.Monad.State (State, StateT, evalState, evalStateT, get, gets,
lift, modify, put)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.Text.Lazy as TL
import Data.Char (isAlphaNum, isDigit, toLower)
import Data.List (intercalate, isInfixOf, isPrefixOf)
import qualified Data.Map as M
@ -373,8 +374,8 @@ pandocToEPUB :: PandocMonad m
-> E m B.ByteString
pandocToEPUB version opts doc@(Pandoc meta _) = do
let epub3 = version == EPUB3
let writeHtml o = fmap UTF8.fromStringLazy .
writeHtmlStringForEPUB version o
let writeHtml o = fmap (UTF8.fromTextLazy . TL.fromStrict) .
writeHtmlStringForEPUB version o
epochtime <- floor <$> lift P.getPOSIXTime
metadata <- getEPUBMetadata opts meta
let mkEntry path content = toEntry path epochtime content

7
src/Text/Pandoc/Writers/FB2.hs
View file

@ -44,6 +44,7 @@ import Data.ByteString.Base64 (encode)
import qualified Data.ByteString.Char8 as B8
import Data.Char (isAscii, isControl, isSpace, toLower)
import Data.Either (lefts, rights)
import Data.Text (Text, pack)
import Data.List (intercalate, intersperse, isPrefixOf, stripPrefix)
import Network.HTTP (urlEncode)
import Text.XML.Light
@ -86,13 +87,13 @@ instance Show ImageMode where
writeFB2 :: PandocMonad m
=> WriterOptions -- ^ conversion options
-> Pandoc -- ^ document to convert
-> m String -- ^ FictionBook2 document (not encoded yet)
-> m Text -- ^ FictionBook2 document (not encoded yet)
writeFB2 opts doc = flip evalStateT newFB $ pandocToFB2 opts doc
pandocToFB2 :: PandocMonad m
=> WriterOptions
-> Pandoc
-> FBM m String
-> FBM m Text
pandocToFB2 opts (Pandoc meta blocks) = do
modify (\s -> s { writerOptions = opts })
desc <- description meta
@ -103,7 +104,7 @@ pandocToFB2 opts (Pandoc meta blocks) = do
(imgs,missing) <- liftM imagesToFetch get >>= \s -> lift (fetchImages s)
let body' = replaceImagesWithAlt missing body
let fb2_xml = el "FictionBook" (fb2_attrs, [desc, body'] ++ notes ++ imgs)
return $ xml_head ++ (showContent fb2_xml) ++ "\n"
return $ pack $ xml_head ++ (showContent fb2_xml) ++ "\n"
where
xml_head = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
fb2_attrs =

50
src/Text/Pandoc/Writers/HTML.hs
View file

@ -45,6 +45,8 @@ module Text.Pandoc.Writers.HTML (
) where
import Control.Monad.State
import Data.Char (ord, toLower)
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Data.List (intersperse, isPrefixOf)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Monoid ((<>))
@ -67,7 +69,7 @@ import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML (escapeStringForXML, fromEntities)
#if MIN_VERSION_blaze_markup(0,6,3)
#else
import Text.Blaze.Internal (preEscapedString)
import Text.Blaze.Internal (preEscapedString, preEscapedText)
#endif
#if MIN_VERSION_blaze_html(0,5,1)
import qualified Text.Blaze.XHtml5 as H5
@ -77,7 +79,7 @@ import qualified Text.Blaze.Html5 as H5
import Control.Monad.Except (throwError)
import Data.Aeson (Value)
import System.FilePath (takeExtension, takeBaseName)
import Text.Blaze.Html.Renderer.String (renderHtml)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Text.Blaze.XHtml1.Transitional as H
import qualified Text.Blaze.XHtml1.Transitional.Attributes as A
import Text.Pandoc.Class (PandocMonad, report)
@ -123,7 +125,7 @@ nl opts = if writerWrapText opts == WrapNone
else preEscapedString "\n"
-- | Convert Pandoc document to Html 5 string.
writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeHtml5String :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHtml5String = writeHtmlString'
defaultWriterState{ stHtml5 = True }
@ -132,7 +134,7 @@ writeHtml5 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
writeHtml5 = writeHtml' defaultWriterState{ stHtml5 = True }
-- | Convert Pandoc document to Html 4 string.
writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeHtml4String :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHtml4String = writeHtmlString'
defaultWriterState{ stHtml5 = False }
@ -142,38 +144,39 @@ writeHtml4 = writeHtml' defaultWriterState{ stHtml5 = False }
-- | Convert Pandoc document to Html appropriate for an epub version.
writeHtmlStringForEPUB :: PandocMonad m
=> EPUBVersion -> WriterOptions -> Pandoc -> m String
writeHtmlStringForEPUB version = writeHtmlString'
=> EPUBVersion -> WriterOptions -> Pandoc
-> m Text
writeHtmlStringForEPUB version o = writeHtmlString'
defaultWriterState{ stHtml5 = version == EPUB3,
stEPUBVersion = Just version }
stEPUBVersion = Just version } o
-- | Convert Pandoc document to Reveal JS HTML slide show.
writeRevealJs :: PandocMonad m
=> WriterOptions -> Pandoc -> m String
=> WriterOptions -> Pandoc -> m Text
writeRevealJs = writeHtmlSlideShow' RevealJsSlides
-- | Convert Pandoc document to S5 HTML slide show.
writeS5 :: PandocMonad m
=> WriterOptions -> Pandoc -> m String
=> WriterOptions -> Pandoc -> m Text
writeS5 = writeHtmlSlideShow' S5Slides
-- | Convert Pandoc document to Slidy HTML slide show.
writeSlidy :: PandocMonad m
=> WriterOptions -> Pandoc -> m String
=> WriterOptions -> Pandoc -> m Text
writeSlidy = writeHtmlSlideShow' SlidySlides
-- | Convert Pandoc document to Slideous HTML slide show.
writeSlideous :: PandocMonad m
=> WriterOptions -> Pandoc -> m String
=> WriterOptions -> Pandoc -> m Text
writeSlideous = writeHtmlSlideShow' SlideousSlides
-- | Convert Pandoc document to DZSlides HTML slide show.
writeDZSlides :: PandocMonad m
=> WriterOptions -> Pandoc -> m String
=> WriterOptions -> Pandoc -> m Text
writeDZSlides = writeHtmlSlideShow' DZSlides
writeHtmlSlideShow' :: PandocMonad m
=> HTMLSlideVariant -> WriterOptions -> Pandoc -> m String
=> HTMLSlideVariant -> WriterOptions -> Pandoc -> m Text
writeHtmlSlideShow' variant = writeHtmlString'
defaultWriterState{ stSlideVariant = variant
, stHtml5 = case variant of
@ -185,12 +188,15 @@ writeHtmlSlideShow' variant = writeHtmlString'
NoSlides -> False
}
renderHtml' :: Html -> Text
renderHtml' = TL.toStrict . renderHtml
writeHtmlString' :: PandocMonad m
=> WriterState -> WriterOptions -> Pandoc -> m String
=> WriterState -> WriterOptions -> Pandoc -> m Text
writeHtmlString' st opts d = do
(body, context) <- evalStateT (pandocToHtml opts d) st
case writerTemplate opts of
Nothing -> return $ renderHtml body
Nothing -> return $ renderHtml' body
Just tpl -> do
-- warn if empty lang
when (isNothing (getField "lang" context :: Maybe String)) $
@ -205,12 +211,12 @@ writeHtmlString' st opts d = do
report $ NoTitleElement fallback
return $ resetField "pagetitle" fallback context
return $ renderTemplate' tpl $
defField "body" (renderHtml body) context'
defField "body" (renderHtml' body) context'
writeHtml' :: PandocMonad m => WriterState -> WriterOptions -> Pandoc -> m Html
writeHtml' st opts d = do
case writerTemplate opts of
Just _ -> preEscapedString <$> writeHtmlString' st opts d
Just _ -> preEscapedText <$> writeHtmlString' st opts d
Nothing -> do
(body, _) <- evalStateT (pandocToHtml opts d) st
return body
@ -222,8 +228,8 @@ pandocToHtml :: PandocMonad m
-> StateT WriterState m (Html, Value)
pandocToHtml opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts
(fmap renderHtml . blockListToHtml opts)
(fmap renderHtml . inlineListToHtml opts)
(fmap renderHtml' . blockListToHtml opts)
(fmap renderHtml' . inlineListToHtml opts)
meta
let stringifyHTML = escapeStringForXML . stringify
let authsMeta = map stringifyHTML $ docAuthors meta
@ -277,10 +283,10 @@ pandocToHtml opts (Pandoc meta blocks) = do
Nothing -> id
else id) $
(if stMath st
then defField "math" (renderHtml math)
then defField "math" (renderHtml' math)
else id) $
defField "quotes" (stQuotes st) $
maybe id (defField "toc" . renderHtml) toc $
maybe id (defField "toc" . renderHtml') toc $
defField "author-meta" authsMeta $
maybe id (defField "date-meta") (normalizeDate dateMeta) $
defField "pagetitle" (stringifyHTML (docTitle meta)) $
@ -463,7 +469,7 @@ parseMailto s = do
obfuscateLink :: PandocMonad m => WriterOptions -> Attr -> Html -> String -> m Html
obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation =
return $ addAttrs opts attr $ H.a ! A.href (toValue s) $ txt
obfuscateLink opts attr (renderHtml -> txt) s =
obfuscateLink opts attr (TL.unpack . renderHtml -> txt) s =
let meth = writerEmailObfuscation opts
s' = map toLower (take 7 s) ++ drop 7 s
in case parseMailto s' of

11
src/Text/Pandoc/Writers/Haddock.hs
View file

@ -35,6 +35,7 @@ Haddock: <http://www.haskell.org/haddock/doc/html/>
module Text.Pandoc.Writers.Haddock (writeHaddock) where
import Control.Monad.State
import Data.Default
import Data.Text (Text)
import Data.List (intersperse, transpose)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@ -52,14 +53,14 @@ instance Default WriterState
where def = WriterState{ stNotes = [] }
-- | Convert Pandoc to Haddock.
writeHaddock :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeHaddock :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeHaddock opts document =
evalStateT (pandocToHaddock opts{
writerWrapText = writerWrapText opts } document) def
-- | Return haddock representation of document.
pandocToHaddock :: PandocMonad m
=> WriterOptions -> Pandoc -> StateT WriterState m String
=> WriterOptions -> Pandoc -> StateT WriterState m Text
pandocToHaddock opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
@ -67,13 +68,13 @@ pandocToHaddock opts (Pandoc meta blocks) = do
body <- blockListToHaddock opts blocks
st <- get
notes' <- notesToHaddock opts (reverse $ stNotes st)
let render' :: Doc -> String
let render' :: Doc -> Text
render' = render colwidth
let main = render' $ body <>
(if isEmpty notes' then empty else blankline <> notes')
metadata <- metaToJSON opts
(fmap (render colwidth) . blockListToHaddock opts)
(fmap (render colwidth) . inlineListToHaddock opts)
(fmap render' . blockListToHaddock opts)
(fmap render' . inlineListToHaddock opts)
meta
let context = defField "body" main
$ metadata

4
src/Text/Pandoc/Writers/ICML.hs
View file

@ -21,6 +21,7 @@ import Control.Monad.State
import Data.List (intersperse, isInfixOf, isPrefixOf, stripPrefix)
import qualified Data.Set as Set
import Data.Text as Text (breakOnAll, pack)
import Data.Text (Text)
import Text.Pandoc.Class (PandocMonad, report)
import qualified Text.Pandoc.Class as P
import Text.Pandoc.Definition
@ -127,11 +128,12 @@ footnoteName = "Footnote"
citeName = "Cite"
-- | Convert Pandoc document to string in ICML format.
writeICML :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeICML :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeICML opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
render' :: Doc -> Text
render' = render colwidth
renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState
metadata <- metaToJSON opts

12
src/Text/Pandoc/Writers/JATS.hs
View file

@ -33,6 +33,7 @@ https://jats.nlm.nih.gov/publishing/tag-library/1.1d3/element/mml-math.html
module Text.Pandoc.Writers.JATS ( writeJATS ) where
import Control.Monad.Reader
import Data.Char (toLower)
import Data.Text (Text)
import Data.Generics (everywhere, mkT)
import Data.List (intercalate, isSuffixOf, partition)
import Data.Maybe (fromMaybe)
@ -81,12 +82,12 @@ authorToJATS opts name' = do
in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$
inTagsSimple "surname" (text $ escapeStringForXML lastname)
writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJATS opts d =
runReaderT (docToJATS opts d) JATS1_1
-- | Convert Pandoc document to string in JATS format.
docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> DB m String
docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text
docToJATS opts (Pandoc meta blocks) = do
let isBackBlock (Div ("refs",_,_) _) = True
isBackBlock _ = False
@ -96,7 +97,8 @@ docToJATS opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' = render colwidth
let render' :: Doc -> Text
render' = render colwidth
let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr)
(writerTemplate opts) &&
TopLevelDefault == writerTopLevelDivision opts)
@ -111,10 +113,10 @@ docToJATS opts (Pandoc meta blocks) = do
auths' <- mapM (authorToJATS opts) $ docAuthors meta
let meta' = B.setMeta "author" auths' meta
metadata <- metaToJSON opts
(fmap (render colwidth . vcat) .
(fmap (render' . vcat) .
(mapM (elementToJATS opts' startLvl) .
hierarchicalize))
(fmap (render colwidth) . inlinesToJATS opts')
(fmap render' . inlinesToJATS opts')
meta'
main <- (render' . vcat) <$>
(mapM (elementToJATS opts' startLvl) elements)

17
src/Text/Pandoc/Writers/LaTeX.hs
View file

@ -42,6 +42,7 @@ import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, ord,
import Data.List (foldl', intercalate, intersperse, isInfixOf, nub, nubBy,
stripPrefix, (\\))
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (unEscapeString)
import Text.Pandoc.Class (PandocMonad, report)
@ -114,13 +115,13 @@ startingState options = WriterState {
, stEmptyLine = True }
-- | Convert Pandoc to LaTeX.
writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeLaTeX options document =
evalStateT (pandocToLaTeX options document) $
startingState options
-- | Convert Pandoc to LaTeX Beamer.
writeBeamer :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeBeamer :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeBeamer options document =
evalStateT (pandocToLaTeX options document) $
(startingState options){ stBeamer = True }
@ -128,7 +129,7 @@ writeBeamer options document =
type LW m = StateT WriterState m
pandocToLaTeX :: PandocMonad m
=> WriterOptions -> Pandoc -> LW m String
=> WriterOptions -> Pandoc -> LW m Text
pandocToLaTeX options (Pandoc meta blocks) = do
-- Strip off final 'references' header if --natbib or --biblatex
let method = writerCiteMethod options
@ -146,9 +147,11 @@ pandocToLaTeX options (Pandoc meta blocks) = do
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON options
(fmap (render colwidth) . blockListToLaTeX)
(fmap (render colwidth) . inlineListToLaTeX)
(fmap render' . blockListToLaTeX)
(fmap render' . inlineListToLaTeX)
meta
let bookClasses = ["memoir","book","report","scrreprt","scrbook"]
let documentClass = case P.parse pDocumentClass "template" template of
@ -180,8 +183,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do
then toSlides blocks''
else return blocks''
body <- mapM (elementToLaTeX options) $ hierarchicalize blocks'''
(biblioTitle :: String) <- liftM (render colwidth) $ inlineListToLaTeX lastHeader
let main = render colwidth $ vsep body
(biblioTitle :: Text) <- render' <$> inlineListToLaTeX lastHeader
let main = render' $ vsep body
st <- get
titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta
authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta

30
src/Text/Pandoc/Writers/Man.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2007-2017 John MacFarlane <jgm@berkeley.edu>
@ -34,6 +35,8 @@ import Control.Monad.State
import Data.List (intercalate, intersperse, stripPrefix, sort)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder (deleteMeta)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@ -62,36 +65,37 @@ defaultWriterState = WriterState { stNotes = []
, stHasTables = False }
-- | Convert Pandoc to Man.
writeMan :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeMan :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMan opts document =
evalStateT (pandocToMan opts document) defaultWriterState
-- | Return groff man representation of document.
pandocToMan :: PandocMonad m => WriterOptions -> Pandoc -> StateT WriterState m String
pandocToMan :: PandocMonad m => WriterOptions -> Pandoc -> StateT WriterState m Text
pandocToMan opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' = render colwidth
let render' :: Doc -> Text
render' = render colwidth
titleText <- inlineListToMan opts $ docTitle meta
let title' = render' titleText
let setFieldsFromTitle =
case break (== ' ') title' of
(cmdName, rest) -> case break (=='(') cmdName of
(xs, '(':ys) | not (null ys) &&
last ys == ')' ->
case T.break (== ' ') title' of
(cmdName, rest) -> case T.break (=='(') cmdName of
(xs, ys) | "(" `T.isPrefixOf` ys
&& ")" `T.isSuffixOf` ys ->
defField "title" xs .
defField "section" (init ys) .
case splitBy (=='|') rest of
defField "section" (T.init $ T.drop 1 ys) .
case T.splitOn "|" rest of
(ft:hds) ->
defField "footer" (trim ft) .
defField "footer" (T.strip ft) .
defField "header"
(trim $ concat hds)
(T.strip $ mconcat hds)
[] -> id
_ -> defField "title" title'
metadata <- metaToJSON opts
(fmap (render colwidth) . blockListToMan opts)
(fmap (render colwidth) . inlineListToMan opts)
(fmap render' . blockListToMan opts)
(fmap render' . inlineListToMan opts)
$ deleteMeta "title" meta
body <- blockListToMan opts blocks
notes <- gets stNotes

23
src/Text/Pandoc/Writers/Markdown.hs
View file

@ -45,6 +45,7 @@ import Data.Maybe (fromMaybe)
import Data.Monoid (Any (..))
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Yaml (Value (Array, Bool, Number, Object, String))
@ -106,7 +107,7 @@ instance Default WriterState
}
-- | Convert Pandoc to Markdown.
writeMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMarkdown opts document =
evalMD (pandocToMarkdown opts{
writerWrapText = if isEnabled Ext_hard_line_breaks opts
@ -116,7 +117,7 @@ writeMarkdown opts document =
-- | Convert Pandoc to plain text (like markdown, but without links,
-- pictures, or inline formatting).
writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m String
writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writePlain opts document =
evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
@ -180,15 +181,17 @@ jsonToYaml (Number n) = text $ show n
jsonToYaml _ = empty
-- | Return markdown representation of document.
pandocToMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> MD m String
pandocToMarkdown :: PandocMonad m => WriterOptions -> Pandoc -> MD m Text
pandocToMarkdown opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
isPlain <- asks envPlain
let render' :: Doc -> Text
render' = render colwidth . chomp
metadata <- metaToJSON'
(fmap (render colwidth) . blockListToMarkdown opts)
(fmap (render colwidth) . blockToMarkdown opts . Plain)
(fmap render' . blockListToMarkdown opts)
(fmap render' . blockToMarkdown opts . Plain)
meta
let title' = maybe empty text $ getField "title" metadata
let authors' = maybe [] (map text) $ getField "author" metadata
@ -216,8 +219,6 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
else blocks
body <- blockListToMarkdown opts blocks'
notesAndRefs' <- notesAndRefs opts
let render' :: Doc -> String
render' = render colwidth . chomp
let main = render' $ body <> notesAndRefs'
let context = defField "toc" (render' toc)
$ defField "body" main
@ -571,7 +572,7 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
gridTable opts blockListToMarkdown
(all null headers) aligns' widths' headers rows
| isEnabled Ext_raw_html opts -> fmap (id,) $
text <$>
(text . T.unpack) <$>
(writeHtml5String def $ Pandoc nullMeta [t])
| otherwise -> return $ (id, text "[TABLE]")
return $ nst $ tbl $$ caption'' $$ blankline
@ -1110,7 +1111,8 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
| isEnabled Ext_raw_html opts &&
not (isEnabled Ext_link_attributes opts) &&
attr /= nullAttr = -- use raw HTML
(text . trim) <$> writeHtml5String def (Pandoc nullMeta [Plain [lnk]])
(text . T.unpack . T.strip) <$>
writeHtml5String def (Pandoc nullMeta [Plain [lnk]])
| otherwise = do
plain <- asks envPlain
linktext <- inlineListToMarkdown opts txt
@ -1149,7 +1151,8 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
| isEnabled Ext_raw_html opts &&
not (isEnabled Ext_link_attributes opts) &&
attr /= nullAttr = -- use raw HTML
(text . trim) <$> writeHtml5String def (Pandoc nullMeta [Plain [img]])
(text . T.unpack . T.strip) <$>
writeHtml5String def (Pandoc nullMeta [Plain [img]])
| otherwise = do
plain <- asks envPlain
let txt = if null alternate || alternate == [Str source]

8
src/Text/Pandoc/Writers/MediaWiki.hs
View file

@ -34,6 +34,7 @@ import Control.Monad.Reader
import Control.Monad.State
import Data.List (intercalate)
import qualified Data.Set as Set
import Data.Text (Text, pack)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Logging
import Text.Pandoc.Definition
@ -59,14 +60,14 @@ data WriterReader = WriterReader {
type MediaWikiWriter m = ReaderT WriterReader (StateT WriterState m)
-- | Convert Pandoc to MediaWiki.
writeMediaWiki :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeMediaWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMediaWiki opts document =
let initialState = WriterState { stNotes = False, stOptions = opts }
env = WriterReader { options = opts, listLevel = [], useTags = False }
in evalStateT (runReaderT (pandocToMediaWiki document) env) initialState
-- | Return MediaWiki representation of document.
pandocToMediaWiki :: PandocMonad m => Pandoc -> MediaWikiWriter m String
pandocToMediaWiki :: PandocMonad m => Pandoc -> MediaWikiWriter m Text
pandocToMediaWiki (Pandoc meta blocks) = do
opts <- asks options
metadata <- metaToJSON opts
@ -81,7 +82,8 @@ pandocToMediaWiki (Pandoc meta blocks) = do
let main = body ++ notes
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts) metadata
return $ case writerTemplate opts of
return $ pack
$ case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate' tpl context

12
src/Text/Pandoc/Writers/Ms.hs
View file

@ -44,6 +44,7 @@ import Text.Pandoc.Options
import Text.Pandoc.Writers.Math
import Text.Printf ( printf )
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Map as Map
import Data.Maybe ( catMaybes, fromMaybe )
import Data.List ( intersperse, intercalate, sort )
@ -85,17 +86,18 @@ type Note = [Block]
type MS = StateT WriterState
-- | Convert Pandoc to Ms.
writeMs :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeMs :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMs opts document =
evalStateT (pandocToMs opts document) defaultWriterState
-- | Return groff ms representation of document.
pandocToMs :: PandocMonad m => WriterOptions -> Pandoc -> MS m String
pandocToMs :: PandocMonad m => WriterOptions -> Pandoc -> MS m Text
pandocToMs opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' = render colwidth
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON opts
(fmap render' . blockListToMs opts)
(fmap render' . inlineListToMs' opts)
@ -108,9 +110,9 @@ pandocToMs opts (Pandoc meta blocks) = do
hasHighlighting <- gets stHighlighting
let highlightingMacros = if hasHighlighting
then case writerHighlightStyle opts of
Nothing -> ""
Nothing -> mempty
Just sty -> render' $ styleToMs sty
else ""
else mempty
let context = defField "body" main
$ defField "has-inline-math" hasInlineMath

11
src/Text/Pandoc/Writers/Muse.hs
View file

@ -43,6 +43,7 @@ even though it is supported only in Emacs Muse.
-}
module Text.Pandoc.Writers.Muse (writeMuse) where
import Control.Monad.State
import Data.Text (Text)
import Data.List (intersperse, transpose, isInfixOf)
import System.FilePath (takeExtension)
import Text.Pandoc.Class (PandocMonad)
@ -68,7 +69,7 @@ data WriterState =
writeMuse :: PandocMonad m
=> WriterOptions
-> Pandoc
-> m String
-> m Text
writeMuse opts document =
let st = WriterState { stNotes = []
, stOptions = opts
@ -81,15 +82,17 @@ writeMuse opts document =
-- | Return Muse representation of document.
pandocToMuse :: PandocMonad m
=> Pandoc
-> StateT WriterState m String
-> StateT WriterState m Text
pandocToMuse (Pandoc meta blocks) = do
opts <- gets stOptions
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render Nothing
metadata <- metaToJSON opts
(fmap (render Nothing) . blockListToMuse)
(fmap (render Nothing) . inlineListToMuse)
(fmap render' . blockListToMuse)
(fmap render' . inlineListToMuse)
meta
body <- blockListToMuse blocks
notes <- liftM (reverse . stNotes) get >>= notesToMuse

3
src/Text/Pandoc/Writers/Native.hs
View file

@ -30,6 +30,7 @@ Conversion of a 'Pandoc' document to a string representation.
-}
module Text.Pandoc.Writers.Native ( writeNative )
where
import Data.Text (Text)
import Data.List (intersperse)
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Definition
@ -67,7 +68,7 @@ prettyBlock (Div attr blocks) =
prettyBlock block = text $ show block
-- | Prettyprint Pandoc document.
writeNative :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeNative :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeNative opts (Pandoc meta blocks) = return $
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts

5
src/Text/Pandoc/Writers/ODT.hs
View file

@ -35,6 +35,7 @@ import Control.Monad.State
import qualified Data.ByteString.Lazy as B
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as TL
import System.FilePath (takeDirectory, takeExtension, (<.>))
import Text.Pandoc.Class (PandocMonad, report)
import qualified Text.Pandoc.Class as P
@ -45,7 +46,7 @@ import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)
import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
import Text.Pandoc.Pretty
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.UTF8 (fromStringLazy)
import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy)
import Text.Pandoc.Walk
import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)
import Text.Pandoc.Writers.Shared (fixDisplayMath)
@ -88,7 +89,7 @@ pandocToODT opts doc@(Pandoc meta _) = do
newContents <- lift $ writeOpenDocument opts{writerWrapText = WrapNone} doc'
epochtime <- floor `fmap` (lift P.getPOSIXTime)
let contentEntry = toEntry "content.xml" epochtime
$ fromStringLazy newContents
$ fromTextLazy $ TL.fromStrict newContents
picEntries <- gets stEntries
let archive = foldr addEntryToArchive refArchive
$ contentEntry : picEntries

15
src/Text/Pandoc/Writers/OPML.hs
View file

@ -30,6 +30,8 @@ Conversion of 'Pandoc' documents to OPML XML.
-}
module Text.Pandoc.Writers.OPML ( writeOPML) where
import Control.Monad.Except (throwError)
import Data.Text (Text, unpack)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Compat.Time
@ -45,7 +47,7 @@ import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
-- | Convert Pandoc document to string in OPML format.
writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeOPML :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOPML opts (Pandoc meta blocks) = do
let elements = hierarchicalize blocks
colwidth = if writerWrapText opts == WrapAuto
@ -54,7 +56,7 @@ writeOPML opts (Pandoc meta blocks) = do
meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta
metadata <- metaToJSON opts
(writeMarkdown def . Pandoc nullMeta)
(\ils -> trimr <$> (writeMarkdown def $ Pandoc nullMeta [Plain ils]))
(\ils -> T.stripEnd <$> (writeMarkdown def $ Pandoc nullMeta [Plain ils]))
meta'
main <- (render colwidth . vcat) <$> (mapM (elementToOPML opts) elements)
let context = defField "body" main metadata
@ -63,9 +65,9 @@ writeOPML opts (Pandoc meta blocks) = do
Just tpl -> renderTemplate' tpl context
writeHtmlInlines :: PandocMonad m => [Inline] -> m String
writeHtmlInlines :: PandocMonad m => [Inline] -> m Text
writeHtmlInlines ils =
trim <$> (writeHtml5String def $ Pandoc nullMeta [Plain ils])
T.strip <$> (writeHtml5String def $ Pandoc nullMeta [Plain ils])
-- date format: RFC 822: Thu, 14 Jul 2005 23:41:05 GMT
showDateTimeRFC822 :: UTCTime -> String
@ -95,9 +97,10 @@ elementToOPML opts (Sec _ _num _ title elements) = do
(blocks, rest) = span isBlk elements
htmlIls <- writeHtmlInlines title
md <- if null blocks
then return []
then return mempty
else do blks <- mapM fromBlk blocks
writeMarkdown def $ Pandoc nullMeta blks
let attrs = [("text", htmlIls)] ++ [("_note", md) | not (null blocks)]
let attrs = [("text", unpack htmlIls)] ++
[("_note", unpack md) | not (null blocks)]
o <- mapM (elementToOPML opts) rest
return $ inTags True "outline" attrs $ vcat o

10
src/Text/Pandoc/Writers/OpenDocument.hs
View file

@ -36,6 +36,7 @@ import Control.Arrow ((***), (>>>))
import Control.Monad.State hiding (when)
import Data.Char (chr)
import Data.List (sortBy)
import Data.Text (Text)
import qualified Data.Map as Map
import Data.Ord (comparing)
import qualified Data.Set as Set
@ -195,17 +196,18 @@ handleSpaces s
rm [] = empty
-- | Convert Pandoc document to string in OpenDocument format.
writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOpenDocument opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' = render colwidth
let render' :: Doc -> Text
render' = render colwidth
((body, metadata),s) <- flip runStateT
defaultWriterState $ do
m <- metaToJSON opts
(fmap (render colwidth) . blocksToOpenDocument opts)
(fmap (render colwidth) . inlinesToOpenDocument opts)
(fmap render' . blocksToOpenDocument opts)
(fmap render' . inlinesToOpenDocument opts)
meta
b <- render' `fmap` blocksToOpenDocument opts blocks
return (b, m)

11
src/Text/Pandoc/Writers/Org.hs
View file

@ -37,6 +37,7 @@ Org-Mode: <http://orgmode.org>
module Text.Pandoc.Writers.Org (writeOrg) where
import Control.Monad.State
import Data.Char (isAlphaNum, toLower)
import Data.Text (Text)
import Data.List (intersect, intersperse, isPrefixOf, partition, transpose)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
@ -56,7 +57,7 @@ data WriterState =
type Org = StateT WriterState
-- | Convert Pandoc to Org.
writeOrg :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeOrg :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeOrg opts document = do
let st = WriterState { stNotes = [],
stHasMath = False,
@ -64,15 +65,17 @@ writeOrg opts document = do
evalStateT (pandocToOrg document) st
-- | Return Org representation of document.
pandocToOrg :: PandocMonad m => Pandoc -> Org m String
pandocToOrg :: PandocMonad m => Pandoc -> Org m Text
pandocToOrg (Pandoc meta blocks) = do
opts <- gets stOptions
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON opts
(fmap (render colwidth) . blockListToOrg)
(fmap (render colwidth) . inlineListToOrg)
(fmap render' . blockListToOrg)
(fmap render' . inlineListToOrg)
meta
body <- blockListToOrg blocks
notes <- gets (reverse . stNotes) >>= notesToOrg

13
src/Text/Pandoc/Writers/RST.hs
View file

@ -35,6 +35,7 @@ import Control.Monad.State
import Data.Char (isSpace, toLower)
import Data.List (isPrefixOf, stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Text (Text, stripEnd)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Logging
@ -62,7 +63,7 @@ data WriterState =
type RST = StateT WriterState
-- | Convert Pandoc to RST.
writeRST :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeRST :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeRST opts document = do
let st = WriterState { stNotes = [], stLinks = [],
stImages = [], stHasMath = False,
@ -71,19 +72,21 @@ writeRST opts document = do
evalStateT (pandocToRST document) st
-- | Return RST representation of document.
pandocToRST :: PandocMonad m => Pandoc -> RST m String
pandocToRST :: PandocMonad m => Pandoc -> RST m Text
pandocToRST (Pandoc meta blocks) = do
opts <- gets stOptions
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
let render' :: Doc -> Text
render' = render colwidth
let subtit = case lookupMeta "subtitle" meta of
Just (MetaBlocks [Plain xs]) -> xs
_ -> []
title <- titleToRST (docTitle meta) subtit
metadata <- metaToJSON opts
(fmap (render colwidth) . blockListToRST)
(fmap (trimr . render colwidth) . inlineListToRST)
(fmap render' . blockListToRST)
(fmap (stripEnd . render') . inlineListToRST)
$ B.deleteMeta "title" $ B.deleteMeta "subtitle" meta
body <- blockListToRST' True $ case writerTemplate opts of
Just _ -> normalizeHeadings 1 blocks
@ -94,7 +97,7 @@ pandocToRST (Pandoc meta blocks) = do
pics <- gets (reverse . stImages) >>= pictRefsToRST
hasMath <- gets stHasMath
rawTeX <- gets stHasRawTeX
let main = render colwidth $ foldl ($+$) empty $ [body, notes, refs, pics]
let main = render' $ foldl ($+$) empty $ [body, notes, refs, pics]
let context = defField "body" main
$ defField "toc" (writerTableOfContents opts)
$ defField "toc-depth" (show $ writerTOCDepth opts)

7
src/Text/Pandoc/Writers/RTF.hs
View file

@ -34,6 +34,8 @@ import Control.Monad.Except (catchError, throwError)
import qualified Data.ByteString as B
import Data.Char (chr, isDigit, ord)
import Data.List (intercalate, isSuffixOf)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map as M
import Text.Pandoc.Class (PandocMonad, report)
import qualified Text.Pandoc.Class as P
@ -97,7 +99,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = catchError
rtfEmbedImage _ x = return x
-- | Convert Pandoc to a string in rich text format.
writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeRTF options doc = do
-- handle images
Pandoc meta@(Meta metamap) blocks <- walkM (rtfEmbedImage options) doc
@ -123,7 +125,8 @@ writeRTF options doc = do
then defField "toc" toc
else id)
$ metadata
return $ case writerTemplate options of
return $ T.pack
$ case writerTemplate options of
Just tpl -> renderTemplate' tpl context
Nothing -> case reverse body of
('\n':_) -> body

10
src/Text/Pandoc/Writers/TEI.hs
View file

@ -31,6 +31,7 @@ Conversion of 'Pandoc' documents to Docbook XML.
-}
module Text.Pandoc.Writers.TEI (writeTEI) where
import Data.Char (toLower)
import Data.Text (Text)
import Data.List (isPrefixOf, stripPrefix)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class (PandocMonad, report)
@ -56,12 +57,13 @@ authorToTEI opts name' = do
inTagsSimple "author" (text $ escapeStringForXML name)
-- | Convert Pandoc document to string in Docbook format.
writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTEI opts (Pandoc meta blocks) = do
let elements = hierarchicalize blocks
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
render' :: Doc -> Text
render' = render colwidth
startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
@ -71,9 +73,9 @@ writeTEI opts (Pandoc meta blocks) = do
auths' <- mapM (authorToTEI opts) $ docAuthors meta
let meta' = B.setMeta "author" auths' meta
metadata <- metaToJSON opts
(fmap (render colwidth . vcat) .
(mapM (elementToTEI opts startLvl)) . hierarchicalize)
(fmap (render colwidth) . inlinesToTEI opts)
(fmap (render' . vcat) .
mapM (elementToTEI opts startLvl) . hierarchicalize)
(fmap render' . inlinesToTEI opts)
meta'
main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements
let context = defField "body" main

11
src/Text/Pandoc/Writers/Texinfo.hs
View file

@ -37,6 +37,7 @@ import Data.Char (chr, ord)
import Data.List (maximumBy, transpose)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
import Network.URI (unEscapeString)
import System.FilePath
import Text.Pandoc.Class (PandocMonad, report)
@ -68,7 +69,7 @@ data WriterState =
type TI m = StateT WriterState m
-- | Convert Pandoc to Texinfo.
writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTexinfo options document =
evalStateT (pandocToTexinfo options $ wrapTop document) $
WriterState { stStrikeout = False, stSuperscript = False,
@ -80,16 +81,18 @@ wrapTop :: Pandoc -> Pandoc
wrapTop (Pandoc meta blocks) =
Pandoc meta (Header 0 nullAttr (docTitle meta) : blocks)
pandocToTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> TI m String
pandocToTexinfo :: PandocMonad m => WriterOptions -> Pandoc -> TI m Text
pandocToTexinfo options (Pandoc meta blocks) = do
let titlePage = not $ all null
$ docTitle meta : docDate meta : docAuthors meta
let colwidth = if writerWrapText options == WrapAuto
then Just $ writerColumns options
else Nothing
let render' :: Doc -> Text
render' = render colwidth
metadata <- metaToJSON options
(fmap (render colwidth) . blockListToTexinfo)
(fmap (render colwidth) . inlineListToTexinfo)
(fmap render' . blockListToTexinfo)
(fmap render' . inlineListToTexinfo)
meta
main <- blockListToTexinfo blocks
st <- get

11
src/Text/Pandoc/Writers/Textile.hs
View file

@ -33,6 +33,7 @@ module Text.Pandoc.Writers.Textile ( writeTextile ) where
import Control.Monad.State
import Data.Char (isSpace)
import Data.List (intercalate)
import Data.Text (Text, pack)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Logging
import Text.Pandoc.Definition
@ -54,7 +55,7 @@ data WriterState = WriterState {
type TW = StateT WriterState
-- | Convert Pandoc to Textile.
writeTextile :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeTextile :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTextile opts document =
evalStateT (pandocToTextile opts document)
WriterState { stNotes = [],
@ -64,17 +65,17 @@ writeTextile opts document =
-- | Return Textile representation of document.
pandocToTextile :: PandocMonad m
=> WriterOptions -> Pandoc -> TW m String
=> WriterOptions -> Pandoc -> TW m Text
pandocToTextile opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts (blockListToTextile opts)
(inlineListToTextile opts) meta
body <- blockListToTextile opts blocks
notes <- gets $ unlines . reverse . stNotes
let main = body ++ if null notes then "" else ("\n\n" ++ notes)
let main = pack $ body ++ if null notes then "" else ("\n\n" ++ notes)
let context = defField "body" main metadata
case writerTemplate opts of
Nothing -> return main
Just tpl -> return $ renderTemplate' tpl context
Nothing -> return main
Just tpl -> return $ renderTemplate' tpl context
withUseTags :: PandocMonad m => TW m a -> TW m a
withUseTags action = do

8
src/Text/Pandoc/Writers/ZimWiki.hs
View file

@ -37,7 +37,7 @@ import Control.Monad.State (StateT, evalStateT, gets, modify)
import Data.Default (Default (..))
import Data.List (intercalate, isInfixOf, isPrefixOf, transpose)
import qualified Data.Map as Map
import Data.Text (breakOnAll, pack)
import Data.Text (breakOnAll, pack, Text)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Logging
import Text.Pandoc.Definition
@ -61,17 +61,17 @@ instance Default WriterState where
type ZW = StateT WriterState
-- | Convert Pandoc to ZimWiki.
writeZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> m String
writeZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeZimWiki opts document = evalStateT (pandocToZimWiki opts document) def
-- | Return ZimWiki representation of document.
pandocToZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> ZW m String
pandocToZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> ZW m Text
pandocToZimWiki opts (Pandoc meta blocks) = do
metadata <- metaToJSON opts
(fmap trimr . blockListToZimWiki opts)
(inlineListToZimWiki opts)
meta
body <- blockListToZimWiki opts blocks
body <- pack <$> blockListToZimWiki opts blocks
--let header = "Content-Type: text/x-zim-wiki\nWiki-Format: zim 0.4\n"
let main = body
let context = defField "body" main

11
src/Text/Pandoc/XML.hs
View file

@ -37,6 +37,8 @@ module Text.Pandoc.XML ( escapeCharForXML,
fromEntities ) where
import Data.Char (isAscii, isSpace, ord)
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc.Pretty
@ -91,11 +93,10 @@ inTagsIndented :: String -> Doc -> Doc
inTagsIndented tagType = inTags True tagType []
-- | Escape all non-ascii characters using numerical entities.
toEntities :: String -> String
toEntities [] = ""
toEntities (c:cs)
| isAscii c = c : toEntities cs
| otherwise = "&#" ++ show (ord c) ++ ";" ++ toEntities cs
toEntities :: Text -> Text
toEntities = T.concatMap go
where go c | isAscii c = T.singleton c
| otherwise = T.pack ("&#" ++ show (ord c) ++ ";")
-- Unescapes XML entities
fromEntities :: String -> String

7
test/Tests/Helpers.hs
View file

@ -106,17 +106,18 @@ class ToString a where
toString :: a -> String
instance ToString Pandoc where
toString d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d
toString d = unpack $
purely (writeNative def{ writerTemplate = s }) $ toPandoc d
where s = case d of
(Pandoc (Meta m) _)
| M.null m -> Nothing
| otherwise -> Just "" -- need this to get meta output
instance ToString Blocks where
toString = purely (writeNative def) . toPandoc
toString = unpack . purely (writeNative def) . toPandoc
instance ToString Inlines where
toString = trimr . purely (writeNative def) . toPandoc
toString = trimr . unpack . purely (writeNative def) . toPandoc
instance ToString String where
toString = id

3
test/Tests/Readers/Docx.hs
View file

@ -3,6 +3,7 @@ module Tests.Readers.Docx (tests) where
import Codec.Archive.Zip
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Map as M
import Test.Tasty
import Test.Tasty.HUnit
@ -27,7 +28,7 @@ defopts :: ReaderOptions
defopts = def{ readerExtensions = getDefaultExtensions "docx" }
instance ToString NoNormPandoc where
toString d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d
toString d = T.unpack $ purely (writeNative def{ writerTemplate = s }) $ toPandoc d
where s = case d of
NoNormPandoc (Pandoc (Meta m) _)
| M.null m -> Nothing

2
test/Tests/Readers/LaTeX.hs
View file

@ -6,7 +6,7 @@ import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
import Data.Text (Text, pack)
import Data.Text (Text)
import qualified Data.Text as T
latex :: Text -> Pandoc

4
test/Tests/Readers/Odt.hs
View file

@ -5,6 +5,7 @@ import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString as BS
import qualified Text.Pandoc.UTF8 as UTF8
import qualified Data.Map as M
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
@ -41,7 +42,8 @@ newtype NoNormPandoc = NoNormPandoc {unNoNorm :: Pandoc}
deriving ( Show )
instance ToString NoNormPandoc where
toString d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d
toString d = unpack $
purely (writeNative def{ writerTemplate = s }) $ toPandoc d
where s = case d of
NoNormPandoc (Pandoc (Meta m) _)
| M.null m -> Nothing

3
test/Tests/Writers/AsciiDoc.hs
View file

@ -1,5 +1,6 @@
module Tests.Writers.AsciiDoc (tests) where
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
@ -7,7 +8,7 @@ import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
asciidoc :: (ToPandoc a) => a -> String
asciidoc = purely (writeAsciiDoc def{ writerWrapText = WrapNone }) . toPandoc
asciidoc = unpack . purely (writeAsciiDoc def{ writerWrapText = WrapNone }) . toPandoc
tests :: [TestTree]
tests = [ testGroup "emphasis"

5
test/Tests/Writers/ConTeXt.hs
View file

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.ConTeXt (tests) where
import Data.Text (unpack)
import Test.Tasty
import Test.Tasty.QuickCheck
import Tests.Helpers
@ -9,10 +10,10 @@ import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
context :: (ToPandoc a) => a -> String
context = purely (writeConTeXt def) . toPandoc
context = unpack . purely (writeConTeXt def) . toPandoc
context' :: (ToPandoc a) => a -> String
context' = purely (writeConTeXt def{ writerWrapText = WrapNone }) . toPandoc
context' = unpack . purely (writeConTeXt def{ writerWrapText = WrapNone }) . toPandoc
{-
"my test" =: X =?> Y

3
test/Tests/Writers/Docbook.hs
View file

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.Docbook (tests) where
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
@ -11,7 +12,7 @@ docbook :: (ToPandoc a) => a -> String
docbook = docbookWithOpts def{ writerWrapText = WrapNone }
docbookWithOpts :: ToPandoc a => WriterOptions -> a -> String
docbookWithOpts opts = purely (writeDocbook4 opts) . toPandoc
docbookWithOpts opts = unpack . purely (writeDocbook4 opts) . toPandoc
{-
"my test" =: X =?> Y

3
test/Tests/Writers/HTML.hs
View file

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.HTML (tests) where
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
@ -8,7 +9,7 @@ import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
html :: (ToPandoc a) => a -> String
html = purely (writeHtml4String def{ writerWrapText = WrapNone }) . toPandoc
html = unpack . purely (writeHtml4String def{ writerWrapText = WrapNone }) . toPandoc
{-
"my test" =: X =?> Y

5
test/Tests/Writers/LaTeX.hs
View file

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.LaTeX (tests) where
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
@ -14,10 +15,10 @@ latexListing :: (ToPandoc a) => a -> String
latexListing = latexWithOpts def{ writerListings = True }
latexWithOpts :: (ToPandoc a) => WriterOptions -> a -> String
latexWithOpts opts = purely (writeLaTeX opts) . toPandoc
latexWithOpts opts = unpack . purely (writeLaTeX opts) . toPandoc
beamerWithOpts :: (ToPandoc a) => WriterOptions -> a -> String
beamerWithOpts opts = purely (writeBeamer opts) . toPandoc
beamerWithOpts opts = unpack . purely (writeBeamer opts) . toPandoc
{-
"my test" =: X =?> Y

5
test/Tests/Writers/Markdown.hs
View file

@ -2,6 +2,7 @@
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Tests.Writers.Markdown (tests) where
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
@ -12,10 +13,10 @@ defopts :: WriterOptions
defopts = def{ writerExtensions = pandocExtensions }
markdown :: (ToPandoc a) => a -> String
markdown = purely (writeMarkdown defopts) . toPandoc
markdown = unpack . purely (writeMarkdown defopts) . toPandoc
markdownWithOpts :: (ToPandoc a) => WriterOptions -> a -> String
markdownWithOpts opts x = purely (writeMarkdown opts) $ toPandoc x
markdownWithOpts opts x = unpack . purely (writeMarkdown opts) $ toPandoc x
{-
"my test" =: X =?> Y

3
test/Tests/Writers/Muse.hs
View file

@ -1,5 +1,6 @@
module Tests.Writers.Muse (tests) where
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
@ -10,7 +11,7 @@ muse :: (ToPandoc a) => a -> String
muse = museWithOpts def{ writerWrapText = WrapNone }
museWithOpts :: (ToPandoc a) => WriterOptions -> a -> String
museWithOpts opts = purely (writeMuse opts) . toPandoc
museWithOpts opts = unpack . purely (writeMuse opts) . toPandoc
infix 4 =:
(=:) :: (ToString a, ToPandoc a)

6
test/Tests/Writers/Native.hs
View file

@ -1,5 +1,6 @@
module Tests.Writers.Native (tests) where
import Data.Text (unpack)
import Test.Tasty
import Test.Tasty.QuickCheck
import Tests.Helpers
@ -8,12 +9,11 @@ import Text.Pandoc.Arbitrary ()
p_write_rt :: Pandoc -> Bool
p_write_rt d =
read (purely (writeNative def{ writerTemplate = Just "" }) d) == d
read (unpack $ purely (writeNative def{ writerTemplate = Just "" }) d) == d
p_write_blocks_rt :: [Block] -> Bool
p_write_blocks_rt bs =
read (purely (writeNative def) (Pandoc nullMeta bs)) ==
bs
read (unpack $ purely (writeNative def) (Pandoc nullMeta bs)) == bs
tests :: [TestTree]
tests = [ testProperty "p_write_rt" p_write_rt

4
trypandoc/trypandoc.hs
View file

@ -33,11 +33,11 @@ app req respond = do
_ -> error $ "could not find reader for "
++ T.unpack fromFormat
let writer = case getWriter (T.unpack toFormat) of
Right (StringWriter w) -> w writerOpts
Right (TextWriter w) -> w writerOpts
_ -> error $ "could not find writer for " ++
T.unpack toFormat
let result = case runPure $ reader (tabFilter 4 text) >>= writer of
Right s -> T.pack s
Right s -> s
Left err -> error (show err)
let output = encode $ object [ T.pack "html" .= result
, T.pack "name" .=