I have modified export function with an additional argument of type Template T.Text:
export :: (PandocMonad m, MonadIO m, MonadMask m) => Template T.Text -> Pandoc -> m (Either BL.ByteString BL.ByteString)
export tmpl = makePDF "pdflatex" [] writeMarkdown def {writerTemplate = Just tmpl}
and main function:
main :: IO ()
main = do
mybytes <- runIO $ do
doc <- g xmlString
tmpl <- compileDefaultTemplate "latex"
export tmpl doc
lr <- handleError mybytes
case lr of (Right b) -> BL.writeFile "output.pdf" b
(Left x) -> BL.putStr x
Full code:
Expand disclosure triangle to see "haskell" source
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.List
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.Text.IO as TIO
import Data.Tree
import Text.Pandoc
import Text.Pandoc.PDF
import Text.Pandoc.Shared
import qualified Data.ByteString.Lazy as BL
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Catch
interact'' :: (T.Text -> IO T.Text) -> IO ()
interact'' f =
TIO.getContents
>>= TIO.readFile . T.unpack
>>= f
>>= TIO.putStrLn
xmlString :: T.Text
xmlString = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<html>\n <head>\n <meta charset=\"utf-8\"/>\n </head>\n <body>\n <ul id=\"a8_boYDC\">\n <li id=\"rp\">\n <p>\"Alpha\"</p>\n <ul>\n <li id=\"cT\">\n <p>\"Beta\"</p>\n <ul>\n <li id=\"wy\">\n <p>\"Gamma\"</p>\n </li>\n <li id=\"Be\">\n <p>\"Delta\"</p>\n </li>\n <li id=\"Ep\">\n <p>\"Epsilon\"</p>\n </li>\n </ul>\n </li>\n <li id=\"Ko\">\n <p>\"Zeta\"</p>\n <ul>\n <li id=\"AI\">\n <p>\"Eta\"</p>\n </li>\n </ul>\n </li>\n <li id=\"kw\">\n <p>\"Theta\"</p>\n <ul>\n <li id=\"sx\">\n <p>\"Iota\"</p>\n </li>\n <li id=\"82\">\n <p>\"Kappa\"</p>\n </li>\n <li id=\"o_\">\n <p>\"Lambda\"</p>\n </li>\n </ul>\n </li>\n </ul>\n </li>\n </ul>\n </body>\n</html>\n"
xmlToMD :: T.Text -> IO T.Text
xmlToMD =
handleError
<=< runIO
. ( pure
. T.unlines
. map (T.drop 1 . T.filter (/= '-'))
. filter (not . T.null)
. T.lines
<=< writePlain def {writerTabStop = 2}
<=< readHtml def
)
export :: (PandocMonad m, MonadIO m, MonadMask m) => Template T.Text -> Pandoc -> m (Either BL.ByteString BL.ByteString)
export tmpl = makePDF "pdflatex" [] writeMarkdown def {writerTemplate = Just tmpl}
g :: T.Text -> PandocIO Pandoc
g = readHtml def
-- f :: MonadIO m => T.Text -> m (Either BL.ByteString BL.ByteString)
f :: T.Text -> PandocIO Pandoc
f = liftIO . (handleError <=< runIO) . g
main :: IO ()
main = do
mybytes <- runIO $ do
doc <- g xmlString
tmpl <- compileDefaultTemplate "latex"
export tmpl doc
lr <- handleError mybytes
case lr of (Right b) -> BL.writeFile "output.pdf" b
(Left x) -> BL.putStr x
However, I get an error with the default template:
! LaTeX hooks Error: Missing (empty) default label on line 7.
(hooks) This command was ignored.
I tried printing the output of writeLaTeX directly. Line 7 was:
\usepackage{amsmath,amssymb}
The Pandoc manual has a long list of packages that need to be installed to output to PDF, and among them is amsmath. So maybe it’s a missing dependency?
To use compileTemplate, it looks like you just write your own template (or edit the default one), save it and then do the same as with compileDefaultTemplate, but with the filename as the first argument:
do
t <- compileTemplate "myTemplate.tex" "latex"
case t of Right tmpl -> -- file read succeeded, so use the template
export :: (PandocMonad m, MonadIO m, MonadMask m) => String -> Template T.Text -> Pandoc -> m (Either BL.ByteString BL.ByteString)
export pdfengine tmpl = makePDF pdfengine [] writeLaTeX def {writerTemplate = Just tmpl}
The writer parameter of makePDF should be writeLaTeX
And, we are forced to update the parameter
def {writerTemplate = Just tmpl}
where tmpl has type Template Text.
Otherwise, pandoc would produce a fragment (instead a standalone document). And that’s why it can’t convert that LaTeX document to PDF.
One of the parameters of the type WriterOptions used to be writeStandalone :: Bool, but that was deprecated. When a Template is used, the writer always generates a standalone document.