{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{- |
   Module      : Text.Pandoc.App
   Copyright   : Copyright (C) 2006-2024 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
  , sandbox'
  ) where
import qualified Data.Map as M
import qualified Data.Text as T
import Text.DocTemplates (toVal, Context(..), Val(..))
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.Except (throwError, catchError)
import Control.Monad.Trans
import Data.Char (toLower)
import Data.List (find)
import Data.Maybe (catMaybes, fromMaybe)
import Skylighting (defaultSyntaxMap)
import Skylighting.Parser (addSyntaxDefinition, parseSyntaxDefinition)
import System.Directory (getCurrentDirectory)
import System.Exit (exitSuccess)
import System.FilePath
import System.IO (stdout)
import Text.Pandoc.Chunks (PathTemplate(..))
import Text.Pandoc
import Text.Pandoc.App.Opt (Opt (..))
import Text.Pandoc.App.CommandLineOptions (engines)
import Text.Pandoc.Format (FlavoredFormat (..), applyExtensionsDiff,
                           parseFlavoredFormat, formatFromFilePaths)
import Text.Pandoc.Highlighting (lookupHighlightingStyle)
import Text.Pandoc.Scripting (ScriptingEngine (engineLoadCustom),
                              CustomComponents(..))
import qualified Text.Pandoc.UTF8 as UTF8

readUtf8File :: PandocMonad m => FilePath -> m T.Text
readUtf8File :: forall (m :: * -> *). PandocMonad m => FilePath -> m Text
readUtf8File FilePath
fp = FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileStrict FilePath
fp m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
fp

-- | Settings specifying how document output should be produced.
data OutputSettings m = OutputSettings
  { forall (m :: * -> *). OutputSettings m -> Text
outputFormat :: T.Text
  , forall (m :: * -> *). OutputSettings m -> Writer m
outputWriter :: Writer m
  , forall (m :: * -> *). OutputSettings m -> WriterOptions
outputWriterOptions :: WriterOptions
  , forall (m :: * -> *). OutputSettings m -> Maybe FilePath
outputPdfProgram :: Maybe String
  }

-- | Get output settings from command line options.
optToOutputSettings :: (PandocMonad m, MonadIO m)
                    => ScriptingEngine -> Opt -> m (OutputSettings m)
optToOutputSettings :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
ScriptingEngine -> Opt -> m (OutputSettings m)
optToOutputSettings ScriptingEngine
scriptingEngine Opt
opts = do
  let outputFile :: FilePath
outputFile = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"-" (Opt -> Maybe FilePath
optOutputFile Opt
opts)

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opt -> Bool
optDumpArgs Opt
opts) (m () -> m ()) -> (IO () -> m ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> Text -> IO ()
UTF8.hPutStrLn Handle
stdout (FilePath -> Text
T.pack FilePath
outputFile)
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Text -> IO ()
UTF8.hPutStrLn Handle
stdout (Text -> IO ()) -> (FilePath -> Text) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) ([FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [FilePath] -> [FilePath]) -> Maybe [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Opt -> Maybe [FilePath]
optInputFiles Opt
opts)
    IO ()
forall a. IO a
exitSuccess

  epubMetadata <- (FilePath -> m Text) -> Maybe FilePath -> m (Maybe Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse FilePath -> m Text
forall (m :: * -> *). PandocMonad m => FilePath -> m Text
readUtf8File (Maybe FilePath -> m (Maybe Text))
-> Maybe FilePath -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Opt -> Maybe FilePath
optEpubMetadata Opt
opts

  let pdfOutput = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (FilePath -> FilePath
takeExtension FilePath
outputFile) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".pdf" Bool -> Bool -> Bool
||
                  Opt -> Maybe Text
optTo Opt
opts Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"pdf"
  let defaultOutput = Text
"html"
  defaultOutputFlavor <- parseFlavoredFormat defaultOutput
  (flvrd@(FlavoredFormat format _extsDiff), maybePdfProg) <-
    if pdfOutput
       then do
         outflavor <- case optTo opts of
                        Just Text
x | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"pdf" -> FlavoredFormat -> Maybe FlavoredFormat
forall a. a -> Maybe a
Just (FlavoredFormat -> Maybe FlavoredFormat)
-> m FlavoredFormat -> m (Maybe FlavoredFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m FlavoredFormat
forall (m :: * -> *). PandocMonad m => Text -> m FlavoredFormat
parseFlavoredFormat Text
x
                        Maybe Text
_ -> Maybe FlavoredFormat -> m (Maybe FlavoredFormat)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FlavoredFormat
forall a. Maybe a
Nothing
         liftIO $ pdfWriterAndProg outflavor (optPdfEngine opts)
       else case optTo opts of
              Just Text
f -> (, Maybe FilePath
forall a. Maybe a
Nothing) (FlavoredFormat -> (FlavoredFormat, Maybe FilePath))
-> m FlavoredFormat -> m (FlavoredFormat, Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m FlavoredFormat
forall (m :: * -> *). PandocMonad m => Text -> m FlavoredFormat
parseFlavoredFormat Text
f
              Maybe Text
Nothing
               | FilePath
outputFile FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"-" ->
                   (FlavoredFormat, Maybe FilePath)
-> m (FlavoredFormat, Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FlavoredFormat
defaultOutputFlavor, Maybe FilePath
forall a. Maybe a
Nothing)
               | Bool
otherwise -> case [FilePath] -> Maybe FlavoredFormat
formatFromFilePaths [FilePath
outputFile] of
                   Maybe FlavoredFormat
Nothing -> do
                     LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> LogMessage
CouldNotDeduceFormat
                       [FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeExtension FilePath
outputFile] Text
defaultOutput
                     (FlavoredFormat, Maybe FilePath)
-> m (FlavoredFormat, Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FlavoredFormat
defaultOutputFlavor,Maybe FilePath
forall a. Maybe a
Nothing)
                   Just FlavoredFormat
f  -> (FlavoredFormat, Maybe FilePath)
-> m (FlavoredFormat, Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FlavoredFormat
f, Maybe FilePath
forall a. Maybe a
Nothing)

  when (format == "asciidoctor") $ do
    report $ Deprecated "asciidoctor" "use asciidoc instead"

  let makeSandboxed Writer PandocPure
pureWriter =
        case Writer PandocPure
pureWriter of
             TextWriter WriterOptions -> Pandoc -> PandocPure Text
w -> (WriterOptions -> Pandoc -> m Text) -> Writer m
forall (m :: * -> *).
(WriterOptions -> Pandoc -> m Text) -> Writer m
TextWriter ((WriterOptions -> Pandoc -> m Text) -> Writer m)
-> (WriterOptions -> Pandoc -> m Text) -> Writer m
forall a b. (a -> b) -> a -> b
$ \WriterOptions
o Pandoc
d -> Opt -> PandocPure Text -> m Text
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
Opt -> PandocPure a -> m a
sandbox' Opt
opts (WriterOptions -> Pandoc -> PandocPure Text
w WriterOptions
o Pandoc
d)
             ByteStringWriter WriterOptions -> Pandoc -> PandocPure ByteString
w -> (WriterOptions -> Pandoc -> m ByteString) -> Writer m
forall (m :: * -> *).
(WriterOptions -> Pandoc -> m ByteString) -> Writer m
ByteStringWriter ((WriterOptions -> Pandoc -> m ByteString) -> Writer m)
-> (WriterOptions -> Pandoc -> m ByteString) -> Writer m
forall a b. (a -> b) -> a -> b
$ \WriterOptions
o Pandoc
d -> Opt -> PandocPure ByteString -> m ByteString
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
Opt -> PandocPure a -> m a
sandbox' Opt
opts (WriterOptions -> Pandoc -> PandocPure ByteString
w WriterOptions
o Pandoc
d)

  let standalone = Opt -> Bool
optStandalone Opt
opts Bool -> Bool -> Bool
|| Text -> Bool
isBinaryFormat Text
format Bool -> Bool -> Bool
|| Bool
pdfOutput
  let templateOrThrow = \case
        Left  FilePath
e -> PandocError -> m a
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m a) -> PandocError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocTemplateError (FilePath -> Text
T.pack FilePath
e)
        Right a
t -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
t
  let processCustomTemplate m (Template a)
getDefault =
        case Opt -> Maybe FilePath
optTemplate Opt
opts of
          Maybe FilePath
_ | Bool -> Bool
not Bool
standalone -> Maybe (Template a) -> m (Maybe (Template a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Template a)
forall a. Maybe a
Nothing
          Maybe FilePath
Nothing -> Template a -> Maybe (Template a)
forall a. a -> Maybe a
Just (Template a -> Maybe (Template a))
-> m (Template a) -> m (Maybe (Template a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Template a)
getDefault
          Just FilePath
tp -> do
            let getAndCompile :: FilePath -> m (Maybe (Template a))
getAndCompile FilePath
fp =
                   FilePath -> m Text
forall (m :: * -> *). PandocMonad m => FilePath -> m Text
getTemplate FilePath
fp m Text
-> (Text -> m (Either FilePath (Template a)))
-> m (Either FilePath (Template a))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WithPartials m (Either FilePath (Template a))
-> m (Either FilePath (Template a))
forall (m :: * -> *) a. WithPartials m a -> m a
runWithPartials (WithPartials m (Either FilePath (Template a))
 -> m (Either FilePath (Template a)))
-> (Text -> WithPartials m (Either FilePath (Template a)))
-> Text
-> m (Either FilePath (Template a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> WithPartials m (Either FilePath (Template a))
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate FilePath
fp m (Either FilePath (Template a))
-> (Either FilePath (Template a) -> m (Maybe (Template a)))
-> m (Maybe (Template a))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                      (Template a -> Maybe (Template a))
-> m (Template a) -> m (Maybe (Template a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Template a -> Maybe (Template a)
forall a. a -> Maybe a
Just (m (Template a) -> m (Maybe (Template a)))
-> (Either FilePath (Template a) -> m (Template a))
-> Either FilePath (Template a)
-> m (Maybe (Template a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either FilePath (Template a) -> m (Template a)
forall {a}. Either FilePath a -> m a
templateOrThrow
            m (Maybe (Template a))
-> (PandocError -> m (Maybe (Template a)))
-> m (Maybe (Template a))
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
              (FilePath -> m (Maybe (Template a))
forall {a}.
(HasChars a, ToText a, FromText a) =>
FilePath -> m (Maybe (Template a))
getAndCompile FilePath
tp)
              (\PandocError
e ->
                  if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> FilePath
takeExtension FilePath
tp)
                     then FilePath -> m (Maybe (Template a))
forall {a}.
(HasChars a, ToText a, FromText a) =>
FilePath -> m (Maybe (Template a))
getAndCompile (FilePath
tp FilePath -> FilePath -> FilePath
<.> Text -> FilePath
T.unpack Text
format)
                     else PandocError -> m (Maybe (Template a))
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)

  (writer, writerExts, mtemplate) <-
    if "lua" `T.isSuffixOf` format
    then do
      let path = Text -> FilePath
T.unpack Text
format
      components <- engineLoadCustom scriptingEngine path
      w <- case customWriter components of
             Maybe (Writer m)
Nothing -> PandocError -> m (Writer m)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Writer m)) -> PandocError -> m (Writer m)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocAppError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$
                         Text
format Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not contain a custom writer"
             Just Writer m
w -> Writer m -> m (Writer m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Writer m
w
      let extsConf = ExtensionsConfig -> Maybe ExtensionsConfig -> ExtensionsConfig
forall a. a -> Maybe a -> a
fromMaybe ExtensionsConfig
forall a. Monoid a => a
mempty (Maybe ExtensionsConfig -> ExtensionsConfig)
-> Maybe ExtensionsConfig -> ExtensionsConfig
forall a b. (a -> b) -> a -> b
$ CustomComponents m -> Maybe ExtensionsConfig
forall (m :: * -> *). CustomComponents m -> Maybe ExtensionsConfig
customExtensions CustomComponents m
components
      wexts <- applyExtensionsDiff extsConf flvrd
      templ <- processCustomTemplate $
               case customTemplate components of
                 Maybe Text
Nothing -> PandocError -> m (Template Text)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (Template Text))
-> PandocError -> m (Template Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocNoTemplateError Text
format
                 Just Text
t -> WithDefaultPartials m (Either FilePath (Template Text))
-> m (Either FilePath (Template Text))
forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials (FilePath
-> Text -> WithDefaultPartials m (Either FilePath (Template Text))
forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
FilePath -> Text -> m (Either FilePath (Template a))
compileTemplate FilePath
path Text
t) m (Either FilePath (Template Text))
-> (Either FilePath (Template Text) -> m (Template Text))
-> m (Template Text)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                           Either FilePath (Template Text) -> m (Template Text)
forall {a}. Either FilePath a -> m a
templateOrThrow
      return (w, wexts, templ)
    else
      if optSandbox opts
      then do
        tmpl <- processCustomTemplate (compileDefaultTemplate format)
        case runPure (getWriter flvrd) of
             Right (Writer PandocPure
w, Extensions
wexts) -> (Writer m, Extensions, Maybe (Template Text))
-> m (Writer m, Extensions, Maybe (Template Text))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Writer PandocPure -> Writer m
forall {m :: * -> *}.
(PandocMonad m, MonadIO m) =>
Writer PandocPure -> Writer m
makeSandboxed Writer PandocPure
w, Extensions
wexts, Maybe (Template Text)
tmpl)
             Left PandocError
e           -> PandocError -> m (Writer m, Extensions, Maybe (Template Text))
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
      else do
        (w, wexts) <- getWriter flvrd
        tmpl <- processCustomTemplate (compileDefaultTemplate format)
        return (w, wexts, tmpl)


  let addSyntaxMap SyntaxMap
existingmap FilePath
f = do
        res <- IO (Either FilePath Syntax) -> m (Either FilePath Syntax)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Either FilePath Syntax)
parseSyntaxDefinition FilePath
f)
        case res of
              Left FilePath
errstr -> PandocError -> m SyntaxMap
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m SyntaxMap) -> PandocError -> m SyntaxMap
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSyntaxMapError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
errstr
              Right Syntax
syn   -> SyntaxMap -> m SyntaxMap
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxMap -> m SyntaxMap) -> SyntaxMap -> m SyntaxMap
forall a b. (a -> b) -> a -> b
$ Syntax -> SyntaxMap -> SyntaxMap
addSyntaxDefinition Syntax
syn SyntaxMap
existingmap

  syntaxMap <- foldM addSyntaxMap defaultSyntaxMap
                     (optSyntaxDefinitions opts)

  hlStyle <- traverse (lookupHighlightingStyle . T.unpack) $
               optHighlightStyle opts

  let setListVariableM Text
_ [] Context a
ctx = Context a -> m (Context a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Context a
ctx
      setListVariableM Text
k [a]
vs Context a
ctx = do
        let ctxMap :: Map Text (Val a)
ctxMap = Context a -> Map Text (Val a)
forall a. Context a -> Map Text (Val a)
unContext Context a
ctx
        Context a -> m (Context a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context a -> m (Context a)) -> Context a -> m (Context a)
forall a b. (a -> b) -> a -> b
$ Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val a) -> Context a) -> Map Text (Val a) -> Context a
forall a b. (a -> b) -> a -> b
$
          case Text -> Map Text (Val a) -> Maybe (Val a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k Map Text (Val a)
ctxMap of
              Just (ListVal [Val a]
xs) -> Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
k
                                  ([Val a] -> Val a
forall a. [Val a] -> Val a
ListVal ([Val a] -> Val a) -> [Val a] -> Val a
forall a b. (a -> b) -> a -> b
$ [Val a]
xs [Val a] -> [Val a] -> [Val a]
forall a. [a] -> [a] -> [a]
++ (a -> Val a) -> [a] -> [Val a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Val a
forall a b. ToContext a b => b -> Val a
toVal [a]
vs) Map Text (Val a)
ctxMap
              Just Val a
v -> Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
k
                         ([Val a] -> Val a
forall a. [Val a] -> Val a
ListVal ([Val a] -> Val a) -> [Val a] -> Val a
forall a b. (a -> b) -> a -> b
$ Val a
v Val a -> [Val a] -> [Val a]
forall a. a -> [a] -> [a]
: (a -> Val a) -> [a] -> [Val a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Val a
forall a b. ToContext a b => b -> Val a
toVal [a]
vs) Map Text (Val a)
ctxMap
              Maybe (Val a)
Nothing -> Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
k ([a] -> Val a
forall a b. ToContext a b => b -> Val a
toVal [a]
vs) Map Text (Val a)
ctxMap

  let getTextContents FilePath
fp = ((ByteString, Maybe Text) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Text) -> ByteString)
-> m (ByteString, Maybe Text) -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem (FilePath -> Text
T.pack FilePath
fp)) m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
fp

  let setFilesVariableM Text
k [FilePath]
fps Context a
ctx = do
        xs <- (FilePath -> m Text) -> [FilePath] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> m Text
forall (m :: * -> *). PandocMonad m => FilePath -> m Text
getTextContents [FilePath]
fps
        setListVariableM k xs ctx

  curdir <- liftIO getCurrentDirectory

  variables <-
    return (optVariables opts)
    >>=
    setListVariableM "sourcefile"
      (maybe ["-"] (fmap T.pack) (optInputFiles opts))
    >>=
    setVariableM "outputfile" (T.pack outputFile)
    >>=
    setVariableM "pandoc-version" pandocVersionText
    >>=
    setFilesVariableM "include-before" (optIncludeBeforeBody opts)
    >>=
    setFilesVariableM "include-after" (optIncludeAfterBody opts)
    >>=
    setFilesVariableM "header-includes" (optIncludeInHeader opts)
    >>=
    setListVariableM "css" (map T.pack $ optCss opts)
    >>=
    maybe return (setVariableM "title-prefix") (optTitlePrefix opts)
    >>=
    maybe return (setVariableM "epub-cover-image" . T.pack)
                 (optEpubCoverImage opts)
    >>=
    setVariableM "curdir" (T.pack curdir)
    >>=
    (\Context Text
vars ->  if Text
format Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dzslides"
                  then do
                      dztempl <-
                        let fp :: FilePath
fp = FilePath
"dzslides" FilePath -> FilePath -> FilePath
</> FilePath
"template.html"
                         in FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
fp m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
fp
                      let dzline = Text
"<!-- {{{{ dzslides core"
                      let dzcore = [Text] -> Text
T.unlines
                                 ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
dzline Text -> Text -> Bool
`T.isPrefixOf`))
                                 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
dztempl
                      setVariableM "dzslides-core" dzcore vars
                  else Context Text -> m (Context Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Context Text
vars)

  let writerOpts = WriterOptions
        { writerTemplate :: Maybe (Template Text)
writerTemplate         = Maybe (Template Text)
mtemplate
        , writerVariables :: Context Text
writerVariables        = Context Text
variables
        , writerTabStop :: Int
writerTabStop          = Opt -> Int
optTabStop Opt
opts
        , writerTableOfContents :: Bool
writerTableOfContents  = Opt -> Bool
optTableOfContents Opt
opts
        , writerListOfFigures :: Bool
writerListOfFigures    = Opt -> Bool
optListOfFigures Opt
opts
        , writerListOfTables :: Bool
writerListOfTables     = Opt -> Bool
optListOfTables Opt
opts
        , writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod   = Opt -> HTMLMathMethod
optHTMLMathMethod Opt
opts
        , writerIncremental :: Bool
writerIncremental      = Opt -> Bool
optIncremental Opt
opts
        , writerCiteMethod :: CiteMethod
writerCiteMethod       = Opt -> CiteMethod
optCiteMethod Opt
opts
        , writerNumberSections :: Bool
writerNumberSections   = Opt -> Bool
optNumberSections Opt
opts
        , writerNumberOffset :: [Int]
writerNumberOffset     = Opt -> [Int]
optNumberOffset Opt
opts
        , writerSectionDivs :: Bool
writerSectionDivs      = Opt -> Bool
optSectionDivs Opt
opts
        , writerExtensions :: Extensions
writerExtensions       = Extensions
writerExts
        , writerReferenceLinks :: Bool
writerReferenceLinks   = Opt -> Bool
optReferenceLinks Opt
opts
        , writerReferenceLocation :: ReferenceLocation
writerReferenceLocation = Opt -> ReferenceLocation
optReferenceLocation Opt
opts
        , writerFigureCaptionPosition :: CaptionPosition
writerFigureCaptionPosition = Opt -> CaptionPosition
optFigureCaptionPosition Opt
opts
        , writerTableCaptionPosition :: CaptionPosition
writerTableCaptionPosition = Opt -> CaptionPosition
optTableCaptionPosition Opt
opts
        , writerDpi :: Int
writerDpi              = Opt -> Int
optDpi Opt
opts
        , writerWrapText :: WrapOption
writerWrapText         = Opt -> WrapOption
optWrap Opt
opts
        , writerColumns :: Int
writerColumns          = Opt -> Int
optColumns Opt
opts
        , writerEmailObfuscation :: ObfuscationMethod
writerEmailObfuscation = Opt -> ObfuscationMethod
optEmailObfuscation Opt
opts
        , writerIdentifierPrefix :: Text
writerIdentifierPrefix = Opt -> Text
optIdentifierPrefix Opt
opts
        , writerHtmlQTags :: Bool
writerHtmlQTags        = Opt -> Bool
optHtmlQTags Opt
opts
        , writerTopLevelDivision :: TopLevelDivision
writerTopLevelDivision = Opt -> TopLevelDivision
optTopLevelDivision Opt
opts
        , writerListings :: Bool
writerListings         = Opt -> Bool
optListings Opt
opts
        , writerSlideLevel :: Maybe Int
writerSlideLevel       = Opt -> Maybe Int
optSlideLevel Opt
opts
        , writerHighlightStyle :: Maybe Style
writerHighlightStyle   = Maybe Style
hlStyle
        , writerSetextHeaders :: Bool
writerSetextHeaders    = Opt -> Bool
optSetextHeaders Opt
opts
        , writerListTables :: Bool
writerListTables       = Opt -> Bool
optListTables Opt
opts
        , writerEpubSubdirectory :: Text
writerEpubSubdirectory = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Opt -> FilePath
optEpubSubdirectory Opt
opts
        , writerEpubMetadata :: Maybe Text
writerEpubMetadata     = Maybe Text
epubMetadata
        , writerEpubFonts :: [FilePath]
writerEpubFonts        = Opt -> [FilePath]
optEpubFonts Opt
opts
        , writerEpubTitlePage :: Bool
writerEpubTitlePage    = Opt -> Bool
optEpubTitlePage Opt
opts
        , writerSplitLevel :: Int
writerSplitLevel       = Opt -> Int
optSplitLevel Opt
opts
        , writerChunkTemplate :: PathTemplate
writerChunkTemplate    = PathTemplate
-> (Text -> PathTemplate) -> Maybe Text -> PathTemplate
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> PathTemplate
PathTemplate Text
"%s-%i.html")
                                     Text -> PathTemplate
PathTemplate
                                     (Opt -> Maybe Text
optChunkTemplate Opt
opts)
        , writerTOCDepth :: Int
writerTOCDepth         = Opt -> Int
optTOCDepth Opt
opts
        , writerReferenceDoc :: Maybe FilePath
writerReferenceDoc     = Opt -> Maybe FilePath
optReferenceDoc Opt
opts
        , writerSyntaxMap :: SyntaxMap
writerSyntaxMap        = SyntaxMap
syntaxMap
        , writerPreferAscii :: Bool
writerPreferAscii      = Opt -> Bool
optAscii Opt
opts
        , writerLinkImages :: Bool
writerLinkImages       = Opt -> Bool
optLinkImages Opt
opts
        }
  return $ OutputSettings
    { outputFormat = format
    , outputWriter = writer
    , outputWriterOptions = writerOpts
    , outputPdfProgram = maybePdfProg
    }

-- | Set text value in text context unless it is already set.
setVariableM :: Monad m
             => T.Text -> T.Text -> Context T.Text -> m (Context T.Text)
setVariableM :: forall (m :: * -> *).
Monad m =>
Text -> Text -> Context Text -> m (Context Text)
setVariableM Text
key Text
val (Context Map Text (Val Text)
ctx) = Context Text -> m (Context Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context Text -> m (Context Text))
-> Context Text -> m (Context Text)
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$ (Maybe (Val Text) -> Maybe (Val Text))
-> Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe (Val Text) -> Maybe (Val Text)
forall {a}. ToContext a Text => Maybe (Val a) -> Maybe (Val a)
go Text
key Map Text (Val Text)
ctx
  where go :: Maybe (Val a) -> Maybe (Val a)
go Maybe (Val a)
Nothing             = Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just (Val a -> Maybe (Val a)) -> Val a -> Maybe (Val a)
forall a b. (a -> b) -> a -> b
$ Text -> Val a
forall a b. ToContext a b => b -> Val a
toVal Text
val
        go (Just Val a
x)            = Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just Val a
x

pdfWriterAndProg :: Maybe FlavoredFormat      -- ^ user-specified format
                 -> Maybe String              -- ^ user-specified pdf-engine
                 -> IO (FlavoredFormat, Maybe String) -- ^ format, pdf-engine
pdfWriterAndProg :: Maybe FlavoredFormat
-> Maybe FilePath -> IO (FlavoredFormat, Maybe FilePath)
pdfWriterAndProg Maybe FlavoredFormat
mWriter Maybe FilePath
mEngine =
  case Maybe FlavoredFormat
-> Maybe FilePath -> Either Text (FlavoredFormat, FilePath)
go Maybe FlavoredFormat
mWriter Maybe FilePath
mEngine of
      Right (FlavoredFormat
writ, FilePath
prog) -> (FlavoredFormat, Maybe FilePath)
-> IO (FlavoredFormat, Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FlavoredFormat
writ, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
prog)
      Left Text
err           -> IO (FlavoredFormat, Maybe FilePath)
-> IO (FlavoredFormat, Maybe FilePath)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FlavoredFormat, Maybe FilePath)
 -> IO (FlavoredFormat, Maybe FilePath))
-> IO (FlavoredFormat, Maybe FilePath)
-> IO (FlavoredFormat, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ PandocError -> IO (FlavoredFormat, Maybe FilePath)
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (PandocError -> IO (FlavoredFormat, Maybe FilePath))
-> PandocError -> IO (FlavoredFormat, Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocAppError Text
err
    where
      go :: Maybe FlavoredFormat
-> Maybe FilePath -> Either Text (FlavoredFormat, FilePath)
go Maybe FlavoredFormat
Nothing Maybe FilePath
Nothing       = (FlavoredFormat, FilePath)
-> Either Text (FlavoredFormat, FilePath)
forall a b. b -> Either a b
Right
                                 (Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat Text
"latex" ExtensionsDiff
forall a. Monoid a => a
mempty, FilePath
"pdflatex")
      go (Just FlavoredFormat
writer) Maybe FilePath
Nothing = (FlavoredFormat
writer,) (FilePath -> (FlavoredFormat, FilePath))
-> Either Text FilePath -> Either Text (FlavoredFormat, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FlavoredFormat -> Either Text FilePath
engineForWriter FlavoredFormat
writer
      go Maybe FlavoredFormat
Nothing (Just FilePath
engine) = (,FilePath
engine) (FlavoredFormat -> (FlavoredFormat, FilePath))
-> Either Text FlavoredFormat
-> Either Text (FlavoredFormat, FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Either Text FlavoredFormat
writerForEngine (FilePath -> FilePath
takeBaseName FilePath
engine)
      go (Just FlavoredFormat
writer) (Just FilePath
engine) | FlavoredFormat -> Bool
isCustomWriter FlavoredFormat
writer =
           -- custom writers can produce any format, so assume the user knows
           -- what they are doing.
           (FlavoredFormat, FilePath)
-> Either Text (FlavoredFormat, FilePath)
forall a b. b -> Either a b
Right (FlavoredFormat
writer, FilePath
engine)
      go (Just FlavoredFormat
writer) (Just FilePath
engine) =
           case ((Text, FilePath) -> Bool)
-> [(Text, FilePath)] -> Maybe (Text, FilePath)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text, FilePath) -> (Text, FilePath) -> Bool
forall a. Eq a => a -> a -> Bool
== (FlavoredFormat -> Text
formatName FlavoredFormat
writer, FilePath -> FilePath
takeBaseName FilePath
engine)) [(Text, FilePath)]
engines of
                Just (Text, FilePath)
_  -> (FlavoredFormat, FilePath)
-> Either Text (FlavoredFormat, FilePath)
forall a b. b -> Either a b
Right (FlavoredFormat
writer, FilePath
engine)
                Maybe (Text, FilePath)
Nothing -> Text -> Either Text (FlavoredFormat, FilePath)
forall a b. a -> Either a b
Left (Text -> Either Text (FlavoredFormat, FilePath))
-> Text -> Either Text (FlavoredFormat, FilePath)
forall a b. (a -> b) -> a -> b
$ Text
"pdf-engine " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
engine Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           Text
" is not compatible with output format " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                           FlavoredFormat -> Text
formatName FlavoredFormat
writer

      writerForEngine :: FilePath -> Either Text FlavoredFormat
writerForEngine FilePath
eng = case [Text
f | (Text
f,FilePath
e) <- [(Text, FilePath)]
engines, FilePath
e FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
eng] of
                                 Text
fmt : [Text]
_ -> FlavoredFormat -> Either Text FlavoredFormat
forall a b. b -> Either a b
Right (Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat Text
fmt ExtensionsDiff
forall a. Monoid a => a
mempty)
                                 []      -> Text -> Either Text FlavoredFormat
forall a b. a -> Either a b
Left (Text -> Either Text FlavoredFormat)
-> Text -> Either Text FlavoredFormat
forall a b. (a -> b) -> a -> b
$
                                   Text
"pdf-engine " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
eng Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not known"

      engineForWriter :: FlavoredFormat -> Either Text FilePath
engineForWriter (FlavoredFormat Text
"pdf" ExtensionsDiff
_) = Text -> Either Text FilePath
forall a b. a -> Either a b
Left Text
"pdf writer"
      engineForWriter FlavoredFormat
w = case [FilePath
e | (Text
f,FilePath
e) <- [(Text, FilePath)]
engines, Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FlavoredFormat -> Text
formatName FlavoredFormat
w] of
                                FilePath
eng : [FilePath]
_ -> FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
eng
                                []      -> Text -> Either Text FilePath
forall a b. a -> Either a b
Left (Text -> Either Text FilePath) -> Text -> Either Text FilePath
forall a b. (a -> b) -> a -> b
$
                                   Text
"cannot produce pdf output from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                                   FlavoredFormat -> Text
formatName FlavoredFormat
w

      isCustomWriter :: FlavoredFormat -> Bool
isCustomWriter FlavoredFormat
w = Text
".lua" Text -> Text -> Bool
`T.isSuffixOf` FlavoredFormat -> Text
formatName FlavoredFormat
w

isBinaryFormat :: T.Text -> Bool
isBinaryFormat :: Text -> Bool
isBinaryFormat Text
s =
  Text
s Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"odt",Text
"docx",Text
"epub2",Text
"epub3",Text
"epub",Text
"pptx",Text
"pdf",Text
"chunkedhtml"]

-- Like 'sandbox', but computes the list of files to preserve from
-- 'Opt'.
sandbox' :: (PandocMonad m, MonadIO m) => Opt -> PandocPure a -> m a
sandbox' :: forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
Opt -> PandocPure a -> m a
sandbox' Opt
opts = [FilePath] -> PandocPure a -> m a
forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
[FilePath] -> PandocPure a -> m a
sandbox [FilePath]
sandboxedFiles
 where
   sandboxedFiles :: [FilePath]
sandboxedFiles = [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes [ Opt -> Maybe FilePath
optReferenceDoc Opt
opts
                              , Opt -> Maybe FilePath
optEpubMetadata Opt
opts
                              , Opt -> Maybe FilePath
optEpubCoverImage Opt
opts
                              , Opt -> Maybe FilePath
optCSL Opt
opts
                              , Opt -> Maybe FilePath
optCitationAbbreviations Opt
opts
                              ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                    Opt -> [FilePath]
optEpubFonts Opt
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                    Opt -> [FilePath]
optBibliography Opt
opts