git.iko.soy/typeable/pandoc
on ca2bbaf help sign in
typeable/pandoc/src/markdown2pdf.hs
211 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)
15#else
16import Prelude hiding ( putStr, putStrLn, writeFile, readFile, getContents )
17import System.IO.UTF8
18#endif
19import System.IO (hPutStrLn)
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 (const Nothing) (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 inputs output = do
47 let texFile = replaceExtension output "tex"
48 result <- run "pandoc" $
49 ["-s", "--no-wrap", "-r", "markdown", "-w", "latex"]
50 ++ inputs ++ ["-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 Left (Right msg) -> return $ Left msg
79 Right pdfFile -> return $ Right pdfFile
81checkLatex :: String -> (Bool, Bool, Bool, String)
82checkLatex "" = (True, False, False, "Could not read log file")
83checkLatex txt = (err , bib, ref, unlines $! msgs ++ tips)
84 where
85 xs `oneOf` x = any (flip isInfixOf x) xs
86 msgs = filter (oneOf ["Error:", "Warning:"]) (lines txt)
87 tips = checkPackages msgs
88 err = any (oneOf ["!", "LaTeX Error:", "Latex Error:"]) msgs
89 bib = any (oneOf ["Warning: Citation"
90 ,"Warning: There were undefined citations"]) msgs
91 ref = any (oneOf ["Warning: Reference"
92 ,"Warning: Label"
93 ,"Warning: There were undefined references"
94 ,"--toc", "--table-of-contents"]) msgs
96checkPackages :: [String] -> [String]
97checkPackages = concatMap chks
98 where -- for each message, search 'pks' for matches and give a hint
99 chks x = concatMap (chk x) pks
100 chk x (k,v) = if sub k `isInfixOf` x then tip k v else []
101 sub k = "`" ++ k ++ ".sty' not found"
102 tip k v = ["Please install the '" ++ k ++
103 "' package from CTAN:", " " ++ v]
104 pks = [("ucs"
105 ,"http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/")
106 ,("ulem"
107 ,"http://www.ctan.org/tex-archive/macros/latex/contrib/misc/")
108 ,("graphicx"
109 ,"http://www.ctan.org/tex-archive/macros/latex/required/graphics/")
110 ,("fancyhdr"
111 ,"http://www.ctan.org/tex-archive/macros/latex/contrib/fancyhdr/")
112 ,("array"
113 ,"http://www.ctan.org/tex-archive/macros/latex/required/tools/")]
115runBibtex :: FilePath -> IO (Either String FilePath)
116runBibtex file = do
117 let auxFile = replaceExtension file "aux"
118 result <- run "bibtex" [auxFile]
119 return $ either Left (const $ Right auxFile) result
121exit :: String -> IO a
122exit x = do
123 progName <- getProgName
124 hPutStrLn stderr $ progName ++ ": " ++ x
125 exitWith $ ExitFailure 1
127saveStdin :: FilePath -> IO (Either String FilePath)
128saveStdin file = do
129 text <- getContents
130 writeFile file text
131 fileExist <- doesFileExist file
132 case fileExist of
133 False -> return $ Left $! "Could not create " ++ file
134 True -> return $ Right file
136saveOutput :: FilePath -> FilePath -> IO ()
137saveOutput input output = do
138 copyFile input output
139 hPutStrLn stderr $! "Created " ++ output
141main :: IO ()
142main = bracket
143 -- acquire resource
144 (do dir <- getTemporaryDirectory
145 let tmp = dir </> "pandoc"
146 createDirectoryIfMissing True tmp
147 return tmp)
149 -- release resource
150 ( \tmp -> removeDirectoryRecursive tmp)
152 -- run computation
153 $ \tmp -> do
154 args <- getArgs
155 -- check for invalid arguments and print help message if needed
156 let goodopts = ["-f","-r","-N", "-p","-R","-H","-B","-A", "-C","-o","-V"]
157 let goodoptslong = ["--from","--read","--strict",
158 "--preserve-tabs","--tab-stop","--parse-raw",
159 "--toc","--table-of-contents", "--xetex",
160 "--number-sections","--include-in-header",
161 "--include-before-body","--include-after-body",
162 "--custom-header","--output",
163 "--template", "--variable"]
164 let isOpt ('-':_) = True
165 isOpt _ = False
166 let opts = filter isOpt args
167 -- note that a long option can come in this form: --opt=val
168 let isGoodopt x = x `elem` (goodopts ++ goodoptslong) ||
169 any (\o -> (o ++ "=") `isPrefixOf` x) goodoptslong
170 unless (all isGoodopt opts) $ do
171 (code, out, _err) <- readProcessWithExitCode "pandoc" ["--help"] ""
172 putStrLn "markdown2pdf [OPTIONS] [FILES]\nOptions:"
173 putStr $ unlines $
174 filter (\l -> any (`isInfixOf` l) goodoptslong) $ lines out
175 exitWith code
177 -- check for executable files
178 let latexProgram = if "--xetex" `elem` opts
179 then "xelatex"
180 else "pdflatex"
181 let execs = ["pandoc", latexProgram, "bibtex"]
182 paths <- mapM findExecutable execs
183 let miss = map snd $ filter (isNothing . fst) $ zip paths execs
184 unless (null miss) $ exit $! "Could not find " ++ intercalate ", " miss
186 -- parse arguments
187 -- if no input given, use 'stdin'
188 pandocArgs <- parsePandocArgs args
189 (input, output) <- case pandocArgs of
190 Nothing -> exit "Could not parse arguments"
191 Just ([],out) -> do
192 stdinFile <- saveStdin (replaceDirectory (takeBaseName out) tmp)
193 case stdinFile of
194 Left err -> exit err
195 Right f -> return ([f], out)
196 -- no need because we'll pass all arguments to pandoc
197 Just (_ ,out) -> return ([], out)
198 -- run pandoc
199 pandocRes <- runPandoc (input ++ args) $ replaceDirectory output tmp
200 case pandocRes of
201 Left err -> exit err
202 Right texFile -> do
203 -- run pdflatex
204 latexRes <- runLatex latexProgram texFile
205 case latexRes of
206 Left err -> exit err
207 Right pdfFile -> do
208 -- save the output creating a backup if necessary
209 saveOutput pdfFile $
210 replaceDirectory pdfFile (takeDirectory output)