4d98815 · typeable/pandoc

42import System.Console.GetOpt

43import Data.Char ( toLower )

44import Data.List ( intercalate, isSuffixOf, isPrefixOf )

45−import System.Directory ( getAppUserDataDirectory, doesFileExist )

45+import System.Directory ( getAppUserDataDirectory, doesFileExist, findExecutable )

46import System.IO ( stdout, stderr )

47import System.IO.Error ( isDoesNotExistError )

48import Control.Exception.Extensible ( throwIO )

217 (\arg opt ->

218 case reads arg of

219 [(t,"")] | t > 0 -> return opt { optTabStop = t }

220− _ -> do

220+ _ -> err 31

221− UTF8.hPutStrLn stderr $

222− "tab-stop must be a number greater than 0"

221+ "tab-stop must be a number greater than 0")

223− exitWith $ ExitFailure 31)

224 "NUMBER")

222 "NUMBER")

225 "" -- "Tab stop (default 4)"

223 "" -- "Tab stop (default 4)"

226

224

259 , Option "5" ["html5"]

257 , Option "5" ["html5"]

260 (NoArg

258 (NoArg

261 (\opt -> do

259 (\opt -> do

262− UTF8.hPutStrLn stderr $ "pandoc: --html5 is deprecated. "

260+ warn $ "pandoc: --html5 is deprecated. "

263 ++ "Use the html5 output format instead."

261 ++ "Use the html5 output format instead."

264 return opt { optHtml5 = True }))

262 return opt { optHtml5 = True }))

265 "" -- "Produce HTML5 in HTML output"

263 "" -- "Produce HTML5 in HTML output"

279 "kate" -> return kate

277 "kate" -> return kate

280 "monochrome" -> return monochrome

278 "monochrome" -> return monochrome

281 "haddock" -> return haddock

279 "haddock" -> return haddock

282− _ -> UTF8.hPutStrLn stderr

280+ _ -> err 39 $

283− ("Unknown style: " ++ arg) >>

281+ "Unknown style :" ++ arg

284− exitWith (ExitFailure 39)

285 return opt{ optHighlightStyle = newStyle })

282 return opt{ optHighlightStyle = newStyle })

286 "STYLE")

283 "STYLE")

287 "" -- "Style for highlighted code"

284 "" -- "Style for highlighted code"

364 , Option "" ["xetex"]

361 , Option "" ["xetex"]

365 (NoArg

362 (NoArg

366 (\opt -> do

363 (\opt -> do

367− UTF8.hPutStrLn stderr $ "pandoc: --xetex is deprecated. "

364+ warn $ "pandoc: --xetex is deprecated. "

368 ++ "It is no longer needed for use with XeTeX."

365 ++ "It is no longer needed for use with XeTeX."

369 return opt { optXeTeX = True }))

366 return opt { optXeTeX = True }))

370 "" -- "Format latex for processing by XeTeX"

367 "" -- "Format latex for processing by XeTeX"

399 (\arg opt ->

396 (\arg opt ->

400 case reads arg of

397 case reads arg of

401 [(t,"")] | t > 0 -> return opt { optColumns = t }

398 [(t,"")] | t > 0 -> return opt { optColumns = t }

402− _ -> do

399+ _ -> err 33 $

403− UTF8.hPutStrLn stderr $

404− "columns must be a number greater than 0"

400+ "columns must be a number greater than 0")

405− exitWith $ ExitFailure 33)

406 "NUMBER")

401 "NUMBER")

407 "" -- "Length of line in characters"

402 "" -- "Length of line in characters"

408

403

413 "references" -> return ReferenceObfuscation

408 "references" -> return ReferenceObfuscation

414 "javascript" -> return JavascriptObfuscation

409 "javascript" -> return JavascriptObfuscation

415 "none" -> return NoObfuscation

410 "none" -> return NoObfuscation

411+ _ -> err 6

416− _ -> UTF8.hPutStrLn stderr ("Error: Unknown obfuscation method: " ++ arg) >>

412+ ("Error: Unknown obfuscation method: " ++ arg)

417− exitWith (ExitFailure 6)

418 return opt { optEmailObfuscation = method })

413 return opt { optEmailObfuscation = method })

419 "none|javascript|references")

414 "none|javascript|references")

420 "" -- "Method for obfuscating email in HTML"

415 "" -- "Method for obfuscating email in HTML"

446 let shift = t - 1

441 let shift = t - 1

447 return opt{ optTransforms =

442 return opt{ optTransforms =

448 headerShift shift : oldTransforms }

443 headerShift shift : oldTransforms }

449− _ -> do

444+ _ -> err 19

450− UTF8.hPutStrLn stderr $

451− "base-header-level must be a number > 0"

445+ "base-header-level must be a number > 0")

452− exitWith $ ExitFailure 19)

453 "NUMBER")

446 "NUMBER")

454 "" -- "Headers base level"

447 "" -- "Headers base level"

455

448

468 (k,_:v) -> do

461 (k,_:v) -> do

469 let newvars = optVariables opt ++ [(k,v)]

462 let newvars = optVariables opt ++ [(k,v)]

470 return opt{ optVariables = newvars }

463 return opt{ optVariables = newvars }

471− _ -> do

464+ _ -> err 17 $

472− UTF8.hPutStrLn stderr $ "Could not parse `" ++ arg ++ "' as a key/value pair (k=v or k:v)"

465+ "Could not parse `" ++ arg ++ "' as a key/value pair (k=v or k:v)")

473− exitWith $ ExitFailure 17)

474 "KEY:VALUE")

466 "KEY:VALUE")

475 "" -- "Use custom template"

467 "" -- "Use custom template"

476

468

713 ['.',y] | y `elem` ['1'..'9'] -> "man"

705 ['.',y] | y `elem` ['1'..'9'] -> "man"

714 _ -> "html"

706 _ -> "html"

715

707

708+

709+err :: Int -> String -> IO a

710+err exitCode msg = do

711+ name <- getProgName

712+ UTF8.hPutStrLn stderr $ name ++ ": " ++ msg

713+ exitWith $ ExitFailure exitCode

714+ return undefined

715+

716+warn :: String -> IO ()

717+warn msg = do

718+ name <- getProgName

719+ UTF8.hPutStrLn stderr $ name ++ ": " ++ msg

720+

716main :: IO ()

721main :: IO ()

717main = do

722main = do

718

723

725 else getOpt Permute options rawArgs

730 else getOpt Permute options rawArgs

726

731

727 unless (null errors) $

732 unless (null errors) $

728− do name <- getProgName

733+ err 2 $ concat $ errors ++

729− mapM_ (\e -> UTF8.hPutStr stderr (name ++ ": ") >> UTF8.hPutStr stderr e) errors

730− UTF8.hPutStrLn stderr $ "Try " ++ name ++ " --help for more information."

734+ ["Try " ++ prg ++ " --help for more information."]

731− exitWith $ ExitFailure 2

732

735

733 let defaultOpts' = if compatMode

736 let defaultOpts' = if compatMode

734 then defaultOpts { optReader = "markdown"

737 then defaultOpts { optReader = "markdown"

809

812

810 reader <- case (lookup readerName' readers) of

813 reader <- case (lookup readerName' readers) of

811 Just r -> return r

814 Just r -> return r

812− Nothing -> error ("Unknown reader: " ++ readerName')

815+ Nothing -> err 7 ("Unknown reader: " ++ readerName')

813

816

814 let standalone' = standalone || (`elem` nonTextFormats) writerName'

817 let standalone' = standalone || (`elem` nonTextFormats) writerName'

815

818

861 -- that we can do lookups with regular string equality

864 -- that we can do lookups with regular string equality

862 let unescapeRefId ref = ref{ refId = deEntity (refId ref) }

865 let unescapeRefId ref = ref{ refId = deEntity (refId ref) }

863

866

864− refs <- mapM (\f -> catch (CSL.readBiblioFile f) $ \e -> do

867+ refs <- mapM (\f -> catch (CSL.readBiblioFile f) $ \e ->

865− UTF8.hPutStrLn stderr $ "Error reading bibliography `" ++ f ++ "'"

868+ err 23 $ "Error reading bibliography `" ++ f ++ "'" ++ "\n" ++ show e)

866− UTF8.hPutStrLn stderr $ show e

867− exitWith (ExitFailure 23)) reffiles >>=

869+ reffiles >>=

868 return . map unescapeRefId . concat

870 return . map unescapeRefId . concat

869

871

870 let sourceDir = if null sources

872 let sourceDir = if null sources

923 writerHighlightStyle = highlightStyle }

925 writerHighlightStyle = highlightStyle }

924

926

925 when (writerName' `elem` nonTextFormats&& outputFile == "-") $

927 when (writerName' `elem` nonTextFormats&& outputFile == "-") $

926− do UTF8.hPutStrLn stderr ("Error: Cannot write " ++ writerName' ++ " output to stdout.\n" ++

928+ err 5 $ "Error: Cannot write " ++ writerName' ++ " output to stdout.\n" ++

927− "Specify an output file using the -o option.")

929+ "Specify an output file using the -o option."

928− exitWith $ ExitFailure 5

929

930

930 let readSources [] = mapM readSource ["-"]

931 let readSources [] = mapM readSource ["-"]

931 readSources srcs = mapM readSource srcs

932 readSources srcs = mapM readSource srcs

964 processBiblio cslfile' cslabbrevs refs doc1

965 processBiblio cslfile' cslabbrevs refs doc1

965 else return doc1

966 else return doc1

966

967

968+ let latexProgram = "pdflatex"

969+

967 case lookup writerName' writers of

970 case lookup writerName' writers of

968 Nothing | writerName' == "epub" ->

971 Nothing | writerName' == "epub" ->

969 writeEPUB epubStylesheet writerOptions doc2 >>= writeBinary

972 writeEPUB epubStylesheet writerOptions doc2 >>= writeBinary

972 | writerName' == "docx" ->

975 | writerName' == "docx" ->

973 writeDocx referenceDocx writerOptions doc2 >>= writeBinary

976 writeDocx referenceDocx writerOptions doc2 >>= writeBinary

974 | writerName' == "pdf" ->

977 | writerName' == "pdf" ->

978+ do -- first check to make sure we have latex

979+ mbLatex <- findExecutable latexProgram

980+ case mbLatex of

981+ Nothing -> err 41 $

982+ latexProgram ++ " not found" -- TODO improve

983+ Just pgm -> do

975− do res <- tex2pdf "pdflatex" $ writeLaTeX writerOptions doc2

984+ res <- tex2pdf latexProgram $ writeLaTeX writerOptions doc2

976− case res of

985+ case res of

977− Right pdf -> writeBinary pdf

986+ Right pdf -> writeBinary pdf

978− Left err' -> B.hPutStr stderr err'

987+ Left err' -> err 43 $ toString err'

979− | otherwise -> error $ "Unknown writer: " ++ writerName'

988+ | otherwise -> err 9 ("Unknown writer: " ++ writerName')

980 where writeBinary = B.writeFile (encodeString outputFile)

989 where writeBinary = B.writeFile (encodeString outputFile)

981 Just r -> writerFn outputFile =<< postProcess result

990 Just r -> writerFn outputFile =<< postProcess result

982 where writerFn "-" = UTF8.putStr

991 where writerFn "-" = UTF8.putStr