App: extract output settings into module
This commit is contained in:
Albert Krewinkel
John MacFarlane
parent
fd3c8cd8c7
commit
418bd42df8
4 changed files with 348 additions and 204 deletions
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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 /= '-')
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
317
src/Text/Pandoc/App/OutputSettings.hs
Normal file
317
src/Text/Pandoc/App/OutputSettings.hs
Normal file
|
|
@ -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"]
|
||||
Loading…
Reference in a new issue