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