    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE OverloadedStrings #-}
    {- |
    Module      : Text.Pandoc.Class.IO
    Copyright   : Copyright (C) 2016-2020 Jesse Rosenthal, John MacFarlane
    License     : GNU GPL, version 2 or above

    Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
    Stability   : alpha
    Portability : portable

    Default ways to perform @'PandocMonad'@ actions in a @'MonadIO'@ type.

    These functions are used to make the @'PandocIO'@ type an instance of
    @'PandocMonad'@, but can be reused for any other MonadIO-conforming
    types.
    -}
    module Text.Pandoc.Class.IO
      ( fileExists
      , getCurrentTime
      , getCurrentTimeZone
      , getDataFileName
      , getModificationTime
      , glob
      , logOutput
      , logIOError
      , lookupEnv
      , newStdGen
      , newUniqueHash
      , openURL
      , readFileLazy
      , readFileStrict
      , readStdinStrict
      , extractMedia
      , writeMedia
     ) where

    import Control.Monad.Except (throwError)
    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Text (Text, pack, unpack)
    import Data.Time (TimeZone, UTCTime)
    import Data.Unique (hashUnique)
    #ifdef PANDOC_HTTP_SUPPORT
    import Data.ByteString.Lazy (toChunks)
    import System.Environment (getEnv)
    import Data.Default (def)
    import Network.Connection (TLSSettings(..))
    import qualified Network.TLS as TLS
    import qualified Network.TLS.Extra as TLS
    import System.X509 (getSystemCertificateStore)
    import Network.HTTP.Client
           (httpLbs, Manager, responseBody, responseHeaders,
            Request(port, host, requestHeaders), parseUrlThrow, newManager, HttpException)
    import Network.HTTP.Client.Internal (addProxy)
    import Network.HTTP.Client.TLS (mkManagerSettings)
    import Network.HTTP.Types.Header ( hContentType )
    import Network.Socket (withSocketsDo)
    import Text.Pandoc.Class.CommonState (CommonState (..))
    import Text.Pandoc.Class.PandocMonad ( getsCommonState, modifyCommonState )
    import qualified Data.CaseInsensitive as CI
    #endif
    import Network.URI (URI(..), parseURI, unEscapeString)
    import System.Directory (createDirectoryIfMissing)
    import System.FilePath ((</>), takeDirectory, takeFileName, normalise, takeExtension)
    import qualified System.FilePath.Posix as Posix
    import System.IO (stderr)
    import System.IO.Error
    import System.Random (StdGen)
    import Text.Pandoc.Class.PandocMonad
           (PandocMonad,
            getMediaBag, report, extractURIData)
    import Text.Pandoc.Definition (Pandoc, Inline (Image))
    import Text.Pandoc.Error (PandocError (..))
    import Text.Pandoc.Logging (LogMessage (..), messageVerbosity, showLogMessage)
    import Text.Pandoc.MIME (MimeType)
    import Text.Pandoc.MediaBag (MediaBag, MediaItem(..), lookupMedia, mediaItems)
    import Text.Pandoc.Walk (walk)
    import qualified Control.Exception as E
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as BL
    import qualified Data.Text as T
    import qualified Data.Time
    import qualified Data.Time.LocalTime
    import qualified Data.Unique
    import qualified System.Directory
    import qualified System.Environment as Env
    import qualified System.FilePath.Glob
    import qualified System.Random
    import qualified Text.Pandoc.UTF8 as UTF8
    import Codec.Archive.Zip
    #ifndef EMBED_DATA_FILES
    import qualified Paths_pandoc as Paths
    #endif

    -- | Utility function to lift IO errors into 'PandocError's.
    liftIOError :: (PandocMonad m, MonadIO m) => (String -> IO a) -> String -> m a
    liftIOError :: forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError String -> IO a
    f String
    u = do
      res <- IO (Either IOError a) -> m (Either IOError a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either IOError a) -> m (Either IOError a))
    -> IO (Either IOError a) -> m (Either IOError a)
    forall a b. (a -> b) -> a -> b
    $ IO a -> IO (Either IOError a)
    forall a. IO a -> IO (Either IOError a)
    tryIOError (IO a -> IO (Either IOError a)) -> IO a -> IO (Either IOError a)
    forall a b. (a -> b) -> a -> b
    $ String -> IO a
    f String
    u
      case res of
             Left IOError
    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 -> IOError -> PandocError
    PandocIOError (String -> Text
    pack String
    u) IOError
    e
             Right a
    r -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r

    -- | Show potential IO errors to the user continuing execution anyway
    logIOError :: (PandocMonad m, MonadIO m) => IO () -> m ()
    logIOError :: forall (m :: * -> *). (PandocMonad m, MonadIO m) => IO () -> m ()
    logIOError IO ()
    f = do
      res <- IO (Either IOError ()) -> m (Either IOError ())
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either IOError ()) -> m (Either IOError ()))
    -> IO (Either IOError ()) -> m (Either IOError ())
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO (Either IOError ())
    forall a. IO a -> IO (Either IOError a)
    tryIOError IO ()
    f
      case res of
        Left IOError
    e -> LogMessage -> m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text -> LogMessage
    IgnoredIOError (Text -> LogMessage) -> Text -> LogMessage
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ IOError -> String
    forall e. Exception e => e -> String
    E.displayException IOError
    e
        Right ()
    _ -> () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    -- | Lookup an environment variable in the programs environment.
    lookupEnv :: MonadIO m => Text -> m (Maybe Text)
    lookupEnv :: forall (m :: * -> *). MonadIO m => Text -> m (Maybe Text)
    lookupEnv = (Maybe String -> Maybe Text) -> m (Maybe String) -> m (Maybe Text)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((String -> Text) -> Maybe String -> Maybe Text
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Text
    pack) (m (Maybe String) -> m (Maybe Text))
    -> (Text -> m (Maybe String)) -> Text -> m (Maybe Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Maybe String) -> m (Maybe String)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe String) -> m (Maybe String))
    -> (Text -> IO (Maybe String)) -> Text -> m (Maybe String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO (Maybe String)
    Env.lookupEnv (String -> IO (Maybe String))
    -> (Text -> String) -> Text -> IO (Maybe String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    unpack

    -- | Get the current (UTC) time.
    getCurrentTime :: MonadIO m => m UTCTime
    getCurrentTime :: forall (m :: * -> *). MonadIO m => m UTCTime
    getCurrentTime = IO UTCTime -> m UTCTime
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    Data.Time.getCurrentTime

    -- | Get the locale's time zone.
    getCurrentTimeZone :: MonadIO m => m TimeZone
    getCurrentTimeZone :: forall (m :: * -> *). MonadIO m => m TimeZone
    getCurrentTimeZone = IO TimeZone -> m TimeZone
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO TimeZone
    Data.Time.LocalTime.getCurrentTimeZone

    -- | Return a new generator for random numbers.
    newStdGen :: MonadIO m => m StdGen
    newStdGen :: forall (m :: * -> *). MonadIO m => m StdGen
    newStdGen = IO StdGen -> m StdGen
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO StdGen
    forall (m :: * -> *). MonadIO m => m StdGen
    System.Random.newStdGen

    -- | Return a new unique integer.
    newUniqueHash :: MonadIO m => m Int
    newUniqueHash :: forall (m :: * -> *). MonadIO m => m Int
    newUniqueHash = Unique -> Int
    hashUnique (Unique -> Int) -> m Unique -> m Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Unique -> m Unique
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO Unique
    Data.Unique.newUnique

    #ifdef PANDOC_HTTP_SUPPORT
    getManager :: (PandocMonad m, MonadIO m) => m Manager
    getManager :: forall (m :: * -> *). (PandocMonad m, MonadIO m) => m Manager
    getManager = do
      mbManager <- (CommonState -> Maybe Manager) -> m (Maybe Manager)
    forall a. (CommonState -> a) -> m a
    forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
    getsCommonState CommonState -> Maybe Manager
    stManager
      disableCertificateValidation <- getsCommonState stNoCheckCertificate
      case mbManager of
        Just Manager
    manager -> Manager -> m Manager
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Manager
    manager
        Maybe Manager
    Nothing -> do
          manager <- IO Manager -> m Manager
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Manager -> m Manager) -> IO Manager -> m Manager
    forall a b. (a -> b) -> a -> b
    $ do
            certificateStore <- IO CertificateStore
    getSystemCertificateStore
            let tlsSettings = ClientParams -> TLSSettings
    TLSSettings (ClientParams -> TLSSettings) -> ClientParams -> TLSSettings
    forall a b. (a -> b) -> a -> b
    $
                   (String -> ByteString -> ClientParams
    TLS.defaultParamsClient String
    "localhost.localdomain" ByteString
    "80")
                      { TLS.clientSupported = def{ TLS.supportedCiphers =
                                                   TLS.ciphersuite_default
                                                 , TLS.supportedExtendedMainSecret =
                                                    TLS.AllowEMS }
                      , TLS.clientShared = def
                          { TLS.sharedCAStore = certificateStore
                          , TLS.sharedValidationCache =
                              if disableCertificateValidation
                                 then TLS.ValidationCache
                                       (\ServiceID
    _ Fingerprint
    _ Certificate
    _ -> ValidationCacheResult -> IO ValidationCacheResult
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ValidationCacheResult
    TLS.ValidationCachePass)
                                       (\ServiceID
    _ Fingerprint
    _ Certificate
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                                 else def
                          }
                      }
            let tlsManagerSettings = TLSSettings -> Maybe SockSettings -> ManagerSettings
    mkManagerSettings TLSSettings
    tlsSettings  Maybe SockSettings
    forall a. Maybe a
    Nothing
            newManager tlsManagerSettings
          modifyCommonState $ \CommonState
    st -> CommonState
    st{ stManager = Just manager }
          pure manager
    #endif

    openURL :: (PandocMonad m, MonadIO m) => Text -> m (B.ByteString, Maybe MimeType)
    openURL :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    Text -> m (ByteString, Maybe Text)
    openURL Text
    u
     | Just (URI{ uriScheme :: URI -> String
    uriScheme = String
    "data:",
                  uriPath :: URI -> String
    uriPath = String
    upath }) <- String -> Maybe URI
    parseURI (Text -> String
    T.unpack Text
    u)
         = (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((ByteString, Maybe Text) -> m (ByteString, Maybe Text))
    -> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ String -> (ByteString, Maybe Text)
    extractURIData String
    upath
    #ifdef PANDOC_HTTP_SUPPORT
     | Bool
    otherwise = do
         let toReqHeader :: (Text, Text) -> (HeaderName, ByteString)
    toReqHeader (Text
    n, Text
    v) = (ByteString -> HeaderName
    forall s. FoldCase s => s -> CI s
    CI.mk (Text -> ByteString
    UTF8.fromText Text
    n), Text -> ByteString
    UTF8.fromText Text
    v)
         customHeaders <- ((Text, Text) -> (HeaderName, ByteString))
    -> [(Text, Text)] -> [(HeaderName, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Text) -> (HeaderName, ByteString)
    toReqHeader ([(Text, Text)] -> [(HeaderName, ByteString)])
    -> m [(Text, Text)] -> m [(HeaderName, ByteString)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (CommonState -> [(Text, Text)]) -> m [(Text, Text)]
    forall a. (CommonState -> a) -> m a
    forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
    getsCommonState CommonState -> [(Text, Text)]
    stRequestHeaders
         report $ Fetching u
         manager <- getManager
         res <- liftIO $ E.try $ withSocketsDo $ do
           proxy <- tryIOError (getEnv "http_proxy")
           let addProxy' Request
    x = case Either IOError String
    proxy of
                                Left IOError
    _ -> Request -> m Request
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Request
    x
                                Right String
    pr -> String -> m Request
    forall (m :: * -> *). MonadThrow m => String -> m Request
    parseUrlThrow String
    pr m Request -> (Request -> m Request) -> m Request
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Request
    r ->
                                    Request -> m Request
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> Int -> Request -> Request
    addProxy (Request -> ByteString
    host Request
    r) (Request -> Int
    port Request
    r) Request
    x)
           req <- parseUrlThrow (unpack u) >>= addProxy'
           let req' = Request
    req{requestHeaders = customHeaders ++ requestHeaders req}
           resp <- httpLbs req' manager
           return (B.concat $ toChunks $ responseBody resp,
                   UTF8.toText `fmap` lookup hContentType (responseHeaders resp))

         case res of
              Right (ByteString, Maybe Text)
    r -> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString, Maybe Text)
    r
              Left (HttpException
    e :: HttpException)
                      -> PandocError -> m (ByteString, Maybe Text)
    forall a. PandocError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> m (ByteString, Maybe Text))
    -> PandocError -> m (ByteString, Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PandocError
    PandocHttpError Text
    u (String -> Text
    T.pack (HttpException -> String
    forall a. Show a => a -> String
    show HttpException
    e))
    #else
     | otherwise =
         throwError $ PandocHttpError u "pandoc was compiled without HTTP support"
    #endif

    -- | Read the lazy ByteString contents from a file path, raising an error on
    -- failure.
    readFileLazy :: (PandocMonad m, MonadIO m) => FilePath -> m BL.ByteString
    readFileLazy :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> m ByteString
    readFileLazy String
    s = (String -> IO ByteString) -> String -> m ByteString
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError String -> IO ByteString
    BL.readFile String
    s

    -- | Read the strict ByteString contents from a file path,
    -- raising an error on failure.
    readFileStrict :: (PandocMonad m, MonadIO m) => FilePath -> m B.ByteString
    readFileStrict :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> m ByteString
    readFileStrict String
    s = (String -> IO ByteString) -> String -> m ByteString
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError String -> IO ByteString
    B.readFile String
    s

    -- | Read the strict ByteString contents from stdin, raising
    -- an error on failure.
    readStdinStrict :: (PandocMonad m, MonadIO m) => m B.ByteString
    readStdinStrict :: forall (m :: * -> *). (PandocMonad m, MonadIO m) => m ByteString
    readStdinStrict = (String -> IO ByteString) -> String -> m ByteString
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError (IO ByteString -> String -> IO ByteString
    forall a b. a -> b -> a
    const IO ByteString
    B.getContents) String
    "stdin"

    -- | Return a list of paths that match a glob, relative to the working
    -- directory. See 'System.FilePath.Glob' for the glob syntax.
    glob :: (PandocMonad m, MonadIO m) => String -> m [FilePath]
    glob :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> m [String]
    glob = (String -> IO [String]) -> String -> m [String]
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError String -> IO [String]
    System.FilePath.Glob.glob

    -- | Returns True if file exists.
    fileExists :: (PandocMonad m, MonadIO m) => FilePath -> m Bool
    fileExists :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> m Bool
    fileExists = (String -> IO Bool) -> String -> m Bool
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError String -> IO Bool
    System.Directory.doesFileExist

    -- | Returns the path of data file.
    getDataFileName :: (PandocMonad m, MonadIO m) => FilePath -> m FilePath
    #ifdef EMBED_DATA_FILES
    getDataFileName = return
    #else
    getDataFileName :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> m String
    getDataFileName = (String -> IO String) -> String -> m String
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError String -> IO String
    Paths.getDataFileName
    #endif

    -- | Return the modification time of a file.
    getModificationTime :: (PandocMonad m, MonadIO m) => FilePath -> m UTCTime
    getModificationTime :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> m UTCTime
    getModificationTime = (String -> IO UTCTime) -> String -> m UTCTime
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError String -> IO UTCTime
    System.Directory.getModificationTime

    -- | Output a log message.
    logOutput :: (PandocMonad m, MonadIO m) => LogMessage -> m ()
    logOutput :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    LogMessage -> m ()
    logOutput LogMessage
    msg = 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.hPutStr Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Text
    "[" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> String -> Text
    T.pack (Verbosity -> String
    forall a. Show a => a -> String
    show (LogMessage -> Verbosity
    messageVerbosity LogMessage
    msg)) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "] "
      [Text] -> IO ()
    alertIndent ([Text] -> IO ()) -> [Text] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text]
    T.lines (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ LogMessage -> Text
    showLogMessage LogMessage
    msg

    -- | Prints the list of lines to @stderr@, indenting every but the first
    -- line by two spaces.
    alertIndent :: [Text] -> IO ()
    alertIndent :: [Text] -> IO ()
    alertIndent [] = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    alertIndent (Text
    l:[Text]
    ls) = do
      Handle -> Text -> IO ()
    UTF8.hPutStrLn Handle
    stderr Text
    l
      (Text -> IO ()) -> [Text] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Text -> IO ()
    go [Text]
    ls
      where go :: Text -> IO ()
    go Text
    l' = do Handle -> Text -> IO ()
    UTF8.hPutStr Handle
    stderr Text
    "  "
                       Handle -> Text -> IO ()
    UTF8.hPutStrLn Handle
    stderr Text
    l'

    -- | Extract media from the mediabag into a directory (or a zip archive if the
    -- path supplied ends in @.zip@.
    extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc
    extractMedia :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> Pandoc -> m Pandoc
    extractMedia String
    path Pandoc
    d = do
      media <- m MediaBag
    forall (m :: * -> *). PandocMonad m => m MediaBag
    getMediaBag
      let items = MediaBag -> [(String, Text, ByteString)]
    mediaItems MediaBag
    media
      let (dir, mbZip) = case takeExtension path of
                           String
    ".zip" -> (String -> String
    takeDirectory String
    path, String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> String
    takeFileName String
    path))
                           String
    _ -> (String
    path, Maybe String
    forall a. Maybe a
    Nothing)
      if null items
        then return d
        else do
          let archive = ((String, Text, ByteString) -> Archive -> Archive)
    -> Archive -> [(String, Text, ByteString)] -> Archive
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (String, Text, ByteString) -> Archive -> Archive
    forall {b}. (String, b, ByteString) -> Archive -> Archive
    addEntry Archive
    emptyArchive [(String, Text, ByteString)]
    items
          case mbZip of
            Just String
    fname -> String -> (String, Text, ByteString) -> m ()
    forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> (String, Text, ByteString) -> m ()
    writeMedia String
    dir
                            (String
    fname, Text
    "application/zip", Archive -> ByteString
    fromArchive Archive
    archive)
            Maybe String
    Nothing -> ((String, Text, ByteString) -> m ())
    -> [(String, Text, ByteString)] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (String -> (String, Text, ByteString) -> m ()
    forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> (String, Text, ByteString) -> m ()
    writeMedia String
    dir) [(String, Text, ByteString)]
    items
          return $ walk (adjustImagePath dir media) d
     where
      addEntry :: (String, b, ByteString) -> Archive -> Archive
    addEntry (String
    fp, b
    _mime, ByteString
    content) = Entry -> Archive -> Archive
    addEntryToArchive (String -> Integer -> ByteString -> Entry
    toEntry String
    fp Integer
    0 ByteString
    content)

    -- | Write the contents of a media bag to a path.
    -- If the path contains URI escape sequences (percent-encoding),
    -- these are resolved.
    writeMedia :: (PandocMonad m, MonadIO m)
               => FilePath
               -> (FilePath, MimeType, BL.ByteString)
               -> m ()
    writeMedia :: forall (m :: * -> *).
    (PandocMonad m, MonadIO m) =>
    String -> (String, Text, ByteString) -> m ()
    writeMedia String
    dir (String
    fp, Text
    _mt, ByteString
    bs) = do
      -- we normalize to get proper path separators for the platform
      -- we unescape URI encoding, but given how insertMedia
      -- is written, we shouldn't have any % in a canonical media name...
      let fullpath :: String
    fullpath = String -> String
    normalise (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    dir String -> String -> String
    </> String -> String
    unEscapeString String
    fp
      (String -> IO ()) -> String -> m ()
    forall (m :: * -> *) a.
    (PandocMonad m, MonadIO m) =>
    (String -> IO a) -> String -> m a
    liftIOError (Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True) (String -> String
    takeDirectory String
    fullpath)
      LogMessage -> m ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> m ()) -> LogMessage -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text -> LogMessage
    Extracting (String -> Text
    T.pack String
    fullpath)
      IO () -> m ()
    forall (m :: * -> *). (PandocMonad m, MonadIO m) => IO () -> m ()
    logIOError (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString -> IO ()
    BL.writeFile String
    fullpath ByteString
    bs

    -- | If the given Inline element is an image with a @src@ path equal to
    -- one in the list of @paths@, then prepends @dir@ to the image source;
    -- returns the element unchanged otherwise.
    adjustImagePath :: FilePath -> MediaBag -> Inline -> Inline
    adjustImagePath :: String -> MediaBag -> Inline -> Inline
    adjustImagePath String
    dir MediaBag
    mediabag (Image Attr
    attr [Inline]
    lab (Text
    src, Text
    tit)) =
      case String -> MediaBag -> Maybe MediaItem
    lookupMedia (Text -> String
    T.unpack Text
    src) MediaBag
    mediabag of
        Maybe MediaItem
    Nothing -> Attr -> [Inline] -> (Text, Text) -> Inline
    Image Attr
    attr [Inline]
    lab (Text
    src, Text
    tit)
        Just MediaItem
    item ->
          let fullpath :: String
    fullpath = String
    dir String -> String -> String
    Posix.</> MediaItem -> String
    mediaPath MediaItem
    item
          in  Attr -> [Inline] -> (Text, Text) -> Inline
    Image Attr
    attr [Inline]
    lab (String -> Text
    T.pack String
    fullpath, Text
    tit)
    adjustImagePath String
    _ MediaBag
    _ Inline
    x = Inline
    x