git.iko.soy/typeable/pandoc
on ca712fe help sign in
typeable/pandoc/src/markdown2pdf.hs
200 lines 7.8 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 Prelude hiding ( putStr, putStrLn, writeFile, readFile, getContents )
13import System.IO.UTF8
14import System.Exit (ExitCode (..), exitWith)
15import System.FilePath
16import System.Directory
17import System.Process (readProcessWithExitCode)
20run :: FilePath -> [String] -> IO (Either String String)
21run file opts = do
22 (code, out, err) <- readProcessWithExitCode file opts ""
23 let msg = out ++ err
24 case code of
25 ExitFailure _ -> return $ Left $! msg
26 ExitSuccess -> return $ Right $! msg
28parsePandocArgs :: [String] -> IO (Maybe ([String], String))
29parsePandocArgs args = do
30 result <- run "pandoc" $ ["--dump-args"] ++ args
31 return $ either (const Nothing) (parse . map trim . lines) result
32 where parse [] = Nothing
33 parse ("-":[]) = Just ([], "stdin") -- no output or input
34 parse ("-":x:xs) = Just (x:xs, dropExtension x) -- no output
35 parse ( x :xs) = Just (xs, dropExtension x) -- at least output
36 --trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
37 trim = takeWhile (/='\r') . dropWhile (=='\r')
39runPandoc :: [String] -> FilePath -> IO (Either String FilePath)
40runPandoc inputs output = do
41 let texFile = replaceExtension output "tex"
42 result <- run "pandoc" $
43 ["-s", "--no-wrap", "-r", "markdown", "-w", "latex"]
44 ++ inputs ++ ["-o", texFile]
45 return $ either Left (const $ Right texFile) result
47runLatexRaw :: FilePath -> IO (Either (Either String String) FilePath)
48runLatexRaw file = do
49 -- we ignore the ExitCode because pdflatex always fails the first time
50 run "pdflatex" ["-interaction=batchmode", "-output-directory",
51 takeDirectory file, dropExtension file] >> return ()
52 let pdfFile = replaceExtension file "pdf"
53 let logFile = replaceExtension file "log"
54 txt <- tryJust (guard . isDoesNotExistError) (readFile logFile)
55 let checks = checkLatex $ either (const "") id txt
56 case checks of
57 -- err , bib , ref , msg
58 (True , _ , _ , msg) -> return $ Left $ Left msg -- failure
59 (False, True , _ , msg) -> runBibtex file >>
60 (return $ Left $ Right msg) -- citations
61 (False, _ , True, msg) -> return $ Left $ Right msg -- references
62 (False, False, False, _ ) -> return $ Right pdfFile -- success
64runLatex :: FilePath -> IO (Either String FilePath)
65runLatex file = step 3
66 where
67 step n = do
68 result <- runLatexRaw file
69 case result of
70 Left (Left err) -> return $ Left err
71 Left (Right _) | n > 1 -> 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 ,"--toc", "--table-of-contents"]) 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 hPutStrLn stderr $ progName ++ ": " ++ x
119 exitWith $ ExitFailure 1
121saveStdin :: FilePath -> IO (Either String FilePath)
122saveStdin file = do
123 text <- getContents
124 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 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 -- check for executable files
149 let execs = ["pandoc", "pdflatex", "bibtex"]
150 paths <- mapM findExecutable execs
151 let miss = map snd $ filter (isNothing . fst) $ zip paths execs
152 unless (null miss) $ exit $! "Could not find " ++ intercalate ", " miss
153 args <- getArgs
154 -- check for invalid arguments and print help message if needed
155 let goodopts = ["-f","-r","-N", "-p","-R","-H","-B","-A", "-C","-o"]
156 let goodoptslong = ["--from","--read","--strict",
157 "--preserve-tabs","--tab-stop","--parse-raw",
158 "--toc","--table-of-contents",
159 "--number-sections","--include-in-header",
160 "--include-before-body","--include-after-body",
161 "--custom-header","--output"]
162 let isOpt ('-':_) = True
163 isOpt _ = False
164 let opts = filter isOpt args
165 -- note that a long option can come in this form: --opt=val
166 let isGoodopt x = x `elem` (goodopts ++ goodoptslong) ||
167 any (\o -> (o ++ "=") `isPrefixOf` x) goodoptslong
168 unless (all isGoodopt opts) $ do
169 (code, out, _err) <- readProcessWithExitCode "pandoc" ["--help"] ""
170 putStrLn "markdown2pdf [OPTIONS] [FILES]\nOptions:"
171 putStr $ unlines $
172 filter (\l -> any (`isInfixOf` l) goodoptslong) $ lines out
173 exitWith code
175 -- parse arguments
176 -- if no input given, use 'stdin'
177 pandocArgs <- parsePandocArgs args
178 (input, output) <- case pandocArgs of
179 Nothing -> exit "Could not parse arguments"
180 Just ([],out) -> do
181 stdinFile <- saveStdin (replaceDirectory (takeBaseName out) tmp)
182 case stdinFile of
183 Left err -> exit err
184 Right f -> return ([f], out)
185 -- no need because we'll pass all arguments to pandoc
186 Just (_ ,out) -> return ([], out)
187 -- run pandoc
188 pandocRes <- runPandoc (input ++ args) $ replaceDirectory output tmp
189 case pandocRes of
190 Left err -> exit err
191 Right texFile -> do
192 -- run pdflatex
193 latexRes <- runLatex texFile
194 case latexRes of
195 Left err -> exit err
196 Right pdfFile -> do
197 -- save the output creating a backup if necessary
198 saveOutput pdfFile $
199 replaceDirectory pdfFile (takeDirectory output)