{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
   Module      : Text.Pandoc.App
   Copyright   : Copyright (C) 2006-2022 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 (
            convertWithOpts
          , Opt(..)
          , LineEnding(..)
          , Filter(..)
          , defaultOpts
          , parseOptions
          , parseOptionsFromArgs
          , options
          , applyFilters
          ) where
import qualified Control.Exception as E
import Control.Monad ( (>=>), when, forM_ )
import Control.Monad.Trans ( MonadIO(..) )
import Control.Monad.Catch ( MonadMask )
import Control.Monad.Except (throwError, catchError)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (fromMaybe, isJust, isNothing)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TE
import qualified Data.Text.Encoding as TSE
import qualified Data.Text.Encoding.Error as TE
import qualified Data.Text.Encoding.Error as TSE
import Network.URI (URI (..), parseURI)
import System.Directory (doesDirectoryExist)
import System.Exit (exitSuccess)
import System.FilePath ( takeBaseName, takeExtension)
import System.IO (nativeNewline, stdout)
import qualified System.IO as IO (Newline (..))
import Text.Pandoc
import Text.Pandoc.Builder (setMeta)
import Text.Pandoc.MediaBag (mediaItems)
import Text.Pandoc.MIME (getCharset, MimeType)
import Text.Pandoc.Image (svgToPng)
import Text.Pandoc.App.FormatHeuristics (formatFromFilePaths)
import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), defaultOpts,
                            IpynbOutput (..))
import Text.Pandoc.App.CommandLineOptions (parseOptions, parseOptionsFromArgs,
                                           options)
import Text.Pandoc.App.OutputSettings (OutputSettings (..), optToOutputSettings)
import Text.Collate.Lang (Lang (..), parseLang)
import Text.Pandoc.Filter (Filter (JSONFilter, LuaFilter), Environment (..),
                           applyFilters)
import Text.Pandoc.PDF (makePDF)
import Text.Pandoc.SelfContained (makeSelfContained)
import Text.Pandoc.Shared (eastAsianLineBreakFilter, stripEmptyParagraphs,
         headerShift, isURI, tabFilter, uriPathToPath, filterIpynbOutput,
         defaultUserDataDir, tshow)
import Text.Pandoc.Writers.Shared (lookupMetaString)
import Text.Pandoc.Readers.Markdown (yamlToMeta)
import Text.Pandoc.Readers.Custom (readCustom)
import qualified Text.Pandoc.UTF8 as UTF8
#ifndef _WINDOWS
import System.Posix.IO (stdOutput)
import System.Posix.Terminal (queryTerminal)
#endif

convertWithOpts :: Opt -> IO ()
convertWithOpts :: Opt -> IO ()
convertWithOpts Opt
opts = do
  let outputFile :: FilePath
outputFile = forall a. a -> Maybe a -> a
fromMaybe FilePath
"-" (Opt -> Maybe FilePath
optOutputFile Opt
opts)
  Maybe FilePath
datadir <- case Opt -> Maybe FilePath
optDataDir Opt
opts of
                  Maybe FilePath
Nothing   -> do
                    FilePath
d <- IO FilePath
defaultUserDataDir
                    Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
d
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
exists
                                then forall a. a -> Maybe a
Just FilePath
d
                                else forall a. Maybe a
Nothing
                  Just FilePath
_    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Opt -> Maybe FilePath
optDataDir Opt
opts

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

#ifdef _WINDOWS
  let istty = True
#else
  Bool
istty <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Fd -> IO Bool
queryTerminal Fd
stdOutput
#endif

  Either PandocError (PandocOutput, [LogMessage])
res <- forall a. PandocIO a -> IO (Either PandocError a)
runIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(PandocMonad m, MonadIO m, MonadMask m) =>
Bool -> Maybe FilePath -> Opt -> m (PandocOutput, [LogMessage])
convertWithOpts' Bool
istty Maybe FilePath
datadir Opt
opts
  case Either PandocError (PandocOutput, [LogMessage])
res of
    Left PandocError
e -> forall e a. Exception e => e -> IO a
E.throwIO PandocError
e
    Right (PandocOutput
output, [LogMessage]
reports) -> do
      case Opt -> Maybe FilePath
optLogFile Opt
opts of
           Maybe FilePath
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Just FilePath
logfile -> FilePath -> ByteString -> IO ()
BL.writeFile FilePath
logfile ([LogMessage] -> ByteString
encodeLogMessages [LogMessage]
reports)
      let isWarning :: LogMessage -> Bool
isWarning LogMessage
msg = LogMessage -> Verbosity
messageVerbosity LogMessage
msg forall a. Eq a => a -> a -> Bool
== Verbosity
WARNING
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opt -> Bool
optFailIfWarnings Opt
opts Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LogMessage -> Bool
isWarning [LogMessage]
reports) forall a b. (a -> b) -> a -> b
$
          forall e a. Exception e => e -> IO a
E.throwIO PandocError
PandocFailOnWarningError
      let eol :: Newline
eol = case Opt -> LineEnding
optEol Opt
opts of
                     LineEnding
CRLF   -> Newline
IO.CRLF
                     LineEnding
LF     -> Newline
IO.LF
                     LineEnding
Native -> Newline
nativeNewline
      case PandocOutput
output of
        TextOutput Text
t    -> Newline -> FilePath -> Text -> IO ()
writerFn Newline
eol FilePath
outputFile Text
t
        BinaryOutput ByteString
bs -> FilePath -> ByteString -> IO ()
writeFnBinary FilePath
outputFile ByteString
bs

convertWithOpts' :: (PandocMonad m, MonadIO m, MonadMask m)
                 => Bool
                 -> Maybe FilePath
                 -> Opt
                 -> m (PandocOutput, [LogMessage])
convertWithOpts' :: forall (m :: * -> *).
(PandocMonad m, MonadIO m, MonadMask m) =>
Bool -> Maybe FilePath -> Opt -> m (PandocOutput, [LogMessage])
convertWithOpts' Bool
istty Maybe FilePath
datadir Opt
opts = do
  let outputFile :: FilePath
outputFile = forall a. a -> Maybe a -> a
fromMaybe FilePath
"-" (Opt -> Maybe FilePath
optOutputFile Opt
opts)
  let filters :: [Filter]
filters = Opt -> [Filter]
optFilters Opt
opts
  let verbosity :: Verbosity
verbosity = Opt -> Verbosity
optVerbosity Opt
opts

  let sources :: [FilePath]
sources = case Opt -> Maybe [FilePath]
optInputFiles Opt
opts of
                     Just [FilePath]
xs | Bool -> Bool
not (Opt -> Bool
optIgnoreArgs Opt
opts) -> [FilePath]
xs
                     Maybe [FilePath]
_ -> [FilePath
"-"]
  forall (m :: * -> *). PandocMonad m => Bool -> m ()
setTrace (Opt -> Bool
optTrace Opt
opts)
  forall (m :: * -> *). PandocMonad m => Verbosity -> m ()
setVerbosity Verbosity
verbosity
  forall (m :: * -> *). PandocMonad m => Maybe FilePath -> m ()
setUserDataDir Maybe FilePath
datadir
  forall (m :: * -> *). PandocMonad m => [FilePath] -> m ()
setResourcePath (Opt -> [FilePath]
optResourcePath Opt
opts)

  forall (m :: * -> *). PandocMonad m => [FilePath] -> m ()
setInputFiles (forall a. a -> Maybe a -> a
fromMaybe [FilePath
"-"] (Opt -> Maybe [FilePath]
optInputFiles Opt
opts))
  forall (m :: * -> *). PandocMonad m => Maybe FilePath -> m ()
setOutputFile (Opt -> Maybe FilePath
optOutputFile Opt
opts)

  -- assign reader and writer based on options and filenames
  Text
readerName <- case Opt -> Maybe Text
optFrom Opt
opts of
                     Just Text
f  -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
f
                     Maybe Text
Nothing -> case [FilePath] -> Maybe Text
formatFromFilePaths [FilePath]
sources of
                         Just Text
f' -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
f'
                         Maybe Text
Nothing | [FilePath]
sources forall a. Eq a => a -> a -> Bool
== [FilePath
"-"] -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"markdown"
                                 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Bool
isURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) [FilePath]
sources -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"html"
                                 | Bool
otherwise -> do
                           forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> LogMessage
CouldNotDeduceFormat
                               (forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
sources) Text
"markdown"
                           forall (m :: * -> *) a. Monad m => a -> m a
return Text
"markdown"

  let readerNameBase :: Text
readerNameBase = (Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'+' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'-') Text
readerName

  let makeSandboxed :: Reader PandocPure -> Reader m
makeSandboxed Reader PandocPure
pureReader =
        let files :: [FilePath]
files = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) (Opt -> Maybe FilePath
optReferenceDoc Opt
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) (Opt -> Maybe FilePath
optEpubMetadata Opt
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) (Opt -> Maybe FilePath
optEpubCoverImage Opt
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) (Opt -> Maybe FilePath
optCSL Opt
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) (Opt -> Maybe FilePath
optCitationAbbreviations Opt
opts) forall a b. (a -> b) -> a -> b
$
                    Opt -> [FilePath]
optEpubFonts Opt
opts forall a. [a] -> [a] -> [a]
++
                    Opt -> [FilePath]
optBibliography Opt
opts
         in  case Reader PandocPure
pureReader of
               TextReader forall a. ToSources a => ReaderOptions -> a -> PandocPure Pandoc
r -> forall (m :: * -> *).
(forall a. ToSources a => ReaderOptions -> a -> m Pandoc)
-> Reader m
TextReader forall a b. (a -> b) -> a -> b
$ \ReaderOptions
o a
t -> forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
[FilePath] -> PandocPure a -> m a
sandbox [FilePath]
files (forall a. ToSources a => ReaderOptions -> a -> PandocPure Pandoc
r ReaderOptions
o a
t)
               ByteStringReader ReaderOptions -> ByteString -> PandocPure Pandoc
r
                          -> forall (m :: * -> *).
(ReaderOptions -> ByteString -> m Pandoc) -> Reader m
ByteStringReader forall a b. (a -> b) -> a -> b
$ \ReaderOptions
o ByteString
t -> forall (m :: * -> *) a.
(PandocMonad m, MonadIO m) =>
[FilePath] -> PandocPure a -> m a
sandbox [FilePath]
files (ReaderOptions -> ByteString -> PandocPure Pandoc
r ReaderOptions
o ByteString
t)

  (Reader m
reader, Extensions
readerExts) <-
    if Text
".lua" Text -> Text -> Bool
`T.isSuffixOf` Text
readerName
       then forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
(forall a. ToSources a => ReaderOptions -> a -> m Pandoc)
-> Reader m
TextReader (forall (m :: * -> *) s.
(PandocMonad m, MonadIO m, ToSources s) =>
FilePath -> ReaderOptions -> s -> m Pandoc
readCustom (Text -> FilePath
T.unpack Text
readerName)), forall a. Monoid a => a
mempty)
       else if Opt -> Bool
optSandbox Opt
opts
               then case forall a. PandocPure a -> Either PandocError a
runPure (forall (m :: * -> *).
PandocMonad m =>
Text -> m (Reader m, Extensions)
getReader Text
readerName) of
                      Left PandocError
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e
                      Right (Reader PandocPure
r, Extensions
rexts) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall {m :: * -> *}.
(PandocMonad m, MonadIO m) =>
Reader PandocPure -> Reader m
makeSandboxed Reader PandocPure
r, Extensions
rexts)
               else forall (m :: * -> *).
PandocMonad m =>
Text -> m (Reader m, Extensions)
getReader Text
readerName

  OutputSettings m
outputSettings <- forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Opt -> m (OutputSettings m)
optToOutputSettings Opt
opts
  let format :: Text
format = forall (m :: * -> *). OutputSettings m -> Text
outputFormat OutputSettings m
outputSettings
  let writer :: Writer m
writer = forall (m :: * -> *). OutputSettings m -> Writer m
outputWriter OutputSettings m
outputSettings
  let writerName :: Text
writerName = forall (m :: * -> *). OutputSettings m -> Text
outputWriterName OutputSettings m
outputSettings
  let writerNameBase :: Text
writerNameBase = (Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'+' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'-') Text
writerName
  let writerOptions :: WriterOptions
writerOptions = forall (m :: * -> *). OutputSettings m -> WriterOptions
outputWriterOptions OutputSettings m
outputSettings

  let pdfOutput :: Bool
pdfOutput = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). OutputSettings m -> Maybe FilePath
outputPdfProgram OutputSettings m
outputSettings

  let bibOutput :: Bool
bibOutput = Text
writerNameBase forall a. Eq a => a -> a -> Bool
== Text
"bibtex" Bool -> Bool -> Bool
||
                  Text
writerNameBase forall a. Eq a => a -> a -> Bool
== Text
"biblatex" Bool -> Bool -> Bool
||
                  Text
writerNameBase forall a. Eq a => a -> a -> Bool
== Text
"csljson"

  let standalone :: Bool
standalone = Opt -> Bool
optStandalone Opt
opts Bool -> Bool -> Bool
||
                   Bool -> Bool
not (Text -> Bool
isTextFormat Text
format) Bool -> Bool -> Bool
||
                   Bool
pdfOutput Bool -> Bool -> Bool
||
                   Bool
bibOutput

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
pdfOutput Bool -> Bool -> Bool
&& Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"latex") forall a b. (a -> b) -> a -> b
$
    case Opt -> Maybe [FilePath]
optInputFiles Opt
opts of
      Just (FilePath
inputFile:[FilePath]
_) -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
UnusualConversion forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$
        FilePath
"to convert a .tex file to PDF, you get better results by using pdflatex "
          forall a. Semigroup a => a -> a -> a
<> FilePath
"(or lualatex or xelatex) directly, try `pdflatex " forall a. Semigroup a => a -> a -> a
<> FilePath
inputFile
          forall a. Semigroup a => a -> a -> a
<> FilePath
"` instead of `pandoc " forall a. Semigroup a => a -> a -> a
<> FilePath
inputFile forall a. Semigroup a => a -> a -> a
<> FilePath
" -o " forall a. Semigroup a => a -> a -> a
<> FilePath
outputFile forall a. Semigroup a => a -> a -> a
<> FilePath
"`."
      Maybe [FilePath]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- 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.
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool
pdfOutput Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
isTextFormat Text
format)) Bool -> Bool -> Bool
&&
           Bool
istty Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing ( Opt -> Maybe FilePath
optOutputFile Opt
opts)) forall a b. (a -> b) -> a -> b
$
    forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocAppError forall a b. (a -> b) -> a -> b
$
            Text
"Cannot write " forall a. Semigroup a => a -> a -> a
<> (if Bool
pdfOutput then Text
"pdf" else Text
format) forall a. Semigroup a => a -> a -> a
<>
            Text
" output to terminal.\n" forall a. Semigroup a => a -> a -> a
<>
            Text
"Specify an output file using the -o option, or " forall a. Semigroup a => a -> a -> a
<>
            Text
"use '-o -' to force output to stdout."


  Set Text
abbrevs <- forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             case Opt -> Maybe FilePath
optAbbreviations Opt
opts of
                  Maybe FilePath
Nothing -> forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readDataFile FilePath
"abbreviations"
                  Just FilePath
f  -> forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileStrict FilePath
f

  case Text -> Meta -> Text
lookupMetaString Text
"lang" (Opt -> Meta
optMetadata Opt
opts) of
         Text
""      -> forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [(Text, [(Text, Text)])]
-> [Text]
-> Lang
Lang Text
"en" forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"US") [] [] []
         Text
l       -> case Text -> Either FilePath Lang
parseLang Text
l of
                         Left FilePath
_   -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
InvalidLang Text
l
                         Right Lang
l' -> forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations Lang
l'

  let readerOpts :: ReaderOptions
readerOpts = forall a. Default a => a
def{
          readerStandalone :: Bool
readerStandalone = Bool
standalone
        , readerColumns :: Int
readerColumns = Opt -> Int
optColumns Opt
opts
        , readerTabStop :: Int
readerTabStop = Opt -> Int
optTabStop Opt
opts
        , readerIndentedCodeClasses :: [Text]
readerIndentedCodeClasses = Opt -> [Text]
optIndentedCodeClasses Opt
opts
        , readerDefaultImageExtension :: Text
readerDefaultImageExtension =
           Opt -> Text
optDefaultImageExtension Opt
opts
        , readerTrackChanges :: TrackChanges
readerTrackChanges = Opt -> TrackChanges
optTrackChanges Opt
opts
        , readerAbbreviations :: Set Text
readerAbbreviations = Set Text
abbrevs
        , readerExtensions :: Extensions
readerExtensions = Extensions
readerExts
        , readerStripComments :: Bool
readerStripComments = Opt -> Bool
optStripComments Opt
opts
        }

  Meta
metadataFromFile <-
    case Opt -> [FilePath]
optMetadataFiles Opt
opts of
      []    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
      [FilePath]
paths -> do
        -- If format is markdown or commonmark, use the enabled extensions,
        -- otherwise treat metadata as pandoc markdown (see #7926, #6832)
        let readerOptsMeta :: ReaderOptions
readerOptsMeta =
              if Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"markdown" Bool -> Bool -> Bool
|| Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"commonmark"
                 then ReaderOptions
readerOpts
                 else ReaderOptions
readerOpts{ readerExtensions :: Extensions
readerExtensions = Extensions
pandocExtensions }
        forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
              (\FilePath
path -> do ByteString
raw <- forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readMetadataFile FilePath
path
                           forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Maybe FilePath -> ByteString -> m Meta
yamlToMeta ReaderOptions
readerOptsMeta (forall a. a -> Maybe a
Just FilePath
path) ByteString
raw) [FilePath]
paths

  let transforms :: [Pandoc -> Pandoc]
transforms = (case Opt -> Int
optShiftHeadingLevelBy Opt
opts of
                        Int
0             -> forall a. a -> a
id
                        Int
x             -> (Int -> Pandoc -> Pandoc
headerShift Int
x forall a. a -> [a] -> [a]
:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (if Opt -> Bool
optStripEmptyParagraphs Opt
opts
                       then (Pandoc -> Pandoc
stripEmptyParagraphs forall a. a -> [a] -> [a]
:)
                       else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_east_asian_line_breaks
                          Extensions
readerExts Bool -> Bool -> Bool
&&
                       Bool -> Bool
not (Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_east_asian_line_breaks
                            (WriterOptions -> Extensions
writerExtensions WriterOptions
writerOptions) Bool -> Bool -> Bool
&&
                            WriterOptions -> WrapOption
writerWrapText WriterOptions
writerOptions forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve)
                       then (Pandoc -> Pandoc
eastAsianLineBreakFilter forall a. a -> [a] -> [a]
:)
                       else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (case Opt -> IpynbOutput
optIpynbOutput Opt
opts of
                     IpynbOutput
_ | Text
readerNameBase forall a. Eq a => a -> a -> Bool
/= Text
"ipynb" -> forall a. a -> a
id
                     IpynbOutput
IpynbOutputAll  -> forall a. a -> a
id
                     IpynbOutput
IpynbOutputNone -> (Maybe Format -> Pandoc -> Pandoc
filterIpynbOutput forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
:)
                     IpynbOutput
IpynbOutputBest -> (Maybe Format -> Pandoc -> Pandoc
filterIpynbOutput (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
                                   if Text -> Bool
htmlFormat Text
format
                                      then Text -> Format
Format Text
"html"
                                      else
                                        case Text
format of
                                          Text
"latex"  -> Text -> Format
Format Text
"latex"
                                          Text
"beamer" -> Text -> Format
Format Text
"latex"
                                          Text
_        -> Text -> Format
Format Text
format) forall a. a -> [a] -> [a]
:))
                   forall a b. (a -> b) -> a -> b
$ []

  let convertTabs :: Text -> Text
convertTabs = Int -> Text -> Text
tabFilter (if Opt -> Bool
optPreserveTabs Opt
opts Bool -> Bool -> Bool
||
                                    Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"t2t" Bool -> Bool -> Bool
||
                                    Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"man" Bool -> Bool -> Bool
||
                                    Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"tsv"
                                  then Int
0
                                  else Opt -> Int
optTabStop Opt
opts)


  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"markdown_github" Bool -> Bool -> Bool
||
        Text
writerNameBase forall a. Eq a => a -> a -> Bool
== Text
"markdown_github") forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
Deprecated Text
"markdown_github" Text
"Use gfm instead."

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). PandocMonad m => Text -> Text -> m ()
setRequestHeader) (Opt -> [(Text, Text)]
optRequestHeaders Opt
opts)

  forall (m :: * -> *). PandocMonad m => Bool -> m ()
setNoCheckCertificate (Opt -> Bool
optNoCheckCertificate Opt
opts)

  let isPandocCiteproc :: Filter -> Bool
isPandocCiteproc (JSONFilter FilePath
f) = FilePath -> FilePath
takeBaseName FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
"pandoc-citeproc"
      isPandocCiteproc Filter
_              = Bool
False

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Filter -> Bool
isPandocCiteproc [Filter]
filters) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
Deprecated Text
"pandoc-citeproc filter"
             Text
"Use --citeproc instead."

  let cslMetadata :: Meta
cslMetadata =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"csl") (Opt -> Maybe FilePath
optCSL Opt
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (case Opt -> [FilePath]
optBibliography Opt
opts of
           [] -> forall a. a -> a
id
           [FilePath]
xs -> forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"bibliography" [FilePath]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
"citation-abbreviations")
                       (Opt -> Maybe FilePath
optCitationAbbreviations Opt
opts) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty

  let filterEnv :: Environment
filterEnv = ReaderOptions -> WriterOptions -> Environment
Environment ReaderOptions
readerOpts WriterOptions
writerOptions

  [(FilePath, (ByteString, Maybe Text))]
inputs <- forall (m :: * -> *).
PandocMonad m =>
[FilePath] -> m [(FilePath, (ByteString, Maybe Text))]
readSources [FilePath]
sources

  Pandoc
doc <- (case Reader m
reader of
           TextReader forall a. ToSources a => ReaderOptions -> a -> m Pandoc
r
             | Text
readerNameBase forall a. Eq a => a -> a -> Bool
== Text
"json" ->
                 forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
(Text -> Text)
-> (FilePath, (ByteString, Maybe Text)) -> m (FilePath, Text)
inputToText Text -> Text
convertTabs
                           forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. ToSources a => ReaderOptions -> a -> m Pandoc
r ReaderOptions
readerOpts forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])) [(FilePath, (ByteString, Maybe Text))]
inputs
             | Opt -> Bool
optFileScope Opt
opts  ->
                 forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                    (forall (m :: * -> *).
PandocMonad m =>
(Text -> Text)
-> (FilePath, (ByteString, Maybe Text)) -> m (FilePath, Text)
inputToText Text -> Text
convertTabs
                           forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. ToSources a => ReaderOptions -> a -> m Pandoc
r ReaderOptions
readerOpts forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]))
                    [(FilePath, (ByteString, Maybe Text))]
inputs
             | Bool
otherwise -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
(Text -> Text)
-> (FilePath, (ByteString, Maybe Text)) -> m (FilePath, Text)
inputToText Text -> Text
convertTabs) [(FilePath, (ByteString, Maybe Text))]
inputs
                              forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ToSources a => ReaderOptions -> a -> m Pandoc
r ReaderOptions
readerOpts
           ByteStringReader ReaderOptions -> ByteString -> m Pandoc
r ->
             forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ReaderOptions -> ByteString -> m Pandoc
r ReaderOptions
readerOpts forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, (ByteString, Maybe Text)) -> ByteString
inputToLazyByteString) [(FilePath, (ByteString, Maybe Text))]
inputs)
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Meta -> Meta) -> Pandoc -> Pandoc
adjustMetadata (Meta
metadataFromFile forall a. Semigroup a => a -> a -> a
<>)
            forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Meta -> Meta) -> Pandoc -> Pandoc
adjustMetadata (forall a. Semigroup a => a -> a -> a
<> Opt -> Meta
optMetadata Opt
opts)
            forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Meta -> Meta) -> Pandoc -> Pandoc
adjustMetadata (forall a. Semigroup a => a -> a -> a
<> Meta
cslMetadata)
            forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *).
Monad m =>
[Pandoc -> Pandoc] -> Pandoc -> m Pandoc
applyTransforms [Pandoc -> Pandoc]
transforms
            forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
Environment -> [Filter] -> [FilePath] -> Pandoc -> m Pandoc
applyFilters Environment
filterEnv [Filter]
filters [Text -> FilePath
T.unpack Text
format]
            forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (if Bool -> Bool
not (Opt -> Bool
optSandbox Opt
opts) Bool -> Bool -> Bool
&&
                    (forall a. Maybe a -> Bool
isJust (Opt -> Maybe FilePath
optExtractMedia Opt
opts)
                     Bool -> Bool -> Bool
|| Text
writerNameBase forall a. Eq a => a -> a -> Bool
== Text
"docx") -- for fallback pngs
                 then forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
fillMediaBag
                 else forall (m :: * -> *) a. Monad m => a -> m a
return)
            forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
FilePath -> Pandoc -> m Pandoc
extractMedia (Opt -> Maybe FilePath
optExtractMedia Opt
opts)
            )

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
writerNameBase forall a. Eq a => a -> a -> Bool
== Text
"docx" Bool -> Bool -> Bool
&& Bool -> Bool
not (Opt -> Bool
optSandbox Opt
opts)) forall a b. (a -> b) -> a -> b
$ do
    -- create fallback pngs for svgs
    [(FilePath, Text, ByteString)]
items <- MediaBag -> [(FilePath, Text, ByteString)]
mediaItems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(FilePath, Text, ByteString)]
items forall a b. (a -> b) -> a -> b
$ \(FilePath
fp, Text
mt, ByteString
bs) ->
      case (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
';') Text
mt of
        Text
"image/svg+xml" -> do
          Either Text ByteString
res <- forall (m :: * -> *).
MonadIO m =>
Int -> ByteString -> m (Either Text ByteString)
svgToPng (WriterOptions -> Int
writerDpi WriterOptions
writerOptions) ByteString
bs
          case Either Text ByteString
res of
            Right ByteString
bs' -> do
              let fp' :: FilePath
fp' = FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
".png"
              forall (m :: * -> *).
PandocMonad m =>
FilePath -> Maybe Text -> ByteString -> m ()
insertMedia FilePath
fp' (forall a. a -> Maybe a
Just Text
"image/png") ByteString
bs'
            Left Text
e -> forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotConvertImage (FilePath -> Text
T.pack FilePath
fp) (forall a. Show a => a -> Text
tshow Text
e)
        Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  PandocOutput
output <- case Writer m
writer of
    ByteStringWriter WriterOptions -> Pandoc -> m ByteString
f -> ByteString -> PandocOutput
BinaryOutput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> m ByteString
f WriterOptions
writerOptions Pandoc
doc
    TextWriter WriterOptions -> Pandoc -> m Text
f -> case forall (m :: * -> *). OutputSettings m -> Maybe FilePath
outputPdfProgram OutputSettings m
outputSettings of
      Just FilePath
pdfProg -> do
              Either ByteString ByteString
res <- forall (m :: * -> *).
(PandocMonad m, MonadIO m, MonadMask m) =>
FilePath
-> [FilePath]
-> (WriterOptions -> Pandoc -> m Text)
-> WriterOptions
-> Pandoc
-> m (Either ByteString ByteString)
makePDF FilePath
pdfProg (Opt -> [FilePath]
optPdfEngineOpts Opt
opts) WriterOptions -> Pandoc -> m Text
f
                      WriterOptions
writerOptions Pandoc
doc
              case Either ByteString ByteString
res of
                   Right ByteString
pdf -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> PandocOutput
BinaryOutput ByteString
pdf
                   Left ByteString
err' -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocPDFError forall a b. (a -> b) -> a -> b
$
                                   Text -> Text
TL.toStrict (OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TE.lenientDecode ByteString
err')

      Maybe FilePath
Nothing -> do
              let ensureNl :: Text -> Text
ensureNl Text
t
                    | Bool
standalone = Text
t
                    | Text -> Bool
T.null Text
t Bool -> Bool -> Bool
|| Text -> Char
T.last Text
t forall a. Eq a => a -> a -> Bool
/= Char
'\n' = Text
t forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
'\n'
                    | Bool
otherwise = Text
t
              Text
textOutput <- Text -> Text
ensureNl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> m Text
f WriterOptions
writerOptions Pandoc
doc
              if (Opt -> Bool
optSelfContained Opt
opts Bool -> Bool -> Bool
|| Opt -> Bool
optEmbedResources Opt
opts) Bool -> Bool -> Bool
&& Text -> Bool
htmlFormat Text
format
                 then Text -> PandocOutput
TextOutput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Text -> m Text
makeSelfContained Text
textOutput
                 else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> PandocOutput
TextOutput Text
textOutput
  [LogMessage]
reports <- forall (m :: * -> *). PandocMonad m => m [LogMessage]
getLog
  forall (m :: * -> *) a. Monad m => a -> m a
return (PandocOutput
output, [LogMessage]
reports)

data PandocOutput = TextOutput Text | BinaryOutput BL.ByteString
  deriving (Int -> PandocOutput -> FilePath -> FilePath
[PandocOutput] -> FilePath -> FilePath
PandocOutput -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [PandocOutput] -> FilePath -> FilePath
$cshowList :: [PandocOutput] -> FilePath -> FilePath
show :: PandocOutput -> FilePath
$cshow :: PandocOutput -> FilePath
showsPrec :: Int -> PandocOutput -> FilePath -> FilePath
$cshowsPrec :: Int -> PandocOutput -> FilePath -> FilePath
Show)

type Transform = Pandoc -> Pandoc

htmlFormat :: Text -> Bool
htmlFormat :: Text -> Bool
htmlFormat = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"html",Text
"html4",Text
"html5",Text
"s5",Text
"slidy",
                      Text
"slideous",Text
"dzslides",Text
"revealjs"])

isTextFormat :: Text -> Bool
isTextFormat :: Text -> Bool
isTextFormat Text
s = Text
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"odt",Text
"docx",Text
"epub2",Text
"epub3",Text
"epub",Text
"pptx"]

adjustMetadata :: (Meta -> Meta) -> Pandoc -> Pandoc
adjustMetadata :: (Meta -> Meta) -> Pandoc -> Pandoc
adjustMetadata Meta -> Meta
f (Pandoc Meta
meta [Block]
bs) = Meta -> [Block] -> Pandoc
Pandoc (Meta -> Meta
f Meta
meta) [Block]
bs

-- Transformations of a Pandoc document post-parsing:

applyTransforms :: Monad m => [Transform] -> Pandoc -> m Pandoc
applyTransforms :: forall (m :: * -> *).
Monad m =>
[Pandoc -> Pandoc] -> Pandoc -> m Pandoc
applyTransforms [Pandoc -> Pandoc]
transforms Pandoc
d = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
($) Pandoc
d [Pandoc -> Pandoc]
transforms

readSources :: PandocMonad m
            => [FilePath] -> m [(FilePath, (BS.ByteString, Maybe MimeType))]
readSources :: forall (m :: * -> *).
PandocMonad m =>
[FilePath] -> m [(FilePath, (ByteString, Maybe Text))]
readSources [FilePath]
srcs =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
fp -> do (ByteString, Maybe Text)
t <- forall (m :: * -> *).
PandocMonad m =>
FilePath -> m (ByteString, Maybe Text)
readSource FilePath
fp
                  forall (m :: * -> *) a. Monad m => a -> m a
return (if FilePath
fp forall a. Eq a => a -> a -> Bool
== FilePath
"-" then FilePath
"" else FilePath
fp, (ByteString, Maybe Text)
t)) [FilePath]
srcs

readSource :: PandocMonad m
           => FilePath -> m (BS.ByteString, Maybe MimeType)
readSource :: forall (m :: * -> *).
PandocMonad m =>
FilePath -> m (ByteString, Maybe Text)
readSource FilePath
"-" = (,forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m ByteString
readStdinStrict
readSource FilePath
src =
  case FilePath -> Maybe URI
parseURI FilePath
src of
    Just URI
u | URI -> FilePath
uriScheme URI
u forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"http:",FilePath
"https:"] -> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL (FilePath -> Text
T.pack FilePath
src)
           | URI -> FilePath
uriScheme URI
u forall a. Eq a => a -> a -> Bool
== FilePath
"file:" ->
               (,forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileStrict (Text -> FilePath
uriPathToPath forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ URI -> FilePath
uriPath URI
u)
    Maybe URI
_       -> (,forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileStrict FilePath
src

utf8ToText :: PandocMonad m => FilePath -> BS.ByteString -> m Text
utf8ToText :: forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
utf8ToText FilePath
fp ByteString
bs =
  case ByteString -> Either UnicodeException Text
TSE.decodeUtf8' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropBOM forall a b. (a -> b) -> a -> b
$ ByteString
bs of
    Left (TSE.DecodeError FilePath
_ (Just Word8
w)) ->
      case Word8 -> ByteString -> Maybe Int
BS.elemIndex Word8
w ByteString
bs of
        Just Int
offset -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Int -> Word8 -> PandocError
PandocUTF8DecodingError (FilePath -> Text
T.pack FilePath
fp) Int
offset Word8
w
        Maybe Int
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Int -> Word8 -> PandocError
PandocUTF8DecodingError (FilePath -> Text
T.pack FilePath
fp) Int
0 Word8
w
    Left UnicodeException
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocAppError (forall a. Show a => a -> Text
tshow UnicodeException
e)
    Right Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
 where
   dropBOM :: ByteString -> ByteString
dropBOM ByteString
bs' =
     if ByteString
"\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
bs'
        then Int -> ByteString -> ByteString
BS.drop Int
3 ByteString
bs'
        else ByteString
bs'


inputToText :: PandocMonad m
            => (Text -> Text)
            -> (FilePath, (BS.ByteString, Maybe MimeType))
            -> m (FilePath, Text)
inputToText :: forall (m :: * -> *).
PandocMonad m =>
(Text -> Text)
-> (FilePath, (ByteString, Maybe Text)) -> m (FilePath, Text)
inputToText Text -> Text
convTabs (FilePath
fp, (ByteString
bs,Maybe Text
mt)) =
  (FilePath
fp,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
convTabs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/=Char
'\r') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  case Maybe Text
mt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
getCharset of
    Just Text
"UTF-8"      -> forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
utf8ToText FilePath
fp ByteString
bs
    Just Text
"ISO-8859-1" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
B8.unpack ByteString
bs
    Just Text
charset      -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocUnsupportedCharsetError Text
charset
    Maybe Text
Nothing           -> forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
                           (forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
utf8ToText FilePath
fp ByteString
bs)
                           (\case
                              PandocUTF8DecodingError{} -> do
                                forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ FilePath -> LogMessage
NotUTF8Encoded
                                  (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
fp
                                      then FilePath
"input"
                                      else FilePath
fp)
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
B8.unpack ByteString
bs
                              PandocError
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)

inputToLazyByteString :: (FilePath, (BS.ByteString, Maybe MimeType))
                      -> BL.ByteString
inputToLazyByteString :: (FilePath, (ByteString, Maybe Text)) -> ByteString
inputToLazyByteString (FilePath
_, (ByteString
bs,Maybe Text
_)) = ByteString -> ByteString
BL.fromStrict ByteString
bs

writeFnBinary :: FilePath -> BL.ByteString -> IO ()
writeFnBinary :: FilePath -> ByteString -> IO ()
writeFnBinary FilePath
"-" = ByteString -> IO ()
BL.putStr
writeFnBinary FilePath
f   = FilePath -> ByteString -> IO ()
BL.writeFile (FilePath -> FilePath
UTF8.encodePath FilePath
f)

writerFn :: IO.Newline -> FilePath -> Text -> IO ()
writerFn :: Newline -> FilePath -> Text -> IO ()
writerFn Newline
eol FilePath
"-" = Newline -> Text -> IO ()
UTF8.putStrWith Newline
eol
writerFn Newline
eol FilePath
f   = Newline -> FilePath -> Text -> IO ()
UTF8.writeFileWith Newline
eol FilePath
f