Added Text.Pandoc.PDF module, 'pdf' as new output option.

The module calls pdflatex to produce the PDF, and is basically shell
scripting in haskell. But this is better than the existing markdown2pdf
script, which is limited to POSIX.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1394 788f1e2b-df1e-0410-8736-df70ead52e1b

1 files changed, 98 insertions, 104 deletions

diff --git a/Text/Pandoc/PDF.hs b/Text/Pandoc/PDF.hs
index 5b900bf03..fa1e6dcf5 100644
--- a/Text/Pandoc/PDF.hs
+++ b/Text/Pandoc/PDF.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, CPP #-}
+{-# LANGUAGE CPP #-}
 {-
 Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>
 
@@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 
 {- |
-   Module      : Text.Pandoc.ODT
+   Module      : Text.Pandoc.PDF
    Copyright   : Copyright (C) 2006-7 John MacFarlane
    License     : GNU GPL, version 2 or above
 
@@ -26,119 +26,113 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    Stability   : alpha
    Portability : portable
 
-Functions for producing an ODT file from OpenDocument XML.
+Functions for producing a PDF file from LaTeX.
 -}
-module Text.Pandoc.ODT ( saveOpenDocumentAsODT ) where
-import Text.Pandoc.TH ( binaryContentsOf )
-import Data.Maybe ( fromJust )
-import Data.List ( partition, intersperse )
+module Text.Pandoc.PDF ( saveLaTeXAsPDF ) where
+import Data.List ( isInfixOf )
 import System.Directory
-import System.FilePath ( (</>), takeDirectory, takeFileName, splitDirectories )
+import System.FilePath ( (</>), (<.>), takeBaseName )
 import System.Process ( runProcess, waitForProcess )
 import System.Exit
-import Text.XML.Light
-import Text.XML.Light.Cursor
+import System.Environment ( getEnvironment )
 import Text.Pandoc.Shared ( withTempDir )
-import Network.URI ( isURI )
-import qualified Data.ByteString as B ( writeFile, pack )
-import Data.ByteString.Internal ( c2w )
-import Prelude hiding ( writeFile, readFile )
-import System.IO ( stderr )
+import Prelude hiding ( writeFile, readFile, putStrLn )
+import System.IO ( stderr, openFile, IOMode (..) )
 #ifdef _UTF8STRING
 import System.IO.UTF8
 #else
 import Text.Pandoc.UTF8
 #endif
 
--- | Produce an ODT file from OpenDocument XML.
-saveOpenDocumentAsODT :: FilePath    -- ^ Pathname of ODT file to be produced.
-                      -> FilePath    -- ^ Relative directory of source file.
-                      -> String      -- ^ OpenDocument XML contents.
-                      -> IO ()
-saveOpenDocumentAsODT destinationODTPath sourceDirRelative xml = do
-  let zipCmd = "zip"
-  -- check for zip in path:
-  zipPathMaybe <- findExecutable zipCmd
-  let zipPath = case zipPathMaybe of
-                  Nothing -> error $ "The '" ++ zipCmd ++
-                                     "' command, which is needed to build an ODT file, was not found.\n" ++
-                                     "It can be obtained from http://www.info-zip.org/Zip.html\n" ++
-                                     "Debian (and Debian-based) linux: apt-get install zip\n" ++
-                                     "Windows: See http://gnuwin32.sourceforge.net/packages/zip.htm"
+-- | Produce an PDF file from LaTeX.
+saveLaTeXAsPDF :: FilePath    -- ^ Pathname of PDF file to be produced.
+                -> FilePath    -- ^ Relative directory of source file.
+                -> String      -- ^ LaTeX document.
+                -> IO ()
+saveLaTeXAsPDF destinationPDFPath sourceDirRelative latex = do
+  -- check for pdflatex and bibtex in path:
+  latexPathMaybe <- findExecutable "pdflatex"
+  bibtexPathMaybe <- findExecutable "bibtex"
+  let latexPath = case latexPathMaybe of
+                  Nothing -> error $ "The 'pdflatex' command, which is needed to build an PDF file, was not found."
                   Just x  -> x
-  withTempDir "pandoc-odt" $ \tempDir -> do
-    let tempODT = tempDir </> "reference.odt"
-    B.writeFile tempODT $ B.pack $ map c2w $(binaryContentsOf $ "odt-styles" </> "reference.odt")
-    xml' <- handlePictures tempODT sourceDirRelative xml
-    writeFile (tempDir </> "content.xml") xml'
-    ph <- runProcess zipPath ["-9", "-q", "-r", tempODT, "content.xml", "Pictures"]
-            (Just tempDir) Nothing Nothing Nothing (Just stderr)
-    ec <- waitForProcess ph   -- requires compilation with -threaded
-    case ec of
-         ExitSuccess -> copyFile tempODT destinationODTPath
-         _           -> error "Error creating ODT." >> exitWith ec
-
--- | Find <draw:image ... /> elements and copy the file (xlink:href attribute) into Pictures/ in
--- the zip file.  If filename is a URL, attempt to download it.  Modify xlink:href attributes
--- to point to the new locations in Pictures/.  Return modified XML.
-handlePictures :: FilePath     -- ^ Path of ODT file in temp directory
-               -> FilePath     -- ^ Directory (relative) containing source file
-               -> String       -- ^ OpenDocument XML string
-               -> IO String    -- ^ Modified XML
-handlePictures tempODT sourceDirRelative xml = do
-  let parsed = case parseXMLDoc xml of
-                Nothing -> error "Could not parse OpenDocument XML."
-                Just x  -> x
-  let cursor = case (fromForest $ elContent parsed) of
-                   Nothing -> error "ODT appears empty"
-                   Just x  -> x
-  cursor' <- scanPictures tempODT sourceDirRelative cursor
-  let modified = parsed { elContent = toForest $ root cursor' }
-  return $ showTopElement modified
-
-scanPictures :: FilePath -> FilePath -> Cursor -> IO Cursor
-scanPictures tempODT sourceDirRelative cursor = do
-  cursor' <- handleTree tempODT sourceDirRelative cursor
-  case right cursor' of
-       Just n  -> scanPictures tempODT sourceDirRelative n
-       Nothing -> return cursor'
-
-handleTree :: FilePath -> FilePath -> Cursor -> IO Cursor
-handleTree tempODT sourceDirRelative cursor = do
-  case firstChild cursor of
-       Nothing -> modifyContentM (handleContent tempODT sourceDirRelative) cursor
-       Just n  -> scanPictures tempODT sourceDirRelative n >>= return . fromJust . parent
+  let bibtexPath = case bibtexPathMaybe of
+                  Nothing -> error $ "The 'bibtex' command, which is needed to build an PDF file, was not found."
+                  Just x  -> x
+  sourceDirAbsolute <- getCurrentDirectory >>= return . (</> sourceDirRelative) >>= canonicalizePath
+  withTempDir "pandoc-pdf" $ \tempDir -> do
+    env <- getEnvironment
+    let env' = ("TEXINPUTS", ".:" ++ sourceDirAbsolute ++ ":") : env
+    let baseName = "input"
+    writeFile (tempDir </> baseName <.> "tex") latex
+    let runLatex = runProgram latexPath ["-interaction=nonstopmode", baseName] tempDir env'
+    let runBibtex = runProgram bibtexPath [baseName] tempDir env'
+    messages1 <- runLatex
+    let logPath = tempDir </> baseName <.> "log"
+    tocExists <- doesFileExist (tempDir </> baseName <.> "toc")
+    logContents <- readFile logPath
+    let undefinedRefs = "There were undefined references" `isInfixOf` logContents
+    let needsBibtex = "itation" `isInfixOf` logContents
+    if needsBibtex
+       then runBibtex >>= hPutStr stderr . unlines
+       else return ()
+    if tocExists || undefinedRefs
+       then do
+         messages2 <- runLatex
+         logContents' <- readFile logPath
+         let stillUndefinedRefs = "There were undefined references" `isInfixOf` logContents'
+         if stillUndefinedRefs
+            then runLatex >>= hPutStr stderr . unlines
+            else hPutStr stderr $ unlines messages2
+       else
+         hPutStr stderr $ unlines messages1
+    let pdfPath = tempDir </> baseName <.> "pdf"
+    pdfExists <- doesFileExist pdfPath
+    if pdfExists
+       then copyFile pdfPath destinationPDFPath
+       else error "The PDF could not be created."
 
--- | If content is an image link, handle it appropriately.
--- Otherwise, handle children if any.
-handleContent :: FilePath -> FilePath -> Content -> IO Content
-handleContent tempODT sourceDirRelative content@(Elem el) = do
-  if qName (elName el) == "image"
-     then do
-        let (hrefs, rest) = partition (\a -> qName (attrKey a) == "href") $ elAttribs el
-        let href = case hrefs of
-                          []     -> error $ "No href found in " ++ show el
-                          [x]    -> x
-                          _      -> error $ "Multiple hrefs found in " ++ show el
-        if isURI $ attrVal href
-           then return content
-           else do  -- treat as filename
-             let oldLoc = sourceDirRelative </> attrVal href
-             fileExists <- doesFileExist oldLoc
-             if fileExists
-                then do
-                   let pref = take 230 $ concat $ intersperse "_" $
-                                splitDirectories $ takeDirectory $ attrVal href
-                   let newLoc = "Pictures" </> pref ++ "_" ++ (takeFileName $ attrVal href)
-                   let tempDir = takeDirectory tempODT
-                   createDirectoryIfMissing False $ tempDir </> takeDirectory newLoc
-                   copyFile oldLoc $ tempDir </> newLoc
-                   let newAttrs = (href { attrVal = newLoc }) : rest
-                   return $ Elem (el { elAttribs = newAttrs })
-                else do
-                   hPutStrLn stderr $ "Warning:  Unable to find image at " ++ oldLoc ++ " - ignoring."
-                   return content
-     else return content
- 
-handleContent _ _ c = return c  -- not Element
+runProgram :: FilePath             -- ^ pathname of executable
+           -> [String]             -- ^ arguments
+           -> FilePath             -- ^ working directory
+           -> [(String, String)]   -- ^ environment
+           -> IO [String]
+runProgram cmdPath arguments workingDir env = do
+   let runOutputPath = workingDir </> "output" <.> "tmp"
+   runOutput <- openFile runOutputPath WriteMode
+   ph <- runProcess cmdPath arguments (Just workingDir) (Just env) Nothing (Just runOutput) (Just runOutput)
+   ec <- waitForProcess ph   -- requires compilation with -threaded
+   case ec of
+         ExitSuccess -> return []
+         _           -> do
+                          output <- readFile runOutputPath
+                          if (takeBaseName cmdPath) == "bibtex"
+                             then return $! lines output
+                             else do
+                               return $!
+                                   (if "`ucs.sty' not found" `isInfixOf` output
+                                       then ["Please install the 'unicode' package from CTAN:",
+                                             "  http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/"]
+                                       else []) ++
+                                   (if "`ulem.sty' not found" `isInfixOf` output
+                                       then ["Please install the 'ulem' package from CTAN:",
+                                             "  http://www.ctan.org/tex-archive/macros/latex/contrib/misc/"]
+                                       else []) ++
+                                   (if "`graphicx.sty' not found" `isInfixOf` output
+                                       then ["Please install the 'graphicx' package from CTAN:",
+                                             "  http://www.ctan.org/tex-archive/macros/latex/required/graphics/"]
+                                       else []) ++
+                                   (if "`fancyhdr.sty' not found" `isInfixOf` output
+                                       then ["Please install the 'fancyhdr' package from CTAN:",
+                                             "  http://www.ctan.org/tex-archive/macros/latex/contrib/fancyhdr/"]
+                                       else []) ++
+                                   (if "`array.sty' not found" `isInfixOf` output
+                                       then ["Please install the 'array' package from CTAN:",
+                                             "  http://www.ctan.org/tex-archive/macros/latex/required/tools/"]
+                                       else []) ++
+                                   (filter isUseful $ lines output)
+                                     where isUseful ln = take 1 ln == "!"  ||
+                                                         take 2 ln == "l." ||
+                                                         "Error"   `isInfixOf` ln ||
+                                                         "error"   `isInfixOf` ln