@@ -0,0 +1,195 @@
1+module Main where
2+
3+import Data.List (isInfixOf, intercalate, intersect)
4+import Data.Maybe (isNothing)
5+
6+import Control.Monad (when, unless, guard)
7+import Control.Exception (tryJust, bracket)
8+
9+import System.IO (stderr, hPutStrLn)
10+import System.IO.Error (isDoesNotExistError)
11+import System.Exit (ExitCode (..), exitWith)
12+import System.FilePath
13+import System.Directory
14+import System.Process (readProcessWithExitCode)
15+import System.Environment (getArgs, getProgName)
16+
17+
18+run :: FilePath -> [String] -> IO (Either String String)
19+run file opts = do
20+ (code, out, err) <- readProcessWithExitCode file opts ""
21+ let msg = out ++ err
22+ case code of
23+ ExitFailure _ -> return $ Left $! msg
24+ ExitSuccess -> return $ Right $! msg
25+
26+parsePandocArgs :: [String] -> IO (Maybe ([String], String))
27+parsePandocArgs args = do
28+ result <- run "pandoc" $ ["--dump-args"] ++ args
29+ return $ either (const Nothing) (parse . map trim . lines) result
30+ where parse [] = Nothing
31+ parse ("-":[]) = Just ([], "stdin") -- no output or input
32+ parse ("-":x:xs) = Just (x:xs, dropExtension x) -- no output
33+ parse ( x :xs) = Just (xs, dropExtension x) -- at least output
34+ --trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
35+ trim = takeWhile (/='\r') . dropWhile (=='\r')
36+
37+runPandoc :: [String] -> FilePath -> IO (Either String FilePath)
38+runPandoc inputs output = do
39+ let texFile = replaceExtension output "tex"
40+ result <- run "pandoc" $
41+ ["-s", "--no-wrap", "-r", "markdown", "-w", "latex"]
42+ ++ inputs ++ ["-o", texFile]
43+ return $ either Left (const $ Right texFile) result
44+
45+runLatexRaw :: FilePath -> IO (Either (Either String String) FilePath)
46+runLatexRaw file = do
47+ -- we ignore the ExitCode because pdflatex always fails the first time
48+ run "pdflatex" ["-interaction=batchmode", "-output-directory",
49+ takeDirectory file, dropExtension file] >> return ()
50+ let pdfFile = replaceExtension file "pdf"
51+ let logFile = replaceExtension file "log"
52+ txt <- tryJust (guard . isDoesNotExistError) (readFile logFile)
53+ let checks = checkLatex $ either (const "") id txt
54+ case checks of
55+ -- err , bib , ref , msg
56+ (True , _ , _ , msg) -> return $ Left $ Left msg -- failure
57+ (False, True , _ , msg) -> runBibtex file >>
58+ (return $ Left $ Right msg) -- citations
59+ (False, _ , True, msg) -> return $ Left $ Right msg -- references
60+ (False, False, False, _ ) -> return $ Right pdfFile -- success
61+
62+runLatex :: FilePath -> IO (Either String FilePath)
63+runLatex file = step 3
64+ where
65+ step 0 = return $ Left "Limit of attempts reached"
66+ step n = do
67+ result <- runLatexRaw file
68+ case result of
69+ Left (Left err) -> return $ Left err
70+ Left (Right _ ) -> step (n-1 :: Int)
71+ Right pdfFile -> return $ Right pdfFile
72+
73+checkLatex :: String -> (Bool, Bool, Bool, String)
74+checkLatex "" = (True, False, False, "Could not read log file")
75+checkLatex txt = (err , bib, ref, unlines $! msgs ++ tips)
76+ where
77+ xs `oneOf` x = any (flip isInfixOf x) xs
78+ msgs = filter (oneOf ["Error:", "Warning:"]) (lines txt)
79+ tips = checkPackages msgs
80+ err = any (oneOf ["LaTeX Error:", "Latex Error:"]) msgs
81+ bib = any (oneOf ["Warning: Citation"
82+ ,"Warning: There were undefined citations"]) msgs
83+ ref = any (oneOf ["Warning: Reference"
84+ ,"Warning: Label"
85+ ,"Warning: There were undefined references"
86+ ,"--toc", "--table-of-contents"]) msgs
87+
88+checkPackages :: [String] -> [String]
89+checkPackages = concatMap chks
90+ where -- for each message, search 'pks' for matches and give a hint
91+ chks x = concatMap (chk x) pks
92+ chk x (k,v) = if sub k `isInfixOf` x then tip k v else []
93+ sub k = "`" ++ k ++ ".sty' not found"
94+ tip k v = ["Please install the '" ++ k ++
95+ "' package from CTAN:", " " ++ v]
96+ pks = [("ucs"
97+ ,"http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/")
98+ ,("ulem"
99+ ,"http://www.ctan.org/tex-archive/macros/latex/contrib/misc/")
100+ ,("graphicx"
101+ ,"http://www.ctan.org/tex-archive/macros/latex/required/graphics/")
102+ ,("fancyhdr"
103+ ,"http://www.ctan.org/tex-archive/macros/latex/contrib/fancyhdr/")
104+ ,("array"
105+ ,"http://www.ctan.org/tex-archive/macros/latex/required/tools/")]
106+
107+runBibtex :: FilePath -> IO (Either String FilePath)
108+runBibtex file = do
109+ let auxFile = replaceExtension file "aux"
110+ result <- run "bibtex" [auxFile]
111+ return $ either Left (const $ Right auxFile) result
112+
113+exit :: String -> IO a
114+exit x = do
115+ progName <- getProgName
116+ hPutStrLn stderr $ progName ++ ": " ++ x
117+ exitWith $ ExitFailure 1
118+
119+saveStdin :: FilePath -> IO (Either String FilePath)
120+saveStdin file = do
121+ text <- getContents
122+ writeFile file text
123+ fileExist <- doesFileExist file
124+ case fileExist of
125+ False -> return $ Left $! "Could not create " ++ file
126+ True -> return $ Right file
127+
128+saveOutput :: FilePath -> FilePath -> IO ()
129+saveOutput input output = do
130+ outputExist <- doesFileExist output
131+ when outputExist $ do
132+ let output' = output ++ "~"
133+ renameFile output output'
134+ putStrLn $! "Created backup file " ++ output'
135+ copyFile input output
136+ putStrLn $! "Created " ++ output
137+
138+main :: IO ()
139+main = bracket
140+ -- acquire resource
141+ (do dir <- getTemporaryDirectory
142+ let tmp = dir </> "pandoc"
143+ createDirectoryIfMissing True tmp
144+ return tmp)
145+
146+ -- release resource
147+ ( \tmp -> removeDirectoryRecursive tmp)
148+
149+ -- run computation
150+ $ \tmp -> do
151+ -- check for executable files
152+ let execs = ["pandoc", "pdflatex", "bibtex"]
153+ paths <- mapM findExecutable execs
154+ let miss = map snd $ filter (isNothing . fst) $ zip paths execs
155+ unless (null miss) $ exit $! "Could not find " ++ intercalate ", " miss
156+ -- parse arguments
157+ args <- getArgs
158+ let badopts = ["-t","-w","--to","--write","-s","--standalone",
159+ "--reference-links","-m","--latexmathml",
160+ "--asciimathml","--mimetex","--jsmath","--gladtex",
161+ "-i","--incremental","--no-wrap", "--sanitize-html",
162+ "--email-obfuscation","-c","--css","-T","--title-prefix",
163+ "-D","--print-default-header","--dump-args",
164+ "--ignore-args","-h","--help","-v","--version"]
165+ let badoptsLong = filter (\o -> length o > 2) badopts
166+ unless (null (args `intersect` badopts)) $ do
167+ (code, out, _err) <- readProcessWithExitCode "pandoc" ["--help"] ""
168+ putStrLn "markdown2pdf [OPTIONS] [FILES]"
169+ putStrLn $ unlines $ drop 3 $
170+ filter (\l -> not . any (`isInfixOf` l) $ badoptsLong) $
171+ lines out
172+ exitWith code
173+ pandocArgs <- parsePandocArgs args
174+ (inputs, output) <- case pandocArgs of
175+ Nothing -> exit "Could not parse arguments"
176+ Just ([],out) -> do
177+ stdinFile <- saveStdin (replaceDirectory (takeBaseName out) tmp)
178+ case stdinFile of
179+ Left err -> exit err
180+ Right f -> return ([f], out)
181+ Just (fs,out) -> return (fs, out)
182+ -- run pandoc
183+ pandocRes <- runPandoc (args ++ inputs) $ replaceDirectory output tmp
184+ case pandocRes of
185+ Left err -> exit err
186+ Right texFile -> do
187+ -- run pdflatex
188+ latexRes <- runLatex texFile
189+ case latexRes of
190+ Left err -> exit err
191+ Right pdfFile -> do
192+ -- save the output creating a backup if necessary
193+ saveOutput pdfFile $
194+ replaceDirectory pdfFile (takeDirectory output)
195+