pandoc.hs: Make --strict compatible with --standalone, --toc.
git-svn-id: https://pandoc.googlecode.com/svn/trunk@1572 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
fiddlosopher
parent
c584e48168
commit
2d5f718048
2 changed files with 196 additions and 2 deletions
195
src/markdown2pdf.hs
Normal file
195
src/markdown2pdf.hs
Normal file
|
|
@ -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)
|
||||
|
||||
|
|
@ -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"),
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue