module Main where
import Data.List (isInfixOf, intercalate, isPrefixOf)
import Data.Maybe (isNothing)
import Control.Monad (unless, guard)
import Control.Exception (tryJust, bracket)
import System.IO (stderr)
import System.IO.Error (isDoesNotExistError)
import System.Environment ( getArgs, getProgName )
#if MIN_VERSION_base(4,2,0)
import System.IO (hPutStrLn)
#else
import Prelude hiding ( putStr, putStrLn, writeFile, readFile, getContents )
import System.IO.UTF8
#endif
import System.Exit (ExitCode (..), exitWith)
import System.FilePath
import System.Directory
import System.Process (readProcessWithExitCode)
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 error (parse . map trim . lines) result
where parse [] = Nothing
parse ("-":[]) = Just ([], "stdin")
parse ("-":x:xs) = Just (x:xs, dropExtension x)
parse ( x :xs) = Just (xs, dropExtension x)
trim = takeWhile (/='\r') . dropWhile (=='\r')
runPandoc :: [String] -> FilePath -> IO (Either String FilePath)
runPandoc inputsAndArgs output = do
let texFile = replaceExtension output "tex"
result <- run "pandoc" $
["-s", "--no-wrap", "-r", "markdown", "-w", "latex"]
++ inputsAndArgs ++ ["-o", texFile]
return $ either Left (const $ Right texFile) result
runLatexRaw :: String -> FilePath -> IO (Either (Either String String) FilePath)
runLatexRaw latexProgram file = do
run latexProgram ["-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
(True , _ , _ , msg) -> return $ Left $ Left msg
(False, True , _ , msg) -> runBibtex file >>
(return $ Left $ Right msg)
(False, _ , True, msg) -> return $ Left $ Right msg
(False, False, False, _ ) -> return $ Right pdfFile
runLatex :: String -> FilePath -> IO (Either String FilePath)
runLatex latexProgram file = step 3
where
step n = do
result <- runLatexRaw latexProgram file
case result of
Left (Left err) -> return $ Left err
Left (Right _) | n > 1 -> step (n1 :: Int)
Right _ | n > 2 -> step (n1 :: Int)
Left (Right msg) -> return $ Left msg
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"
]) msgs
checkPackages :: [String] -> [String]
checkPackages = concatMap chks
where
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
copyFile input output
hPutStrLn stderr $! "Created " ++ output
main :: IO ()
main = bracket
(do dir <- getTemporaryDirectory
let tmp = dir </> "pandoc"
createDirectoryIfMissing True tmp
return tmp)
( \tmp -> removeDirectoryRecursive tmp)
$ \tmp -> do
args <- getArgs
let goodopts = ["-f","-r","-N", "-p","-R","-H","-B","-A", "-C","-o","-V"]
let goodoptslong = ["--from","--read","--strict",
"--preserve-tabs","--tab-stop","--parse-raw",
"--toc","--table-of-contents", "--xetex",
"--number-sections","--include-in-header",
"--include-before-body","--include-after-body",
"--custom-header","--output",
"--template", "--variable"]
let isOpt ('-':_) = True
isOpt _ = False
let opts = filter isOpt args
let isGoodopt x = x `elem` (goodopts ++ goodoptslong) ||
any (\o -> (o ++ "=") `isPrefixOf` x) goodoptslong
unless (all isGoodopt opts) $ do
(code, out, _err) <- readProcessWithExitCode "pandoc" ["--help"] ""
putStrLn "markdown2pdf [OPTIONS] [FILES]\nOptions:"
putStr $ unlines $
filter (\l -> any (`isInfixOf` l) goodoptslong) $ lines out
exitWith code
let latexProgram = if "--xetex" `elem` opts
then "xelatex"
else "pdflatex"
let execs = ["pandoc", latexProgram, "bibtex"]
paths <- mapM findExecutable execs
let miss = map snd $ filter (isNothing . fst) $ zip paths execs
unless (null miss) $ exit $! "Could not find " ++ intercalate ", " miss
pandocArgs <- parsePandocArgs args
(input, 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 (_ ,out) -> return ([], out)
pandocRes <- runPandoc (input ++ args) $ replaceDirectory output tmp
case pandocRes of
Left err -> exit err
Right texFile -> do
latexRes <- runLatex latexProgram texFile
case latexRes of
Left err -> exit err
Right pdfFile -> do
saveOutput pdfFile $
replaceDirectory pdfFile (takeDirectory output)