Steps towards making makePDF polymorphic.

1 files changed, 71 insertions, 48 deletions

diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs
index 06702b5f1..b92f25d99 100644
--- a/src/Text/Pandoc/PDF.hs
+++ b/src/Text/Pandoc/PDF.hs
@@ -19,7 +19,6 @@ import Prelude
 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.ByteString as BS
 import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as BL
@@ -51,7 +50,7 @@ import Text.Pandoc.Writers.Shared (getField, metaToContext)
 import Data.List (intercalate)
 #endif
 import Data.List (isPrefixOf, find)
-import Text.Pandoc.Class (PandocMonad(..), PandocIO,
+import Text.Pandoc.Class (PandocMonad(..),
                           extractMedia, fillMediaBag, getCommonState,
                           getVerbosity, putCommonState, report,
                           runIOorExplode, setVerbosity)
@@ -62,27 +61,28 @@ changePathSeparators :: FilePath -> FilePath
 changePathSeparators = intercalate "/" . splitDirectories
 #endif
 
-makePDF :: String              -- ^ pdf creator (pdflatex, lualatex, xelatex,
+makePDF :: PandocMonad m
+        => String              -- ^ pdf creator (pdflatex, lualatex, xelatex,
                                -- wkhtmltopdf, weasyprint, prince, context, pdfroff,
                                -- or path to executable)
         -> [String]            -- ^ arguments to pass to pdf creator
-        -> (WriterOptions -> Pandoc -> PandocIO Text)  -- ^ writer
+        -> (WriterOptions -> Pandoc -> m Text)  -- ^ writer
         -> WriterOptions       -- ^ options
         -> Pandoc              -- ^ document
-        -> PandocIO (Either ByteString ByteString)
+        -> m (Either ByteString ByteString)
 makePDF program pdfargs writer opts doc =
   case takeBaseName program of
     "wkhtmltopdf" -> makeWithWkhtmltopdf program pdfargs writer opts doc
     prog | prog `elem` ["weasyprint", "prince"] -> do
       source <- writer opts doc
       verbosity <- getVerbosity
-      liftIO $ html2pdf verbosity program pdfargs source
+      io (Left prog) $ html2pdf verbosity program pdfargs source
     "pdfroff" -> do
       source <- writer opts doc
       let args   = ["-ms", "-mpdfmark", "-mspdf",
                     "-e", "-t", "-k", "-KUTF-8", "-i"] ++ pdfargs
       verbosity <- getVerbosity
-      liftIO $ generic2pdf verbosity program args source
+      io (Left "pdfroff") $ generic2pdf verbosity program args source
     baseProg -> do
       commonState <- getCommonState
       verbosity <- getVerbosity
@@ -100,7 +100,8 @@ makePDF program pdfargs writer opts doc =
             if '~' `elem` tmp || uname == Just "Cygwin" -- see #5451
                    then withTempDirectory "." templ action
                    else withSystemTempDirectory templ action
-      (newCommonState, res) <- liftIO $ withTempDir "tex2pdf." $ \tmpdir' -> do
+      (newCommonState, res) <- io (Left baseProg) $
+       withTempDir "tex2pdf." $ \tmpdir' -> do
 #ifdef _WINDOWS
         -- note:  we want / even on Windows, for TexLive
         let tmpdir = changePathSeparators tmpdir'
@@ -123,12 +124,13 @@ makePDF program pdfargs writer opts doc =
       putCommonState newCommonState
       return res
 
-makeWithWkhtmltopdf :: String              -- ^ wkhtmltopdf or path
+makeWithWkhtmltopdf :: PandocMonad m
+                    => String              -- ^ wkhtmltopdf or path
                     -> [String]            -- ^ arguments
-                    -> (WriterOptions -> Pandoc -> PandocIO Text)  -- ^ writer
+                    -> (WriterOptions -> Pandoc -> m Text)  -- ^ writer
                     -> WriterOptions       -- ^ options
                     -> Pandoc              -- ^ document
-                    -> PandocIO (Either ByteString ByteString)
+                    -> m (Either ByteString ByteString)
 makeWithWkhtmltopdf program pdfargs writer opts doc@(Pandoc meta _) = do
   let mathArgs = case writerHTMLMathMethod opts of
                  -- with MathJax, wait til all math is rendered:
@@ -155,16 +157,17 @@ makeWithWkhtmltopdf program pdfargs writer opts doc@(Pandoc meta _) = do
                  ]
   source <- writer opts doc
   verbosity <- getVerbosity
-  liftIO $ html2pdf verbosity program args source
+  io (Left "wkhtmltopdf") $ html2pdf verbosity program args source
 
-handleImages :: WriterOptions
+handleImages :: PandocMonad m
+             => WriterOptions
              -> FilePath      -- ^ temp dir to store images
              -> Pandoc        -- ^ document
-             -> PandocIO Pandoc
+             -> m Pandoc
 handleImages opts tmpdir doc =
   fillMediaBag doc >>=
     extractMedia tmpdir >>=
-    walkM (convertImages opts tmpdir)
+      walkM (convertImages opts tmpdir)
 
 convertImages :: PandocMonad m
               => WriterOptions -> FilePath -> Inline -> m Inline
@@ -210,18 +213,19 @@ convertImage opts tmpdir fname = do
                  E.catch (Right pngOut <$ JP.savePngImage pngOut img) $
                      \(e :: E.SomeException) -> return (Left (show e))
   where
-    sandboxError = Left $ "Cannot convert image " ++ fname ++ " in a sandbox"
+    sandboxError = Left $ "convert image " ++ fname
     pngOut = replaceDirectory (replaceExtension fname ".png") tmpdir
     pdfOut = replaceDirectory (replaceExtension fname ".pdf") tmpdir
     mime = getMimeType fname
     doNothing = return (Right fname)
 
-tectonic2pdf :: Verbosity                       -- ^ Verbosity level
+tectonic2pdf :: PandocMonad m
+             => Verbosity                       -- ^ Verbosity level
              -> String                          -- ^ tex program
              -> [String]                        -- ^ Arguments to the latex-engine
              -> FilePath                        -- ^ temp directory for output
              -> Text                            -- ^ tex source
-             -> PandocIO (Either ByteString ByteString)
+             -> m (Either ByteString ByteString)
 tectonic2pdf verbosity program args tmpDir source = do
   (exit, log', mbPdf) <- runTectonic verbosity program args tmpDir source
   case (exit, mbPdf) of
@@ -231,12 +235,13 @@ tectonic2pdf verbosity program args tmpDir source = do
           missingCharacterWarnings verbosity log'
           return $ Right pdf
 
-tex2pdf :: Verbosity                       -- ^ Verbosity level
+tex2pdf :: PandocMonad m
+        => Verbosity                       -- ^ Verbosity level
         -> String                          -- ^ tex program
         -> [String]                        -- ^ Arguments to the latex-engine
         -> FilePath                        -- ^ temp directory for output
         -> Text                            -- ^ tex source
-        -> PandocIO (Either ByteString ByteString)
+        -> m (Either ByteString ByteString)
 tex2pdf verbosity program args tmpDir source = do
   let numruns | takeBaseName program == "latexmk"        = 1
               | "\\tableofcontents" `T.isInfixOf` source = 3  -- to get page numbers
@@ -258,7 +263,7 @@ tex2pdf verbosity program args tmpDir source = do
           missingCharacterWarnings verbosity log'
           return $ Right pdf
 
-missingCharacterWarnings :: Verbosity -> ByteString -> PandocIO ()
+missingCharacterWarnings :: PandocMonad m => Verbosity -> ByteString -> m ()
 missingCharacterWarnings verbosity log' = do
   let ls = BC.lines log'
   let isMissingCharacterWarning = BC.isPrefixOf "Missing character: "
@@ -295,8 +300,13 @@ extractConTeXtMsg log' = do
 
 -- running tex programs
 
-runTectonic :: Verbosity -> String -> [String] -> FilePath
-              -> Text -> PandocIO (ExitCode, ByteString, Maybe ByteString)
+runTectonic :: PandocMonad m
+            => Verbosity
+            -> String
+            -> [String]
+            -> FilePath
+            -> Text
+            -> m (ExitCode, ByteString, Maybe ByteString)
 runTectonic verbosity program args' tmpDir' source = do
     let getOutDir acc (a:b:xs) = if a `elem` ["-o", "--outdir"]
                                     then (reverse acc ++ xs, Just b)
@@ -304,20 +314,21 @@ runTectonic verbosity program args' tmpDir' source = do
         getOutDir acc xs = (reverse acc ++ xs, Nothing)
         (args, outDir) = getOutDir [] args'
         tmpDir = fromMaybe tmpDir' outDir
-    liftIO $ createDirectoryIfMissing True tmpDir
+    io (Left $ "create directory " ++ tmpDir)
+      $ createDirectoryIfMissing True tmpDir
     -- run tectonic on stdin so it reads \include commands from $PWD instead of a temp directory
     let sourceBL = BL.fromStrict $ UTF8.fromText source
     let programArgs = ["--outdir", tmpDir] ++ args ++ ["-"]
-    env <- liftIO getEnvironment
-    when (verbosity >= INFO) $ liftIO $
+    env <- io (Left "getEnvironment") $ getEnvironment
+    when (verbosity >= INFO) $ io (Right ()) $
       showVerboseInfo (Just tmpDir) program programArgs env (UTF8.toStringLazy sourceBL)
-    (exit, out) <- liftIO $ E.catch
+    (exit, out) <- io (Left "tectonic") $ E.catch
       (pipeProcess (Just env) program programArgs sourceBL)
       (\(e :: IOError) -> if isDoesNotExistError e
                              then E.throwIO $ PandocPDFProgramNotFoundError
                                    program
                              else E.throwIO e)
-    when (verbosity >= INFO) $ liftIO $ do
+    when (verbosity >= INFO) $ io (Right ()) $ do
       putStrLn "[makePDF] Running"
       BL.hPutStr stdout out
       putStr "\n"
@@ -327,23 +338,26 @@ runTectonic verbosity program args' tmpDir' source = do
 
 -- read a pdf that has been written to a temporary directory, and optionally read
 -- logs
-getResultingPDF :: Maybe String -> String -> PandocIO (Maybe ByteString, Maybe ByteString)
+getResultingPDF :: PandocMonad m
+                => Maybe String
+                -> String
+                -> m (Maybe ByteString, Maybe ByteString)
 getResultingPDF logFile pdfFile = do
-    pdfExists <- liftIO $ doesFileExist pdfFile
+    pdfExists <- fileExists pdfFile
     pdf <- if pdfExists
               -- We read PDF as a strict bytestring to make sure that the
               -- temp directory is removed on Windows.
               -- See https://github.com/jgm/pandoc/issues/1192.
-              then (Just . BL.fromChunks . (:[])) `fmap`
-                   liftIO (BS.readFile pdfFile)
+              then (Just . BL.fromChunks . (:[])) <$>
+                   readFileStrict pdfFile
               else return Nothing
     -- Note that some things like Missing character warnings
     -- appear in the log but not on stderr, so we prefer the log:
     log' <- case logFile of
               Just logFile' -> do
-                logExists <- liftIO $ doesFileExist logFile'
+                logExists <- fileExists logFile'
                 if logExists
-                  then liftIO $ Just <$> BL.readFile logFile'
+                  then Just <$> readFileLazy logFile'
                   else return Nothing
               Nothing -> return Nothing
     return (log', pdf)
@@ -351,8 +365,15 @@ getResultingPDF logFile pdfFile = do
 -- Run a TeX program on an input bytestring and return (exit code,
 -- 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
-              -> Text -> PandocIO (ExitCode, ByteString, Maybe ByteString)
+runTeXProgram :: PandocMonad m
+              => Verbosity
+              -> String
+              -> [String]
+              -> Int
+              -> Int
+              -> FilePath
+              -> Text
+              -> m (ExitCode, ByteString, Maybe ByteString)
 runTeXProgram verbosity program args runNumber numRuns tmpDir' source = do
     let isOutdirArg x = "-outdir=" `isPrefixOf` x ||
                         "-output-directory=" `isPrefixOf` x
@@ -360,16 +381,18 @@ runTeXProgram verbosity program args runNumber numRuns tmpDir' source = do
           case find isOutdirArg args of
             Just x  -> drop 1 $ dropWhile (/='=') x
             Nothing -> tmpDir'
-    liftIO $ createDirectoryIfMissing True tmpDir
+    io (Left $ "create directory " ++ tmpDir) $
+      createDirectoryIfMissing True tmpDir
     let file = tmpDir ++ "/input.tex"  -- note: tmpDir has / path separators
-    exists <- liftIO $ doesFileExist file
-    unless exists $ liftIO $ BS.writeFile file $ UTF8.fromText source
+    exists <- fileExists file
+    unless exists $ io (Left $ "write file " ++ file) $
+      BS.writeFile file $ UTF8.fromText source
     let isLatexMk = takeBaseName program == "latexmk"
         programArgs | isLatexMk = ["-interaction=batchmode", "-halt-on-error", "-pdf",
                                    "-quiet", "-outdir=" ++ tmpDir] ++ args ++ [file]
                     | otherwise = ["-halt-on-error", "-interaction", "nonstopmode",
                                    "-output-directory", tmpDir] ++ args ++ [file]
-    env' <- liftIO getEnvironment
+    env' <- io (Right []) getEnvironment
     let sep = [searchPathSeparator]
     let texinputs = maybe (tmpDir ++ sep) ((tmpDir ++ sep) ++)
           $ lookup "TEXINPUTS" env'
@@ -377,16 +400,16 @@ runTeXProgram verbosity program args runNumber numRuns tmpDir' source = do
                 ("TEXMFOUTPUT", tmpDir) :
                   [(k,v) | (k,v) <- env'
                          , k /= "TEXINPUTS" && k /= "TEXMFOUTPUT"]
-    when (runNumber == 1 && verbosity >= INFO) $ liftIO $
-      UTF8.readFile file >>=
+    when (runNumber == 1 && verbosity >= INFO) $
+      io (Left $ "read file " ++ file) $ UTF8.readFile file >>=
        showVerboseInfo (Just tmpDir) program programArgs env''
-    (exit, out) <- liftIO $ E.catch
+    (exit, out) <- io (Left program) $ E.catch
       (pipeProcess (Just env'') program programArgs BL.empty)
       (\(e :: IOError) -> if isDoesNotExistError e
                              then E.throwIO $ PandocPDFProgramNotFoundError
                                    program
                              else E.throwIO e)
-    when (verbosity >= INFO) $ liftIO $ do
+    when (verbosity >= INFO) $ io (Right ()) $ do
       putStrLn $ "[makePDF] Run #" ++ show runNumber
       BL.hPutStr stdout out
       putStr "\n"
@@ -463,14 +486,15 @@ html2pdf verbosity program args source = do
                  (ExitSuccess, Nothing)  -> Left ""
                  (ExitSuccess, Just pdf) -> Right pdf
 
-context2pdf :: Verbosity    -- ^ Verbosity level
+context2pdf :: PandocMonad m
+            => Verbosity    -- ^ Verbosity level
             -> String       -- ^ "context" or path to it
             -> [String]     -- ^ extra arguments
             -> FilePath     -- ^ temp directory for output
             -> Text         -- ^ ConTeXt source
-            -> PandocIO (Either ByteString ByteString)
+            -> m (Either ByteString ByteString)
 context2pdf verbosity program pdfargs tmpDir source =
-  liftIO $ inDirectory tmpDir $ do
+  io (Left $ "create " ++ tmpDir) $ inDirectory tmpDir $ do
     let file = "input.tex"
     BS.writeFile file $ UTF8.fromText source
     let programArgs = "--batchmode" : pdfargs ++ [file]
@@ -502,7 +526,6 @@ context2pdf verbosity program pdfargs tmpDir source =
          (ExitSuccess, Nothing)  -> return $ Left ""
          (ExitSuccess, Just pdf) -> return $ Right pdf
 
-
 showVerboseInfo :: Maybe FilePath
                 -> String
                 -> [String]