diff --git a/pandoc.hs b/pandoc.hs index 7897d68cf..dd58e79ab 100644 --- a/pandoc.hs +++ b/pandoc.hs @@ -78,6 +78,377 @@ import System.Posix.IO (stdOutput) import Control.Monad.Trans import Text.Pandoc.Class (withMediaBag, PandocIO, getWarnings) +main :: IO () +main = do + + rawArgs <- map UTF8.decodeArg <$> getArgs + prg <- getProgName + + let (actions, args, errors) = getOpt Permute options rawArgs + + unless (null errors) $ + err 2 $ concat $ errors ++ + ["Try " ++ prg ++ " --help for more information."] + + -- thread option data structure through all supplied option actions + opts <- foldl (>>=) (return defaultOpts) actions + convertWithOpts opts args + +convertWithOpts :: Opt -> [FilePath] -> IO () +convertWithOpts opts args = do + let Opt { optTabStop = tabStop + , optPreserveTabs = preserveTabs + , optStandalone = standalone + , optReader = readerName + , optWriter = writerName + , optParseRaw = parseRaw + , optVariables = variables + , optMetadata = metadata + , optTableOfContents = toc + , optTransforms = transforms + , optTemplate = templatePath + , optOutputFile = outputFile + , optNumberSections = numberSections + , optNumberOffset = numberFrom + , optSectionDivs = sectionDivs + , optIncremental = incremental + , optSelfContained = selfContained + , optSmart = smart + , optOldDashes = oldDashes + , optHtml5 = html5 + , optHtmlQTags = htmlQTags + , optHighlight = highlight + , optHighlightStyle = highlightStyle + , optTopLevelDivision = topLevelDivision + , optHTMLMathMethod = mathMethod' + , optReferenceDoc = referenceDoc + , optEpubStylesheet = epubStylesheet + , optEpubMetadata = epubMetadata + , optEpubFonts = epubFonts + , optEpubChapterLevel = epubChapterLevel + , optTOCDepth = epubTOCDepth + , optDumpArgs = dumpArgs + , optIgnoreArgs = ignoreArgs + , optVerbose = verbose + , optQuiet = quiet + , optFailIfWarnings = failIfWarnings + , optReferenceLinks = referenceLinks + , optReferenceLocation = referenceLocation + , optDpi = dpi + , optWrapText = wrap + , optColumns = columns + , optFilters = filters + , optEmailObfuscation = obfuscationMethod + , optIdentifierPrefix = idPrefix + , optIndentedCodeClasses = codeBlockClasses + , optDataDir = mbDataDir + , optCiteMethod = citeMethod + , optListings = listings + , optLaTeXEngine = latexEngine + , optLaTeXEngineArgs = latexEngineArgs + , optSlideLevel = slideLevel + , optSetextHeaders = setextHeaders + , optAscii = ascii + , optTeXLigatures = texLigatures + , optDefaultImageExtension = defaultImageExtension + , optExtractMedia = mbExtractMedia + , optTrace = trace + , optTrackChanges = trackChanges + , optFileScope = fileScope + , optKaTeXStylesheet = katexStylesheet + , optKaTeXJS = katexJS + } = opts + + when dumpArgs $ + do UTF8.hPutStrLn stdout outputFile + mapM_ (UTF8.hPutStrLn stdout) args + exitSuccess + + let csscdn = "https://cdnjs.cloudflare.com/ajax/libs/KaTeX/0.6.0/katex.min.css" + let mathMethod = + case (katexJS, katexStylesheet) of + (Nothing, _) -> mathMethod' + (Just js, ss) -> KaTeX js (fromMaybe csscdn ss) + + + -- --bibliography implies -F pandoc-citeproc for backwards compatibility: + let needsCiteproc = isJust (M.lookup "bibliography" (optMetadata opts)) && + optCiteMethod opts `notElem` [Natbib, Biblatex] && + "pandoc-citeproc" `notElem` map takeBaseName filters + let filters' = if needsCiteproc then "pandoc-citeproc" : filters + else filters + + let sources = case args of + [] -> ["-"] + xs | ignoreArgs -> ["-"] + | otherwise -> xs + + datadir <- case mbDataDir of + Nothing -> E.catch + (Just <$> getAppUserDataDirectory "pandoc") + (\e -> let _ = (e :: E.SomeException) + in return Nothing) + Just _ -> return mbDataDir + + -- assign reader and writer based on options and filenames + let readerName' = case map toLower readerName of + [] -> defaultReaderName + (if any isURI sources + then "html" + else "markdown") sources + "html4" -> "html" + x -> x + + let writerName' = case map toLower writerName of + [] -> defaultWriterName outputFile + "epub2" -> "epub" + "html4" -> "html" + x -> x + let format = takeWhile (`notElem` ['+','-']) + $ takeFileName writerName' -- in case path to lua script + + let pdfOutput = map toLower (takeExtension outputFile) == ".pdf" + + let laTeXOutput = format `elem` ["latex", "beamer"] + let conTeXtOutput = format == "context" + let html5Output = format == "html5" + + let laTeXInput = "latex" `isPrefixOf` readerName' || + "beamer" `isPrefixOf` readerName' + + + -- disabling the custom writer for now + writer <- if ".lua" `isSuffixOf` format + -- note: use non-lowercased version writerName + then error "custom writers disabled for now" + else case getWriter writerName' of + Left e -> err 9 $ + if format == "pdf" + then e ++ + "\nTo create a pdf with pandoc, use " ++ + "the latex or beamer writer and specify\n" ++ + "an output file with .pdf extension " ++ + "(pandoc -t latex -o filename.pdf)." + else e + Right w -> return (w :: Writer PandocIO) + + -- TODO: we have to get the input and the output into the state for + -- the sake of the text2tags reader. + reader <- case getReader readerName' of + Right r -> return (r :: Reader PandocIO) + Left e -> err 7 e' + where e' = case readerName' of + "pdf" -> e ++ + "\nPandoc can convert to PDF, but not from PDF." + "doc" -> e ++ + "\nPandoc can convert from DOCX, but not from DOC.\nTry using Word to save your DOC file as DOCX, and convert that with pandoc." + _ -> e + + let standalone' = standalone || not (isTextFormat format) || pdfOutput + + templ <- case templatePath of + _ | not standalone' -> return Nothing + Nothing -> do + deftemp <- getDefaultTemplate datadir format + case deftemp of + Left e -> throwIO e + Right t -> return (Just t) + Just tp -> do + -- strip off extensions + let tp' = case takeExtension tp of + "" -> tp <.> format + _ -> tp + Just <$> E.catch (UTF8.readFile tp') + (\e -> if isDoesNotExistError e + then E.catch + (readDataFileUTF8 datadir + ("templates" tp')) + (\e' -> let _ = (e' :: E.SomeException) + in throwIO e') + else throwIO e) + + variables' <- case mathMethod of + LaTeXMathML Nothing -> do + s <- readDataFileUTF8 datadir "LaTeXMathML.js" + return $ ("mathml-script", s) : variables + MathML Nothing -> do + s <- readDataFileUTF8 datadir "MathMLinHTML.js" + return $ ("mathml-script", s) : variables + _ -> return variables + + variables'' <- if format == "dzslides" + then do + dztempl <- readDataFileUTF8 datadir + ("dzslides" "template.html") + let dzline = "