diff options
| -rw-r--r-- | src/markdown2pdf.hs | 195 | ||||
| -rw-r--r-- | src/pandoc.hs | 3 |
2 files changed, 196 insertions, 2 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) + diff --git a/src/pandoc.hs b/src/pandoc.hs index 3887a952f..b4f54b7c1 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -570,7 +570,7 @@ main = do Just cols -> read cols Nothing -> stateColumns defaultParserState - let standalone' = (standalone && not strict) || isNonTextOutput writerName' + let standalone' = standalone || isNonTextOutput writerName' #ifdef _CITEPROC refs <- if null biblioFile then return [] else readBiblioFile biblioFile biblioFormat @@ -604,7 +604,6 @@ main = do writerTitlePrefix = titlePrefix, writerTabStop = tabStop, writerTableOfContents = toc && - not strict && writerName' /= "s5", writerHTMLMathMethod = mathMethod, writerS5 = (writerName' == "s5"), |