@@ -1,269 +0,0 @@
1−module Main where
2−
3−import Data.List (isInfixOf, intercalate, isPrefixOf)
4−import Data.Maybe (isNothing)
5−import qualified Data.ByteString as BS
6−import Codec.Binary.UTF8.String (decodeString, encodeString)
7−import Data.ByteString.UTF8 (toString)
8−import Control.Monad (unless, guard, liftM, when)
9−import Control.Concurrent (putMVar, takeMVar, newEmptyMVar, forkIO)
10−import Control.Exception (tryJust, bracket, evaluate)
11−import Control.Monad.Trans (liftIO)
12−import System.IO.Error (isAlreadyExistsError)
13−
14−import System.IO
15−import System.IO.Error (isDoesNotExistError)
16−import System.Environment ( getArgs, getProgName )
17−import qualified Text.Pandoc.UTF8 as UTF8
18−import System.Exit (ExitCode (..), exitWith)
19−import System.FilePath
20−import System.Directory
21−import System.Process
22−
23−-- A variant of 'readProcessWithExitCode' that does not
24−-- cause an error if the output is not UTF-8. (Copied
25−-- with slight variants from 'System.Process'.)
26−readProcessWithExitCode'
27− :: FilePath -- ^ command to run
28− -> [String] -- ^ any arguments
29− -> String -- ^ standard input
30− -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr
31−readProcessWithExitCode' cmd args input = do
32− (Just inh, Just outh, Just errh, pid) <-
33− createProcess (proc cmd args){ std_in = CreatePipe,
34− std_out = CreatePipe,
35− std_err = CreatePipe }
36−
37− outMVar <- newEmptyMVar
38−
39− -- fork off a thread to start consuming stdout
40− out <- liftM toString $ BS.hGetContents outh
41− _ <- forkIO $ evaluate (length out) >> putMVar outMVar ()
42−
43− -- fork off a thread to start consuming stderr
44− err <- liftM toString $ BS.hGetContents errh
45− _ <- forkIO $ evaluate (length err) >> putMVar outMVar ()
46−
47− -- now write and flush any input
48− when (not (null input)) $ do hPutStr inh input; hFlush inh
49− hClose inh -- done with stdin
50−
51− -- wait on the output
52− takeMVar outMVar
53− takeMVar outMVar
54− hClose outh
55−
56− -- wait on the process
57− ex <- waitForProcess pid
58−
59− return (ex, out, err)
60−
61−run :: FilePath -> [String] -> IO (Either String String)
62−run file opts = do
63− (code, out, err) <- readProcessWithExitCode' (encodeString file)
64− (map encodeString opts) ""
65− let msg = out ++ err
66− case code of
67− ExitFailure _ -> return $ Left $! msg
68− ExitSuccess -> return $ Right $! msg
69−
70−parsePandocArgs :: [String] -> IO (Maybe ([String], String))
71−parsePandocArgs args = do
72− result <- run "pandoc" $ ["--dump-args"] ++ args
73− return $ either error (parse . map trim . lines) result
74− where parse [] = Nothing
75− parse ("-":[]) = Just ([], "stdin") -- no output or input
76− parse ("-":x:xs) = Just (x:xs, dropExtension x) -- no output
77− parse ( x :xs) = Just (xs, dropExtension x) -- at least output
78− --trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
79− trim = takeWhile (/='\r') . dropWhile (=='\r')
80−
81−runPandoc :: String -> [String] -> FilePath -> IO (Either String FilePath)
82−runPandoc outputFormat inputsAndArgs output = do
83− let texFile = addExtension output "tex"
84− result <- run "pandoc" $
85− ["-s", "--no-wrap", "-r", "markdown", "-w", outputFormat]
86− ++ inputsAndArgs ++ ["-o", texFile]
87− return $ either Left (const $ Right texFile) result
88−
89−runLatexRaw :: String -> FilePath -> IO (Either (Either String String) FilePath)
90−runLatexRaw latexProgram file = do
91− -- we ignore the ExitCode because pdflatex always fails the first time
92− run latexProgram ["-halt-on-error", "-interaction", "nonstopmode",
93− "-output-directory", takeDirectory file, dropExtension file] >> return ()
94− let pdfFile = replaceExtension file "pdf"
95− let logFile = replaceExtension file "log"
96− txt <- tryJust (guard . isDoesNotExistError)
97− (liftM toString $ BS.readFile logFile)
98− let checks = checkLatex $ either (const "") id txt
99− case checks of
100− -- err , bib , ref , msg
101− (True , _ , _ , msg) -> return $ Left $ Left msg -- failure
102− (False, True , _ , msg) -> runBibtex file >>
103− (return $ Left $ Right msg) -- citations
104− (False, _ , True, msg) -> return $ Left $ Right msg -- references
105− (False, False, False, _ ) -> return $ Right pdfFile -- success
106−
107−runLatex :: String -> FilePath -> IO (Either String FilePath)
108−runLatex latexProgram file = step 3
109− where
110− step n = do
111− result <- runLatexRaw latexProgram file
112− case result of
113− Left (Left err) -> return $ Left err
114− Left (Right _) | n > 1 -> step (n-1 :: Int)
115− Right _ | n > 2 -> step (n-1 :: Int)
116− Left (Right msg) -> return $ Left msg
117− Right pdfFile -> return $ Right pdfFile
118−
119−checkLatex :: String -> (Bool, Bool, Bool, String)
120−checkLatex "" = (True, False, False, "Could not read log file")
121−checkLatex txt = (err , bib, ref, unlines $! msgs ++ tips)
122− where
123− xs `oneOf` x = any (flip isInfixOf x) xs
124− msgs = dropWhile (not . errorline) $ lines txt
125− errorline ('!':_) = True
126− errorline _ = False
127− tips = checkPackages msgs
128− err = any (oneOf ["!", "LaTeX Error:", "Latex Error:"]) msgs
129− bib = any (oneOf ["Warning: Citation"
130− ,"Warning: There were undefined citations"]) msgs
131− ref = any (oneOf ["Warning: Reference"
132− ,"Warning: Label"
133− ,"Warning: There were undefined references"
134− ]) msgs
135−
136−checkPackages :: [String] -> [String]
137−checkPackages = concatMap chks
138− where -- for each message, search 'pks' for matches and give a hint
139− chks x = concatMap (chk x) pks
140− chk x (k,v) = if sub k `isInfixOf` x then tip k v else []
141− sub k = "`" ++ k ++ ".sty' not found"
142− tip k v = ["Please install the '" ++ k ++
143− "' package from CTAN:", " " ++ v]
144− pks = [("ucs"
145− ,"http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/")
146− ,("ulem"
147− ,"http://www.ctan.org/tex-archive/macros/latex/contrib/misc/")
148− ,("graphicx"
149− ,"http://www.ctan.org/tex-archive/macros/latex/required/graphics/")
150− ,("fancyhdr"
151− ,"http://www.ctan.org/tex-archive/macros/latex/contrib/fancyhdr/")
152− ,("array"
153− ,"http://www.ctan.org/tex-archive/macros/latex/required/tools/")]
154−
155−runBibtex :: FilePath -> IO (Either String FilePath)
156−runBibtex file = do
157− let auxFile = replaceExtension file "aux"
158− result <- run "bibtex" [auxFile]
159− return $ either Left (const $ Right auxFile) result
160−
161−exit :: String -> IO a
162−exit x = do
163− progName <- getProgName
164− UTF8.hPutStrLn stderr $ progName ++ ": " ++ x
165− exitWith $ ExitFailure 1
166−
167−saveStdin :: FilePath -> IO (Either String FilePath)
168−saveStdin file = do
169− text <- liftM toString $ BS.getContents
170− UTF8.writeFile file text
171− fileExist <- doesFileExist (encodeString file)
172− case fileExist of
173− False -> return $ Left $! "Could not create " ++ file
174− True -> return $ Right file
175−
176−saveOutput :: FilePath -> FilePath -> IO ()
177−saveOutput input output = do
178− copyFile (encodeString input) (encodeString output)
179− UTF8.hPutStrLn stderr $! "Created " ++ output
180−
181−-- | Perform a function in a temporary directory and clean up.
182−withTempDir :: FilePath -> (FilePath -> IO a) -> IO a
183−withTempDir baseName = bracket (createTempDir 0 baseName) removeDirectoryRecursive
184−
185−-- | Create a temporary directory with a unique name.
186−createTempDir :: Integer -> FilePath -> IO FilePath
187−createTempDir num baseName = do
188− sysTempDir <- getTemporaryDirectory
189− let dirName = sysTempDir </> baseName <.> show num
190− liftIO $ catch (createDirectory dirName >> return dirName) $
191− \e -> if isAlreadyExistsError e
192− then createTempDir (num + 1) baseName
193− else ioError e
194−
195−main :: IO ()
196−main = withTempDir "pandoc"
197− -- run computation
198− $ \tmp -> do
199− args <- liftM (map decodeString) getArgs
200− -- check for invalid arguments and print help message if needed
201− let goodopts = ["-f","-r","-N", "-p","-R","-H","-B","-A", "-C","-o","-V"]
202− let goodoptslong = ["--from","--read","--strict",
203− "--preserve-tabs","--tab-stop","--parse-raw",
204− "--toc","--table-of-contents", "--xetex", "--luatex",
205− "--number-sections","--include-in-header",
206− "--include-before-body","--include-after-body",
207− "--custom-header","--output",
208− "--template", "--variable",
209− "--no-highlight", "--highlight-style",
210− "--citation-abbreviations", "--old-dashes",
211− "--csl", "--bibliography", "--data-dir", "--listings",
212− "--beamer"]
213− let isOpt ('-':_) = True
214− isOpt _ = False
215− let opts = filter isOpt args
216− -- note that a long option can come in this form: --opt=val
217− let isGoodopt x = x `elem` (goodopts ++ goodoptslong) ||
218− any (\o -> (o ++ "=") `isPrefixOf` x) goodoptslong
219− let markdown2pdfOpts = ["--xetex","--luatex", "--beamer"]
220− unless (all isGoodopt opts) $ do
221− (code, out, _err) <- readProcessWithExitCode "pandoc" ["--help"] ""
222− UTF8.putStrLn "markdown2pdf [OPTIONS] [FILES]\nOptions:"
223− UTF8.putStr $ unlines $
224− filter (\l -> any (`isInfixOf` l) goodoptslong) (lines out)
225− ++ map (replicate 24 ' ' ++) markdown2pdfOpts
226− exitWith code
227−
228− let args' = filter (`notElem` markdown2pdfOpts) args
229−
230− -- check for executable files
231− let latexProgram = if "--xetex" `elem` opts
232− then "xelatex"
233− else if "--luatex" `elem` opts
234− then "lualatex"
235− else "pdflatex"
236− let outputFormat = if "--beamer" `elem` opts
237− then "beamer"
238− else "latex"
239− let execs = ["pandoc", latexProgram, "bibtex"]
240− paths <- mapM findExecutable execs
241− let miss = map snd $ filter (isNothing . fst) $ zip paths execs
242− unless (null miss) $ exit $! "Could not find " ++ intercalate ", " miss
243−
244− -- parse arguments
245− -- if no input given, use 'stdin'
246− pandocArgs <- parsePandocArgs args'
247− (input, output) <- case pandocArgs of
248− Nothing -> exit "Could not parse arguments"
249− Just ([],out) -> do
250− stdinFile <- saveStdin (replaceDirectory (takeBaseName out) tmp)
251− case stdinFile of
252− Left err -> exit err
253− Right f -> return ([f], out)
254− -- no need because we'll pass all arguments to pandoc
255− Just (_ ,out) -> return ([], out)
256− -- run pandoc
257− pandocRes <- runPandoc outputFormat (input ++ args') $ replaceDirectory output tmp
258− case pandocRes of
259− Left err -> exit err
260− Right texFile -> do
261− -- run pdflatex
262− latexRes <- runLatex latexProgram texFile
263− case latexRes of
264− Left err -> exit err
265− Right pdfFile -> do
266− -- save the output
267− saveOutput pdfFile $
268− replaceDirectory pdfFile (takeDirectory output)
269−