git.iko.soy/typeable/pandoc
on 283f1e6 help sign in
typeable/pandoc/src/markdown2pdf.hs
206 lines 8.1 kB history raw
1module Main where
3import Data.List (isInfixOf, intercalate, isPrefixOf)
4import Data.Maybe (isNothing)
6import Control.Monad (unless, guard)
7import Control.Exception (tryJust, bracket)
9import System.IO (stderr)
10import System.IO.Error (isDoesNotExistError)
11import System.Environment ( getArgs, getProgName )
12import qualified Text.Pandoc.UTF8 as UTF8
13import System.Exit (ExitCode (..), exitWith)
14import System.FilePath
15import System.Directory
16import System.Process (readProcessWithExitCode)
19run :: FilePath -> [String] -> IO (Either String String)
20run file opts = do
21 (code, out, err) <- readProcessWithExitCode file opts ""
22 let msg = out ++ err
23 case code of
24 ExitFailure _ -> return $ Left $! msg
25 ExitSuccess -> return $ Right $! msg
27parsePandocArgs :: [String] -> IO (Maybe ([String], String))
28parsePandocArgs args = do
29 result <- run "pandoc" $ ["--dump-args"] ++ args
30 return $ either error (parse . map trim . lines) result
31 where parse [] = Nothing
32 parse ("-":[]) = Just ([], "stdin") -- no output or input
33 parse ("-":x:xs) = Just (x:xs, dropExtension x) -- no output
34 parse ( x :xs) = Just (xs, dropExtension x) -- at least output
35 --trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
36 trim = takeWhile (/='\r') . dropWhile (=='\r')
38runPandoc :: [String] -> FilePath -> IO (Either String FilePath)
39runPandoc inputsAndArgs output = do
40 let texFile = replaceExtension output "tex"
41 result <- run "pandoc" $
42 ["-s", "--no-wrap", "-r", "markdown", "-w", "latex"]
43 ++ inputsAndArgs ++ ["-o", texFile]
44 return $ either Left (const $ Right texFile) result
46runLatexRaw :: String -> FilePath -> IO (Either (Either String String) FilePath)
47runLatexRaw latexProgram file = do
48 -- we ignore the ExitCode because pdflatex always fails the first time
49 run latexProgram ["-interaction=batchmode", "-output-directory",
50 takeDirectory file, dropExtension file] >> return ()
51 let pdfFile = replaceExtension file "pdf"
52 let logFile = replaceExtension file "log"
53 txt <- tryJust (guard . isDoesNotExistError) (UTF8.readFile logFile)
54 let checks = checkLatex $ either (const "") id txt
55 case checks of
56 -- err , bib , ref , msg
57 (True , _ , _ , msg) -> return $ Left $ Left msg -- failure
58 (False, True , _ , msg) -> runBibtex file >>
59 (return $ Left $ Right msg) -- citations
60 (False, _ , True, msg) -> return $ Left $ Right msg -- references
61 (False, False, False, _ ) -> return $ Right pdfFile -- success
63runLatex :: String -> FilePath -> IO (Either String FilePath)
64runLatex latexProgram file = step 3
65 where
66 step n = do
67 result <- runLatexRaw latexProgram file
68 case result of
69 Left (Left err) -> return $ Left err
70 Left (Right _) | n > 1 -> step (n-1 :: Int)
71 Right _ | n > 2 -> step (n-1 :: Int)
72 Left (Right msg) -> return $ Left msg
73 Right pdfFile -> return $ Right pdfFile
75checkLatex :: String -> (Bool, Bool, Bool, String)
76checkLatex "" = (True, False, False, "Could not read log file")
77checkLatex txt = (err , bib, ref, unlines $! msgs ++ tips)
78 where
79 xs `oneOf` x = any (flip isInfixOf x) xs
80 msgs = filter (oneOf ["Error:", "Warning:"]) (lines txt)
81 tips = checkPackages msgs
82 err = any (oneOf ["!", "LaTeX Error:", "Latex Error:"]) msgs
83 bib = any (oneOf ["Warning: Citation"
84 ,"Warning: There were undefined citations"]) msgs
85 ref = any (oneOf ["Warning: Reference"
86 ,"Warning: Label"
87 ,"Warning: There were undefined references"
88 ]) msgs
90checkPackages :: [String] -> [String]
91checkPackages = concatMap chks
92 where -- for each message, search 'pks' for matches and give a hint
93 chks x = concatMap (chk x) pks
94 chk x (k,v) = if sub k `isInfixOf` x then tip k v else []
95 sub k = "`" ++ k ++ ".sty' not found"
96 tip k v = ["Please install the '" ++ k ++
97 "' package from CTAN:", " " ++ v]
98 pks = [("ucs"
99 ,"http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/")
100 ,("ulem"
101 ,"http://www.ctan.org/tex-archive/macros/latex/contrib/misc/")
102 ,("graphicx"
103 ,"http://www.ctan.org/tex-archive/macros/latex/required/graphics/")
104 ,("fancyhdr"
105 ,"http://www.ctan.org/tex-archive/macros/latex/contrib/fancyhdr/")
106 ,("array"
107 ,"http://www.ctan.org/tex-archive/macros/latex/required/tools/")]
109runBibtex :: FilePath -> IO (Either String FilePath)
110runBibtex file = do
111 let auxFile = replaceExtension file "aux"
112 result <- run "bibtex" [auxFile]
113 return $ either Left (const $ Right auxFile) result
115exit :: String -> IO a
116exit x = do
117 progName <- getProgName
118 UTF8.hPutStrLn stderr $ progName ++ ": " ++ x
119 exitWith $ ExitFailure 1
121saveStdin :: FilePath -> IO (Either String FilePath)
122saveStdin file = do
123 text <- UTF8.getContents
124 UTF8.writeFile file text
125 fileExist <- doesFileExist file
126 case fileExist of
127 False -> return $ Left $! "Could not create " ++ file
128 True -> return $ Right file
130saveOutput :: FilePath -> FilePath -> IO ()
131saveOutput input output = do
132 copyFile input output
133 UTF8.hPutStrLn stderr $! "Created " ++ output
135main :: IO ()
136main = bracket
137 -- acquire resource
138 (do dir <- getTemporaryDirectory
139 let tmp = dir </> "pandoc"
140 createDirectoryIfMissing True tmp
141 return tmp)
143 -- release resource
144 ( \tmp -> removeDirectoryRecursive tmp)
146 -- run computation
147 $ \tmp -> do
148 args <- getArgs
149 -- check for invalid arguments and print help message if needed
150 let goodopts = ["-f","-r","-N", "-p","-R","-H","-B","-A", "-C","-o","-V"]
151 let goodoptslong = ["--from","--read","--strict",
152 "--preserve-tabs","--tab-stop","--parse-raw",
153 "--toc","--table-of-contents", "--xetex",
154 "--number-sections","--include-in-header",
155 "--include-before-body","--include-after-body",
156 "--custom-header","--output",
157 "--template", "--variable",
158 "--csl", "--biblio", "--biblio-format"]
159 let isOpt ('-':_) = True
160 isOpt _ = False
161 let opts = filter isOpt args
162 -- note that a long option can come in this form: --opt=val
163 let isGoodopt x = x `elem` (goodopts ++ goodoptslong) ||
164 any (\o -> (o ++ "=") `isPrefixOf` x) goodoptslong
165 unless (all isGoodopt opts) $ do
166 (code, out, _err) <- readProcessWithExitCode "pandoc" ["--help"] ""
167 UTF8.putStrLn "markdown2pdf [OPTIONS] [FILES]\nOptions:"
168 UTF8.putStr $ unlines $
169 filter (\l -> any (`isInfixOf` l) goodoptslong) $ lines out
170 exitWith code
172 -- check for executable files
173 let latexProgram = if "--xetex" `elem` opts
174 then "xelatex"
175 else "pdflatex"
176 let execs = ["pandoc", latexProgram, "bibtex"]
177 paths <- mapM findExecutable execs
178 let miss = map snd $ filter (isNothing . fst) $ zip paths execs
179 unless (null miss) $ exit $! "Could not find " ++ intercalate ", " miss
181 -- parse arguments
182 -- if no input given, use 'stdin'
183 pandocArgs <- parsePandocArgs args
184 (input, output) <- case pandocArgs of
185 Nothing -> exit "Could not parse arguments"
186 Just ([],out) -> do
187 stdinFile <- saveStdin (replaceDirectory (takeBaseName out) tmp)
188 case stdinFile of
189 Left err -> exit err
190 Right f -> return ([f], out)
191 -- no need because we'll pass all arguments to pandoc
192 Just (_ ,out) -> return ([], out)
193 -- run pandoc
194 pandocRes <- runPandoc (input ++ args) $ replaceDirectory output tmp
195 case pandocRes of
196 Left err -> exit err
197 Right texFile -> do
198 -- run pdflatex
199 latexRes <- runLatex latexProgram texFile
200 case latexRes of
201 Left err -> exit err
202 Right pdfFile -> do
203 -- save the output creating a backup if necessary
204 saveOutput pdfFile $
205 replaceDirectory pdfFile (takeDirectory output)