pandoc.hs: Make --strict compatible with --standalone, --toc.

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

1 files changed, 195 insertions, 0 deletions

diff --git a/src/markdown2pdf.hs b/src/markdown2pdf.hs
new file mode 100644
index 000000000..7a557069b
--- /dev/null
+++ b/src/markdown2pdf.hs
@@ -0,0 +1,195 @@
+module Main where
+
+import Data.List (isInfixOf, intercalate, intersect)
+import Data.Maybe (isNothing)
+
+import Control.Monad (when, unless, guard)
+import Control.Exception (tryJust, bracket)
+
+import System.IO (stderr, hPutStrLn)
+import System.IO.Error (isDoesNotExistError)
+import System.Exit (ExitCode (..), exitWith)
+import System.FilePath
+import System.Directory
+import System.Process (readProcessWithExitCode)
+import System.Environment (getArgs, getProgName)
+
+
+run :: FilePath -> [String] -> IO (Either String String)
+run file opts = do
+  (code, out, err) <- readProcessWithExitCode file opts ""
+  let msg = out ++ err
+  case code of
+    ExitFailure _ -> return $ Left  $! msg
+    ExitSuccess   -> return $ Right $! msg
+
+parsePandocArgs :: [String] -> IO (Maybe ([String], String))
+parsePandocArgs args = do
+  result <- run "pandoc" $ ["--dump-args"] ++ args
+  return $ either (const Nothing) (parse . map trim . lines) result
+  where parse []         = Nothing
+        parse ("-":[])   = Just ([], "stdin") -- no output or input
+        parse ("-":x:xs) = Just (x:xs, dropExtension x) -- no output
+        parse ( x :xs)   = Just (xs,   dropExtension x) -- at least output
+        --trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+        trim = takeWhile (/='\r') . dropWhile (=='\r')
+
+runPandoc :: [String] -> FilePath -> IO (Either String FilePath)
+runPandoc inputs output = do
+  let texFile = replaceExtension output "tex"
+  result <- run "pandoc" $
+    ["-s", "--no-wrap", "-r", "markdown", "-w", "latex"]
+    ++ inputs ++ ["-o", texFile]
+  return $ either Left (const $ Right texFile) result
+
+runLatexRaw :: FilePath -> IO (Either (Either String String) FilePath)
+runLatexRaw file = do
+  -- we ignore the ExitCode because pdflatex always fails the first time
+  run "pdflatex" ["-interaction=batchmode", "-output-directory",
+    takeDirectory file, dropExtension file] >> return ()
+  let pdfFile = replaceExtension file "pdf"
+  let logFile = replaceExtension file "log"
+  txt <- tryJust (guard . isDoesNotExistError) (readFile logFile)
+  let  checks = checkLatex $ either (const "") id txt
+  case checks of
+  -- err  , bib , ref , msg
+    (True , _    , _   , msg) -> return $ Left $ Left msg   -- failure
+    (False, True , _   , msg) -> runBibtex file >>
+                                (return $ Left $ Right msg) -- citations
+    (False, _    , True, msg) -> return $ Left $ Right msg  -- references
+    (False, False, False, _ ) -> return $ Right pdfFile     -- success
+
+runLatex :: FilePath -> IO (Either String FilePath)
+runLatex file = step 3
+  where
+  step 0 = return $ Left "Limit of attempts reached"
+  step n = do
+    result <- runLatexRaw file
+    case result of
+      Left (Left err) -> return $ Left err
+      Left (Right _ ) -> step (n-1 :: Int)
+      Right pdfFile   -> return $ Right pdfFile
+
+checkLatex :: String -> (Bool, Bool, Bool, String)
+checkLatex ""  = (True, False, False, "Could not read log file")
+checkLatex txt = (err , bib, ref, unlines $! msgs ++ tips)
+  where
+  xs `oneOf` x = any (flip isInfixOf x) xs
+  msgs = filter (oneOf ["Error:", "Warning:"]) (lines txt)
+  tips = checkPackages msgs
+  err = any (oneOf ["LaTeX Error:", "Latex Error:"]) msgs
+  bib = any (oneOf ["Warning: Citation"
+                   ,"Warning: There were undefined citations"]) msgs
+  ref = any (oneOf ["Warning: Reference"
+                   ,"Warning: Label"
+                   ,"Warning: There were undefined references"
+                   ,"--toc", "--table-of-contents"]) msgs
+
+checkPackages :: [String] -> [String]
+checkPackages = concatMap chks
+  where -- for each message, search 'pks' for matches and give a hint
+  chks x = concatMap (chk x) pks
+  chk x (k,v) = if sub k `isInfixOf` x then tip k v else []
+  sub k   = "`" ++ k ++ ".sty' not found"
+  tip k v = ["Please install the '" ++ k ++
+             "' package from CTAN:", "  " ++ v]
+  pks = [("ucs"
+         ,"http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/")
+        ,("ulem"
+         ,"http://www.ctan.org/tex-archive/macros/latex/contrib/misc/")
+        ,("graphicx"
+         ,"http://www.ctan.org/tex-archive/macros/latex/required/graphics/")
+        ,("fancyhdr"
+         ,"http://www.ctan.org/tex-archive/macros/latex/contrib/fancyhdr/")
+        ,("array"
+         ,"http://www.ctan.org/tex-archive/macros/latex/required/tools/")]
+
+runBibtex :: FilePath -> IO (Either String FilePath)
+runBibtex file = do
+  let auxFile = replaceExtension file "aux"
+  result <- run "bibtex" [auxFile]
+  return $ either Left (const $ Right auxFile) result
+
+exit :: String -> IO a
+exit x = do
+  progName <- getProgName
+  hPutStrLn stderr $ progName ++ ": " ++ x
+  exitWith $ ExitFailure 1
+
+saveStdin :: FilePath -> IO (Either String FilePath)
+saveStdin file = do
+  text <- getContents
+  writeFile file text
+  fileExist <- doesFileExist file
+  case fileExist of
+    False -> return $ Left $! "Could not create " ++ file
+    True  -> return $ Right file
+
+saveOutput :: FilePath -> FilePath -> IO ()
+saveOutput input output = do
+  outputExist <- doesFileExist output
+  when outputExist $ do
+    let output' = output ++ "~"
+    renameFile output output'
+    putStrLn $! "Created backup file " ++ output'
+  copyFile input output
+  putStrLn $! "Created " ++ output
+
+main :: IO ()
+main = bracket
+  -- acquire resource
+  (do dir <- getTemporaryDirectory
+      let tmp = dir </> "pandoc"
+      createDirectoryIfMissing True tmp
+      return tmp)
+
+  -- release resource
+  ( \tmp -> removeDirectoryRecursive tmp)
+
+  -- run computation
+  $ \tmp -> do
+    -- check for executable files
+    let execs = ["pandoc", "pdflatex", "bibtex"]
+    paths <- mapM findExecutable execs
+    let miss = map snd $ filter (isNothing . fst) $ zip paths execs
+    unless (null miss) $ exit $! "Could not find " ++ intercalate ", " miss
+    -- parse arguments
+    args <- getArgs
+    let badopts = ["-t","-w","--to","--write","-s","--standalone",
+                   "--reference-links","-m","--latexmathml",
+                   "--asciimathml","--mimetex","--jsmath","--gladtex",
+                   "-i","--incremental","--no-wrap", "--sanitize-html",
+                   "--email-obfuscation","-c","--css","-T","--title-prefix",
+                   "-D","--print-default-header","--dump-args",
+                   "--ignore-args","-h","--help","-v","--version"]
+    let badoptsLong = filter (\o -> length o > 2) badopts
+    unless (null (args `intersect` badopts)) $ do
+      (code, out, _err) <- readProcessWithExitCode "pandoc" ["--help"] ""
+      putStrLn "markdown2pdf [OPTIONS] [FILES]"
+      putStrLn $ unlines $ drop 3 $
+                 filter (\l -> not . any (`isInfixOf` l) $ badoptsLong) $
+                 lines out
+      exitWith code
+    pandocArgs <- parsePandocArgs args
+    (inputs, output) <- case pandocArgs of
+      Nothing     -> exit "Could not parse arguments"
+      Just ([],out) -> do
+        stdinFile <- saveStdin (replaceDirectory (takeBaseName out) tmp)
+        case stdinFile of
+          Left err  -> exit err
+          Right f   -> return ([f], out)
+      Just (fs,out) -> return (fs, out)
+    -- run pandoc
+    pandocRes <- runPandoc (args ++ inputs) $ replaceDirectory output tmp
+    case pandocRes of
+      Left err -> exit err
+      Right texFile  -> do
+        -- run pdflatex
+        latexRes <- runLatex texFile
+        case latexRes of
+          Left err      -> exit err
+          Right pdfFile -> do
+            -- save the output creating a backup if necessary
+            saveOutput pdfFile $
+              replaceDirectory pdfFile (takeDirectory output)
+