diff options
| -rw-r--r-- | pandoc.cabal | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/App.hs | 229 | ||||
| -rw-r--r-- | src/Text/Pandoc/App/CommandLineOptions.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/App/OutputSettings.hs | 317 |
4 files changed, 348 insertions, 204 deletions
diff --git a/pandoc.cabal b/pandoc.cabal index 33087716c..01e7b1153 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -515,6 +515,7 @@ library Text.Pandoc.BCP47, Text.Pandoc.Class other-modules: Text.Pandoc.App.CommandLineOptions, + Text.Pandoc.App.OutputSettings, Text.Pandoc.Filter.JSON, Text.Pandoc.Filter.Lua, Text.Pandoc.Filter.Path, diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index cf4c9173d..173c60a56 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -1,7 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} {- Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> @@ -44,12 +43,10 @@ module Text.Pandoc.App ( import Prelude import qualified Control.Exception as E import Control.Monad -import Control.Monad.Except (catchError, throwError) import Control.Monad.Trans import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B import Data.Char (toLower) -import Data.List (find, isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe, isJust, isNothing) import qualified Data.Set as Set import Data.Text (Text) @@ -59,8 +56,6 @@ import qualified Data.Text.Lazy.Encoding as TE import qualified Data.Text.Encoding.Error as TE import qualified Data.YAML as YAML import Network.URI (URI (..), parseURI) -import Skylighting (defaultSyntaxMap) -import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition) import System.Directory (getAppUserDataDirectory) import System.Exit (exitSuccess) import System.FilePath @@ -68,7 +63,8 @@ import System.IO (nativeNewline, stdout) import qualified System.IO as IO (Newline (..)) import Text.Pandoc import Text.Pandoc.App.CommandLineOptions (Opt (..), LineEnding (..), - defaultOpts, engines, parseOptions, options) + defaultOpts, parseOptions, options) +import Text.Pandoc.App.OutputSettings (OutputSettings (..), optToOutputSettings) import Text.Pandoc.BCP47 (Lang (..), parseBCP47) import Text.Pandoc.Builder (setMeta, deleteMeta) import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters) @@ -83,41 +79,6 @@ import System.Posix.IO (stdOutput) import System.Posix.Terminal (queryTerminal) #endif -pdfIsNoWriterErrorMsg :: String -pdfIsNoWriterErrorMsg = - "To create a pdf using pandoc, use " ++ - "-t latex|beamer|context|ms|html5" ++ - "\nand specify an output file with " ++ - ".pdf extension (-o filename.pdf)." - -pdfWriterAndProg :: Maybe String -- ^ user-specified writer name - -> Maybe String -- ^ user-specified pdf-engine - -> IO (String, Maybe String) -- ^ IO (writerName, maybePdfEngineProg) -pdfWriterAndProg mWriter mEngine = do - let panErr msg = liftIO $ E.throwIO $ PandocAppError msg - case go mWriter mEngine of - Right (writ, prog) -> return (writ, Just prog) - Left err -> panErr err - where - go Nothing Nothing = Right ("latex", "pdflatex") - go (Just writer) Nothing = (writer,) <$> engineForWriter writer - go Nothing (Just engine) = (,engine) <$> writerForEngine (takeBaseName engine) - go (Just writer) (Just engine) = - case find (== (baseWriterName writer, takeBaseName engine)) engines of - Just _ -> Right (writer, engine) - Nothing -> Left $ "pdf-engine " ++ engine ++ - " is not compatible with output format " ++ writer - - writerForEngine eng = case [f | (f,e) <- engines, e == eng] of - fmt : _ -> Right fmt - [] -> Left $ - "pdf-engine " ++ eng ++ " not known" - - engineForWriter "pdf" = Left pdfIsNoWriterErrorMsg - engineForWriter w = case [e | (f,e) <- engines, f == baseWriterName w] of - eng : _ -> Right eng - [] -> Left $ - "cannot produce pdf output from " ++ w convertWithOpts :: Opt -> IO () convertWithOpts opts = do @@ -130,10 +91,6 @@ convertWithOpts opts = do mapM_ (UTF8.hPutStrLn stdout) (optInputFiles opts) exitSuccess - epubMetadata <- case optEpubMetadata opts of - Nothing -> return Nothing - Just fp -> Just <$> UTF8.readFile fp - let isPandocCiteproc (JSONFilter f) = takeBaseName f == "pandoc-citeproc" isPandocCiteproc _ = False -- --bibliography implies -F pandoc-citeproc for backwards compatibility: @@ -165,30 +122,6 @@ convertWithOpts opts = do let pdfOutput = map toLower (takeExtension outputFile) == ".pdf" - (writerName, maybePdfProg) <- - if pdfOutput - then pdfWriterAndProg (optWriter opts) (optPdfEngine opts) - else case optWriter opts of - Nothing -> - return (formatFromFilePaths "html" [outputFile], Nothing) - Just f -> return (f, Nothing) - - let format = map toLower $ baseWriterName - $ takeFileName writerName -- in case path to lua script - - -- disabling the custom writer for now - (writer, writerExts) <- - if ".lua" `isSuffixOf` format - then return (TextWriter - (\o d -> writeCustom writerName o d) - :: Writer PandocIO, mempty) - else case getWriter (map toLower writerName) of - Left e -> E.throwIO $ PandocAppError $ - if format == "pdf" - then e ++ "\n" ++ pdfIsNoWriterErrorMsg - else e - Right (w, es) -> return (w :: Writer PandocIO, es) - -- TODO: we have to get the input and the output into the state for -- the sake of the text2tags reader. (reader, readerExts) <- @@ -202,34 +135,6 @@ convertWithOpts opts = do "\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 = optStandalone opts || not (isTextFormat format) || pdfOutput - let addStringAsVariable varname s vars = return $ (varname, s) : vars - - let addSyntaxMap existingmap f = do - res <- parseSyntaxDefinition f - case res of - Left errstr -> E.throwIO $ PandocSyntaxMapError errstr - Right syn -> return $ addSyntaxDefinition syn existingmap - - syntaxMap <- foldM addSyntaxMap defaultSyntaxMap - (optSyntaxDefinitions opts) - - -- We don't want to send output to the terminal if the user - -- does 'pandoc -t docx input.txt'; though we allow them to - -- force this with '-o -'. On posix systems, we detect - -- when stdout is being piped and allow output to stdout - -- in that case, but on Windows we can't. -#ifdef _WINDOWS - let istty = True -#else - istty <- queryTerminal stdOutput -#endif - when (not (isTextFormat format) && istty && isNothing ( optOutputFile opts)) $ - E.throwIO $ PandocAppError $ - "Cannot write " ++ format ++ " output to terminal.\n" ++ - "Specify an output file using the -o option, or " ++ - "use '-o -' to force output to stdout." - let convertTabs = tabFilter (if optPreserveTabs opts || readerName == "t2t" || readerName == "man" @@ -261,80 +166,41 @@ convertWithOpts opts = do LF -> IO.LF Native -> nativeNewline - -- note: this reverses the list constructed in option parsing, - -- which in turn was reversed from the command-line order, - -- so we end up with the correct order in the variable list: - let withList _ [] vars = return vars - withList f (x:xs) vars = f x vars >>= withList f xs - - let addContentsAsVariable varname fp vars = do - s <- UTF8.toString <$> readFileStrict fp - return $ (varname, s) : vars - runIO' $ do setUserDataDir datadir setInputFiles (optInputFiles opts) setOutputFile (optOutputFile opts) - variables <- - withList (addStringAsVariable "sourcefile") - (reverse $ optInputFiles opts) - (("outputfile", fromMaybe "-" (optOutputFile opts)) - : optVariables opts) - -- we reverse this list because, unlike - -- the other option lists here, it is - -- not reversed when parsed from CLI arguments. - -- See withList, above. - >>= - withList (addContentsAsVariable "include-before") - (optIncludeBeforeBody opts) - >>= - withList (addContentsAsVariable "include-after") - (optIncludeAfterBody opts) - >>= - withList (addContentsAsVariable "header-includes") - (optIncludeInHeader opts) - >>= - withList (addStringAsVariable "css") (optCss opts) - >>= - maybe return (addStringAsVariable "title-prefix") - (optTitlePrefix opts) - >>= - maybe return (addStringAsVariable "epub-cover-image") - (optEpubCoverImage opts) - >>= - (\vars -> if format == "dzslides" - then do - dztempl <- UTF8.toString <$> readDataFile - ("dzslides" </> "template.html") - let dzline = "<!-- {{{{ dzslides core" - let dzcore = unlines - $ dropWhile (not . (dzline `isPrefixOf`)) - $ lines dztempl - return $ ("dzslides-core", dzcore) : vars - else return vars) + outputSettings <- optToOutputSettings opts + let format = outputFormat outputSettings + let writer = outputWriter outputSettings + let writerName = outputWriterName outputSettings + let writerOptions = outputWriterOptions outputSettings + + let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput + + -- We don't want to send output to the terminal if the user + -- does 'pandoc -t docx input.txt'; though we allow them to + -- force this with '-o -'. On posix systems, we detect + -- when stdout is being piped and allow output to stdout + -- in that case, but on Windows we can't. +#ifdef _WINDOWS + let istty = True +#else + istty <- liftIO $ queryTerminal stdOutput +#endif + when (not (isTextFormat format) && istty && isNothing ( optOutputFile opts)) $ + liftIO $ E.throwIO $ PandocAppError $ + "Cannot write " ++ format ++ " output to terminal.\n" ++ + "Specify an output file using the -o option, or " ++ + "use '-o -' to force output to stdout." + abbrevs <- Set.fromList . filter (not . null) . lines <$> case optAbbreviations opts of Nothing -> UTF8.toString <$> readDataFile "abbreviations" Just f -> UTF8.toString <$> readFileStrict f - templ <- case optTemplate opts of - _ | not standalone -> return Nothing - Nothing -> Just <$> getDefaultTemplate format - Just tp -> do - -- strip off extensions - let tp' = case takeExtension tp of - "" -> tp <.> format - _ -> tp - Just . UTF8.toString <$> - ((fst <$> fetchItem tp') `catchError` - (\e -> - case e of - PandocResourceNotFound _ -> - readDataFile ("templates" </> tp') - _ -> throwError e)) - metadata <- if format == "jats" && isNothing (lookup "csl" (optMetadata opts)) && isNothing (lookup "citation-style" (optMetadata opts)) @@ -355,41 +221,6 @@ convertWithOpts opts = do Right l' -> setTranslations l' Nothing -> setTranslations $ Lang "en" "" "US" [] - let writerOptions = def { - writerTemplate = templ - , writerVariables = variables - , writerTabStop = optTabStop opts - , writerTableOfContents = optTableOfContents opts - , writerHTMLMathMethod = optHTMLMathMethod opts - , writerIncremental = optIncremental opts - , writerCiteMethod = optCiteMethod opts - , writerNumberSections = optNumberSections opts - , writerNumberOffset = optNumberOffset opts - , writerSectionDivs = optSectionDivs opts - , writerExtensions = writerExts - , writerReferenceLinks = optReferenceLinks opts - , writerReferenceLocation = optReferenceLocation opts - , writerDpi = optDpi opts - , writerWrapText = optWrapText opts - , writerColumns = optColumns opts - , writerEmailObfuscation = optEmailObfuscation opts - , writerIdentifierPrefix = optIdentifierPrefix opts - , writerHtmlQTags = optHtmlQTags opts - , writerTopLevelDivision = optTopLevelDivision opts - , writerListings = optListings opts - , writerSlideLevel = optSlideLevel opts - , writerHighlightStyle = optHighlightStyle opts - , writerSetextHeaders = optSetextHeaders opts - , writerEpubSubdirectory = optEpubSubdirectory opts - , writerEpubMetadata = epubMetadata - , writerEpubFonts = optEpubFonts opts - , writerEpubChapterLevel = optEpubChapterLevel opts - , writerTOCDepth = optTOCDepth opts - , writerReferenceDoc = optReferenceDoc opts - , writerSyntaxMap = syntaxMap - , writerPreferAscii = optAscii opts - } - let readerOpts = def{ readerStandalone = standalone , readerColumns = optColumns opts @@ -412,7 +243,7 @@ convertWithOpts opts = do (if extensionEnabled Ext_east_asian_line_breaks readerExts && not (extensionEnabled Ext_east_asian_line_breaks - writerExts && + (writerExtensions writerOptions) && writerWrapText writerOptions == WrapPreserve) then (eastAsianLineBreakFilter :) else id) $ @@ -450,7 +281,7 @@ convertWithOpts opts = do case writer of ByteStringWriter f -> f writerOptions doc >>= writeFnBinary outputFile - TextWriter f -> case maybePdfProg of + TextWriter f -> case outputPdfProgram outputSettings of Just pdfProg -> do res <- makePDF pdfProg (optPdfEngineArgs opts) f writerOptions doc @@ -594,7 +425,3 @@ writerFn :: MonadIO m => IO.Newline -> FilePath -> Text -> m () -- TODO this implementation isn't maximally efficient: writerFn eol "-" = liftIO . UTF8.putStrWith eol . T.unpack writerFn eol f = liftIO . UTF8.writeFileWith eol f . T.unpack - - -baseWriterName :: String -> String -baseWriterName = takeWhile (\c -> c /= '+' && c /= '-') diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs index d97b43b2f..9cbef3ee6 100644 --- a/src/Text/Pandoc/App/CommandLineOptions.hs +++ b/src/Text/Pandoc/App/CommandLineOptions.hs @@ -268,9 +268,8 @@ defaultOpts = Opt , optStripComments = False } -lookupHighlightStyle :: Maybe String -> IO (Maybe Style) -lookupHighlightStyle Nothing = return Nothing -lookupHighlightStyle (Just s) +lookupHighlightStyle :: String -> IO (Maybe Style) +lookupHighlightStyle s | takeExtension s == ".theme" = -- attempt to load KDE theme do contents <- B.readFile s case parseTheme contents of diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs new file mode 100644 index 000000000..a7d5bee1b --- /dev/null +++ b/src/Text/Pandoc/App/OutputSettings.hs @@ -0,0 +1,317 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{- +Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.App + Copyright : Copyright (C) 2006-2018 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley@edu> + Stability : alpha + Portability : portable + +Does a pandoc conversion based on command-line options. +-} +module Text.Pandoc.App.OutputSettings + ( OutputSettings (..) + , optToOutputSettings + ) where +import Prelude +import qualified Control.Exception as E +import Control.Monad +import Control.Monad.Except (catchError, throwError) +import Control.Monad.Trans +import Data.Char (toLower) +import Data.List (find, isPrefixOf, isSuffixOf) +import Data.Maybe (fromMaybe) +import Skylighting (defaultSyntaxMap) +import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition) +import System.Exit (exitSuccess) +import System.FilePath +import System.IO (stdout) +import Text.Pandoc +import Text.Pandoc.App.CommandLineOptions (Opt (..), engines) +import Text.Pandoc.BCP47 (Lang (..), parseBCP47) +import qualified Text.Pandoc.UTF8 as UTF8 + +-- | Settings specifying how document output should be produced. +data OutputSettings = OutputSettings + { outputFormat :: String + , outputWriter :: Writer PandocIO + , outputWriterName :: String + , outputWriterOptions :: WriterOptions + , outputPdfProgram :: Maybe String + } + +readUtf8File :: PandocMonad m => FilePath -> m String +readUtf8File = fmap UTF8.toString . readFileStrict + +-- | Get output settings from command line options. +optToOutputSettings :: Opt -> PandocIO OutputSettings +optToOutputSettings opts = do + let outputFile = fromMaybe "-" (optOutputFile opts) + + when (optDumpArgs opts) . liftIO $ do + UTF8.hPutStrLn stdout outputFile + mapM_ (UTF8.hPutStrLn stdout) (optInputFiles opts) + exitSuccess + + epubMetadata <- case optEpubMetadata opts of + Nothing -> return Nothing + Just fp -> Just <$> readUtf8File fp + + let nonPdfWriterName Nothing = defaultWriterName outputFile + nonPdfWriterName (Just x) = x + + let pdfOutput = map toLower (takeExtension outputFile) == ".pdf" + (writerName, maybePdfProg) <- + if pdfOutput + then liftIO $ pdfWriterAndProg (optWriter opts) (optPdfEngine opts) + else return (nonPdfWriterName $ optWriter opts, Nothing) + + let format = map toLower $ baseWriterName + $ takeFileName writerName -- in case path to lua script + + -- disabling the custom writer for now + (writer, writerExts) <- + if ".lua" `isSuffixOf` format + then return (TextWriter + (\o d -> writeCustom writerName o d) + :: Writer PandocIO, mempty) + else case getWriter (map toLower writerName) of + Left e -> throwError $ PandocAppError $ + if format == "pdf" + then e ++ "\n" ++ pdfIsNoWriterErrorMsg + else e + Right (w, es) -> return (w :: Writer PandocIO, es) + + + let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput + + let addStringAsVariable varname s vars = return $ (varname, s) : vars + + let addSyntaxMap existingmap f = do + res <- liftIO (parseSyntaxDefinition f) + case res of + Left errstr -> throwError $ PandocSyntaxMapError errstr + Right syn -> return $ addSyntaxDefinition syn existingmap + + syntaxMap <- foldM addSyntaxMap defaultSyntaxMap + (optSyntaxDefinitions opts) + + -- note: this reverses the list constructed in option parsing, + -- which in turn was reversed from the command-line order, + -- so we end up with the correct order in the variable list: + let withList _ [] vars = return vars + withList f (x:xs) vars = f x vars >>= withList f xs + + let addContentsAsVariable varname fp vars = do + s <- UTF8.toString <$> readFileStrict fp + return $ (varname, s) : vars + + variables <- + withList (addStringAsVariable "sourcefile") + (reverse $ optInputFiles opts) + (("outputfile", fromMaybe "-" (optOutputFile opts)) + : optVariables opts) + -- we reverse this list because, unlike + -- the other option lists here, it is + -- not reversed when parsed from CLI arguments. + -- See withList, above. + >>= + withList (addContentsAsVariable "include-before") + (optIncludeBeforeBody opts) + >>= + withList (addContentsAsVariable "include-after") + (optIncludeAfterBody opts) + >>= + withList (addContentsAsVariable "header-includes") + (optIncludeInHeader opts) + >>= + withList (addStringAsVariable "css") (optCss opts) + >>= + maybe return (addStringAsVariable "title-prefix") + (optTitlePrefix opts) + >>= + maybe return (addStringAsVariable "epub-cover-image") + (optEpubCoverImage opts) + >>= + (\vars -> if format == "dzslides" + then do + dztempl <- UTF8.toString <$> readDataFile + ("dzslides" </> "template.html") + let dzline = "<!-- {{{{ dzslides core" + let dzcore = unlines + $ dropWhile (not . (dzline `isPrefixOf`)) + $ lines dztempl + return $ ("dzslides-core", dzcore) : vars + else return vars) + + templ <- case optTemplate opts of + _ | not standalone -> return Nothing + Nothing -> Just <$> getDefaultTemplate format + Just tp -> do + -- strip off extensions + let tp' = case takeExtension tp of + "" -> tp <.> format + _ -> tp + Just . UTF8.toString <$> + ((fst <$> fetchItem tp') `catchError` + (\e -> + case e of + PandocResourceNotFound _ -> + readDataFile ("templates" </> tp') + _ -> throwError e)) + + case lookup "lang" (optMetadata opts) of + Just l -> case parseBCP47 l of + Left _ -> return () + Right l' -> setTranslations l' + Nothing -> setTranslations $ Lang "en" "" "US" [] + + let writerOpts = def { + writerTemplate = templ + , writerVariables = variables + , writerTabStop = optTabStop opts + , writerTableOfContents = optTableOfContents opts + , writerHTMLMathMethod = optHTMLMathMethod opts + , writerIncremental = optIncremental opts + , writerCiteMethod = optCiteMethod opts + , writerNumberSections = optNumberSections opts + , writerNumberOffset = optNumberOffset opts + , writerSectionDivs = optSectionDivs opts + , writerExtensions = writerExts + , writerReferenceLinks = optReferenceLinks opts + , writerReferenceLocation = optReferenceLocation opts + , writerDpi = optDpi opts + , writerWrapText = optWrapText opts + , writerColumns = optColumns opts + , writerEmailObfuscation = optEmailObfuscation opts + , writerIdentifierPrefix = optIdentifierPrefix opts + , writerHtmlQTags = optHtmlQTags opts + , writerTopLevelDivision = optTopLevelDivision opts + , writerListings = optListings opts + , writerSlideLevel = optSlideLevel opts + , writerHighlightStyle = optHighlightStyle opts + , writerSetextHeaders = optSetextHeaders opts + , writerEpubSubdirectory = optEpubSubdirectory opts + , writerEpubMetadata = epubMetadata + , writerEpubFonts = optEpubFonts opts + , writerEpubChapterLevel = optEpubChapterLevel opts + , writerTOCDepth = optTOCDepth opts + , writerReferenceDoc = optReferenceDoc opts + , writerSyntaxMap = syntaxMap + , writerPreferAscii = optAscii opts + } + return $ OutputSettings + { outputFormat = format + , outputWriter = writer + , outputWriterName = writerName + , outputWriterOptions = writerOpts + , outputPdfProgram = maybePdfProg + } + +-- Determine default writer based on output file extension +defaultWriterName :: FilePath -> String +defaultWriterName "-" = "html" -- no output file +defaultWriterName x = + case takeExtension (map toLower x) of + "" -> "markdown" -- empty extension + ".tex" -> "latex" + ".latex" -> "latex" + ".ltx" -> "latex" + ".context" -> "context" + ".ctx" -> "context" + ".rtf" -> "rtf" + ".rst" -> "rst" + ".s5" -> "s5" + ".native" -> "native" + ".json" -> "json" + ".txt" -> "markdown" + ".text" -> "markdown" + ".md" -> "markdown" + ".muse" -> "muse" + ".markdown" -> "markdown" + ".textile" -> "textile" + ".lhs" -> "markdown+lhs" + ".texi" -> "texinfo" + ".texinfo" -> "texinfo" + ".db" -> "docbook" + ".odt" -> "odt" + ".docx" -> "docx" + ".epub" -> "epub" + ".org" -> "org" + ".asciidoc" -> "asciidoc" + ".adoc" -> "asciidoc" + ".fb2" -> "fb2" + ".opml" -> "opml" + ".icml" -> "icml" + ".tei.xml" -> "tei" + ".tei" -> "tei" + ".ms" -> "ms" + ".roff" -> "ms" + ".pptx" -> "pptx" + ['.',y] | y `elem` ['1'..'9'] -> "man" + _ -> "html" + +baseWriterName :: String -> String +baseWriterName = takeWhile (\c -> c /= '+' && c /= '-') + +pdfIsNoWriterErrorMsg :: String +pdfIsNoWriterErrorMsg = + "To create a pdf using pandoc, use " ++ + "-t latex|beamer|context|ms|html5" ++ + "\nand specify an output file with " ++ + ".pdf extension (-o filename.pdf)." + +pdfWriterAndProg :: Maybe String -- ^ user-specified writer name + -> Maybe String -- ^ user-specified pdf-engine + -> IO (String, Maybe String) -- ^ IO (writerName, maybePdfEngineProg) +pdfWriterAndProg mWriter mEngine = do + let panErr msg = liftIO $ E.throwIO $ PandocAppError msg + case go mWriter mEngine of + Right (writ, prog) -> return (writ, Just prog) + Left err -> panErr err + where + go Nothing Nothing = Right ("latex", "pdflatex") + go (Just writer) Nothing = (writer,) <$> engineForWriter writer + go Nothing (Just engine) = (,engine) <$> writerForEngine (takeBaseName engine) + go (Just writer) (Just engine) = + case find (== (baseWriterName writer, takeBaseName engine)) engines of + Just _ -> Right (writer, engine) + Nothing -> Left $ "pdf-engine " ++ engine ++ + " is not compatible with output format " ++ writer + + writerForEngine eng = case [f | (f,e) <- engines, e == eng] of + fmt : _ -> Right fmt + [] -> Left $ + "pdf-engine " ++ eng ++ " not known" + + engineForWriter "pdf" = Left pdfIsNoWriterErrorMsg + engineForWriter w = case [e | (f,e) <- engines, f == baseWriterName w] of + eng : _ -> Right eng + [] -> Left $ + "cannot produce pdf output from " ++ w + +isTextFormat :: String -> Bool +isTextFormat s = s `notElem` ["odt","docx","epub2","epub3","epub","pptx"] |