App: extract output settings into module
This commit is contained in:
parent
fd3c8cd8c7
commit
418bd42df8
4 changed files with 348 additions and 204 deletions
|
@ -515,6 +515,7 @@ library
|
||||||
Text.Pandoc.BCP47,
|
Text.Pandoc.BCP47,
|
||||||
Text.Pandoc.Class
|
Text.Pandoc.Class
|
||||||
other-modules: Text.Pandoc.App.CommandLineOptions,
|
other-modules: Text.Pandoc.App.CommandLineOptions,
|
||||||
|
Text.Pandoc.App.OutputSettings,
|
||||||
Text.Pandoc.Filter.JSON,
|
Text.Pandoc.Filter.JSON,
|
||||||
Text.Pandoc.Filter.Lua,
|
Text.Pandoc.Filter.Lua,
|
||||||
Text.Pandoc.Filter.Path,
|
Text.Pandoc.Filter.Path,
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
|
||||||
{-
|
{-
|
||||||
Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu>
|
Copyright (C) 2006-2018 John MacFarlane <jgm@berkeley.edu>
|
||||||
|
|
||||||
|
@ -44,12 +43,10 @@ module Text.Pandoc.App (
|
||||||
import Prelude
|
import Prelude
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Except (catchError, throwError)
|
|
||||||
import Control.Monad.Trans
|
import Control.Monad.Trans
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Lazy as B
|
import qualified Data.ByteString.Lazy as B
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.List (find, isPrefixOf, isSuffixOf)
|
|
||||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Text (Text)
|
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.Text.Encoding.Error as TE
|
||||||
import qualified Data.YAML as YAML
|
import qualified Data.YAML as YAML
|
||||||
import Network.URI (URI (..), parseURI)
|
import Network.URI (URI (..), parseURI)
|
||||||
import Skylighting (defaultSyntaxMap)
|
|
||||||
import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition)
|
|
||||||
import System.Directory (getAppUserDataDirectory)
|
import System.Directory (getAppUserDataDirectory)
|
||||||
import System.Exit (exitSuccess)
|
import System.Exit (exitSuccess)
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
@ -68,7 +63,8 @@ import System.IO (nativeNewline, stdout)
|
||||||
import qualified System.IO as IO (Newline (..))
|
import qualified System.IO as IO (Newline (..))
|
||||||
import Text.Pandoc
|
import Text.Pandoc
|
||||||
import Text.Pandoc.App.CommandLineOptions (Opt (..), LineEnding (..),
|
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.BCP47 (Lang (..), parseBCP47)
|
||||||
import Text.Pandoc.Builder (setMeta, deleteMeta)
|
import Text.Pandoc.Builder (setMeta, deleteMeta)
|
||||||
import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters)
|
import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), applyFilters)
|
||||||
|
@ -83,41 +79,6 @@ import System.Posix.IO (stdOutput)
|
||||||
import System.Posix.Terminal (queryTerminal)
|
import System.Posix.Terminal (queryTerminal)
|
||||||
#endif
|
#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 :: Opt -> IO ()
|
||||||
convertWithOpts opts = do
|
convertWithOpts opts = do
|
||||||
|
@ -130,10 +91,6 @@ convertWithOpts opts = do
|
||||||
mapM_ (UTF8.hPutStrLn stdout) (optInputFiles opts)
|
mapM_ (UTF8.hPutStrLn stdout) (optInputFiles opts)
|
||||||
exitSuccess
|
exitSuccess
|
||||||
|
|
||||||
epubMetadata <- case optEpubMetadata opts of
|
|
||||||
Nothing -> return Nothing
|
|
||||||
Just fp -> Just <$> UTF8.readFile fp
|
|
||||||
|
|
||||||
let isPandocCiteproc (JSONFilter f) = takeBaseName f == "pandoc-citeproc"
|
let isPandocCiteproc (JSONFilter f) = takeBaseName f == "pandoc-citeproc"
|
||||||
isPandocCiteproc _ = False
|
isPandocCiteproc _ = False
|
||||||
-- --bibliography implies -F pandoc-citeproc for backwards compatibility:
|
-- --bibliography implies -F pandoc-citeproc for backwards compatibility:
|
||||||
|
@ -165,30 +122,6 @@ convertWithOpts opts = do
|
||||||
|
|
||||||
let pdfOutput = map toLower (takeExtension outputFile) == ".pdf"
|
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
|
-- TODO: we have to get the input and the output into the state for
|
||||||
-- the sake of the text2tags reader.
|
-- the sake of the text2tags reader.
|
||||||
(reader, readerExts) <-
|
(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."
|
"\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
|
_ -> 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 ||
|
let convertTabs = tabFilter (if optPreserveTabs opts ||
|
||||||
readerName == "t2t" ||
|
readerName == "t2t" ||
|
||||||
readerName == "man"
|
readerName == "man"
|
||||||
|
@ -261,80 +166,41 @@ convertWithOpts opts = do
|
||||||
LF -> IO.LF
|
LF -> IO.LF
|
||||||
Native -> nativeNewline
|
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
|
runIO' $ do
|
||||||
setUserDataDir datadir
|
setUserDataDir datadir
|
||||||
setInputFiles (optInputFiles opts)
|
setInputFiles (optInputFiles opts)
|
||||||
setOutputFile (optOutputFile opts)
|
setOutputFile (optOutputFile opts)
|
||||||
|
|
||||||
variables <-
|
outputSettings <- optToOutputSettings opts
|
||||||
withList (addStringAsVariable "sourcefile")
|
let format = outputFormat outputSettings
|
||||||
(reverse $ optInputFiles opts)
|
let writer = outputWriter outputSettings
|
||||||
(("outputfile", fromMaybe "-" (optOutputFile opts))
|
let writerName = outputWriterName outputSettings
|
||||||
: optVariables opts)
|
let writerOptions = outputWriterOptions outputSettings
|
||||||
-- we reverse this list because, unlike
|
|
||||||
-- the other option lists here, it is
|
let standalone = optStandalone opts || not (isTextFormat format) || pdfOutput
|
||||||
-- not reversed when parsed from CLI arguments.
|
|
||||||
-- See withList, above.
|
-- We don't want to send output to the terminal if the user
|
||||||
>>=
|
-- does 'pandoc -t docx input.txt'; though we allow them to
|
||||||
withList (addContentsAsVariable "include-before")
|
-- force this with '-o -'. On posix systems, we detect
|
||||||
(optIncludeBeforeBody opts)
|
-- when stdout is being piped and allow output to stdout
|
||||||
>>=
|
-- in that case, but on Windows we can't.
|
||||||
withList (addContentsAsVariable "include-after")
|
#ifdef _WINDOWS
|
||||||
(optIncludeAfterBody opts)
|
let istty = True
|
||||||
>>=
|
#else
|
||||||
withList (addContentsAsVariable "header-includes")
|
istty <- liftIO $ queryTerminal stdOutput
|
||||||
(optIncludeInHeader opts)
|
#endif
|
||||||
>>=
|
when (not (isTextFormat format) && istty && isNothing ( optOutputFile opts)) $
|
||||||
withList (addStringAsVariable "css") (optCss opts)
|
liftIO $ E.throwIO $ PandocAppError $
|
||||||
>>=
|
"Cannot write " ++ format ++ " output to terminal.\n" ++
|
||||||
maybe return (addStringAsVariable "title-prefix")
|
"Specify an output file using the -o option, or " ++
|
||||||
(optTitlePrefix opts)
|
"use '-o -' to force output to stdout."
|
||||||
>>=
|
|
||||||
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)
|
|
||||||
|
|
||||||
abbrevs <- Set.fromList . filter (not . null) . lines <$>
|
abbrevs <- Set.fromList . filter (not . null) . lines <$>
|
||||||
case optAbbreviations opts of
|
case optAbbreviations opts of
|
||||||
Nothing -> UTF8.toString <$> readDataFile "abbreviations"
|
Nothing -> UTF8.toString <$> readDataFile "abbreviations"
|
||||||
Just f -> UTF8.toString <$> readFileStrict f
|
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" &&
|
metadata <- if format == "jats" &&
|
||||||
isNothing (lookup "csl" (optMetadata opts)) &&
|
isNothing (lookup "csl" (optMetadata opts)) &&
|
||||||
isNothing (lookup "citation-style" (optMetadata opts))
|
isNothing (lookup "citation-style" (optMetadata opts))
|
||||||
|
@ -355,41 +221,6 @@ convertWithOpts opts = do
|
||||||
Right l' -> setTranslations l'
|
Right l' -> setTranslations l'
|
||||||
Nothing -> setTranslations $ Lang "en" "" "US" []
|
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{
|
let readerOpts = def{
|
||||||
readerStandalone = standalone
|
readerStandalone = standalone
|
||||||
, readerColumns = optColumns opts
|
, readerColumns = optColumns opts
|
||||||
|
@ -412,7 +243,7 @@ convertWithOpts opts = do
|
||||||
(if extensionEnabled Ext_east_asian_line_breaks
|
(if extensionEnabled Ext_east_asian_line_breaks
|
||||||
readerExts &&
|
readerExts &&
|
||||||
not (extensionEnabled Ext_east_asian_line_breaks
|
not (extensionEnabled Ext_east_asian_line_breaks
|
||||||
writerExts &&
|
(writerExtensions writerOptions) &&
|
||||||
writerWrapText writerOptions == WrapPreserve)
|
writerWrapText writerOptions == WrapPreserve)
|
||||||
then (eastAsianLineBreakFilter :)
|
then (eastAsianLineBreakFilter :)
|
||||||
else id) $
|
else id) $
|
||||||
|
@ -450,7 +281,7 @@ convertWithOpts opts = do
|
||||||
|
|
||||||
case writer of
|
case writer of
|
||||||
ByteStringWriter f -> f writerOptions doc >>= writeFnBinary outputFile
|
ByteStringWriter f -> f writerOptions doc >>= writeFnBinary outputFile
|
||||||
TextWriter f -> case maybePdfProg of
|
TextWriter f -> case outputPdfProgram outputSettings of
|
||||||
Just pdfProg -> do
|
Just pdfProg -> do
|
||||||
res <- makePDF pdfProg (optPdfEngineArgs opts) f
|
res <- makePDF pdfProg (optPdfEngineArgs opts) f
|
||||||
writerOptions doc
|
writerOptions doc
|
||||||
|
@ -594,7 +425,3 @@ writerFn :: MonadIO m => IO.Newline -> FilePath -> Text -> m ()
|
||||||
-- TODO this implementation isn't maximally efficient:
|
-- TODO this implementation isn't maximally efficient:
|
||||||
writerFn eol "-" = liftIO . UTF8.putStrWith eol . T.unpack
|
writerFn eol "-" = liftIO . UTF8.putStrWith eol . T.unpack
|
||||||
writerFn eol f = liftIO . UTF8.writeFileWith eol f . 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
|
, optStripComments = False
|
||||||
}
|
}
|
||||||
|
|
||||||
lookupHighlightStyle :: Maybe String -> IO (Maybe Style)
|
lookupHighlightStyle :: String -> IO (Maybe Style)
|
||||||
lookupHighlightStyle Nothing = return Nothing
|
lookupHighlightStyle s
|
||||||
lookupHighlightStyle (Just s)
|
|
||||||
| takeExtension s == ".theme" = -- attempt to load KDE theme
|
| takeExtension s == ".theme" = -- attempt to load KDE theme
|
||||||
do contents <- B.readFile s
|
do contents <- B.readFile s
|
||||||
case parseTheme contents of
|
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