{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module      : Text.Pandoc.Class.PandocIO
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

This module defines @'PandocIO'@, an IO-based instance of the
@'PandocMonad'@ type class. File, data, and network access all are run
using IO operators.
-}
module Text.Pandoc.Class.PandocIO
  ( getPOSIXTime
  , getZonedTime
  , readFileFromDirs
  , report
  , setTrace
  , setRequestHeader
  , getLog
  , setVerbosity
  , getVerbosity
  , getMediaBag
  , setMediaBag
  , insertMedia
  , setUserDataDir
  , getUserDataDir
  , fetchItem
  , getInputFiles
  , setInputFiles
  , getOutputFile
  , setOutputFile
  , setResourcePath
  , getResourcePath
  , PandocIO(..)
  , runIO
  , runIOorExplode
  , extractMedia
 ) where

import Control.Monad.Except
import Control.Monad.State.Strict
import Data.ByteString.Base64 (decodeLenient)
import Data.ByteString.Lazy (toChunks)
import Data.Default
import Data.Text (Text)
import Data.Unique (hashUnique)
import Network.HTTP.Client
       (httpLbs, responseBody, responseHeaders,
        Request(port, host, requestHeaders), parseRequest, newManager)
import Network.HTTP.Client.Internal (addProxy)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types.Header ( hContentType )
import Network.Socket (withSocketsDo)
import Network.URI (URI(..), parseURI, unEscapeString)
import Prelude
import System.Directory (createDirectoryIfMissing)
import System.Environment (getEnv)
import System.FilePath ((</>), takeDirectory, normalise)
import System.IO (stderr)
import System.IO.Error
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)
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.CaseInsensitive as CI
import qualified Data.Text as T
import qualified Data.Time as IO (getCurrentTime)
import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)
import qualified Data.Unique as IO (newUnique)
import qualified System.Directory as Directory
import qualified System.Directory as IO (getModificationTime)
import qualified System.Environment as IO (lookupEnv)
import qualified System.FilePath.Glob as IO (glob)
import qualified System.Random as IO (newStdGen)
import qualified Text.Pandoc.UTF8 as UTF8
#ifndef EMBED_DATA_FILES
import qualified Paths_pandoc as Paths
#endif

-- | Evaluate a 'PandocIO' operation.
runIO :: PandocIO a -> IO (Either PandocError a)
runIO :: PandocIO a -> IO (Either PandocError a)
runIO ma :: PandocIO a
ma = (StateT CommonState IO (Either PandocError a)
 -> CommonState -> IO (Either PandocError a))
-> CommonState
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CommonState IO (Either PandocError a)
-> CommonState -> IO (Either PandocError a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CommonState
forall a. Default a => a
def (StateT CommonState IO (Either PandocError a)
 -> IO (Either PandocError a))
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PandocError (StateT CommonState IO) a
 -> StateT CommonState IO (Either PandocError a))
-> ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
forall a.
PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
unPandocIO PandocIO a
ma

-- | Evaluate a 'PandocIO' operation, handling any errors
-- by exiting with an appropriate message and error status.
runIOorExplode :: PandocIO a -> IO a
runIOorExplode :: PandocIO a -> IO a
runIOorExplode ma :: PandocIO a
ma = PandocIO a -> IO (Either PandocError a)
forall a. PandocIO a -> IO (Either PandocError a)
runIO PandocIO a
ma IO (Either PandocError a) -> (Either PandocError a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either PandocError a -> IO a
forall a. Either PandocError a -> IO a
handleError

newtype PandocIO a = PandocIO {
  PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
unPandocIO :: ExceptT PandocError (StateT CommonState IO) a
  } deriving ( Monad PandocIO
Monad PandocIO =>
(forall a. IO a -> PandocIO a) -> MonadIO PandocIO
IO a -> PandocIO a
forall a. IO a -> PandocIO a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> PandocIO a
$cliftIO :: forall a. IO a -> PandocIO a
$cp1MonadIO :: Monad PandocIO
MonadIO
             , a -> PandocIO b -> PandocIO a
(a -> b) -> PandocIO a -> PandocIO b
(forall a b. (a -> b) -> PandocIO a -> PandocIO b)
-> (forall a b. a -> PandocIO b -> PandocIO a) -> Functor PandocIO
forall a b. a -> PandocIO b -> PandocIO a
forall a b. (a -> b) -> PandocIO a -> PandocIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PandocIO b -> PandocIO a
$c<$ :: forall a b. a -> PandocIO b -> PandocIO a
fmap :: (a -> b) -> PandocIO a -> PandocIO b
$cfmap :: forall a b. (a -> b) -> PandocIO a -> PandocIO b
Functor
             , Functor PandocIO
a -> PandocIO a
Functor PandocIO =>
(forall a. a -> PandocIO a)
-> (forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b)
-> (forall a b c.
    (a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO b)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO a)
-> Applicative PandocIO
PandocIO a -> PandocIO b -> PandocIO b
PandocIO a -> PandocIO b -> PandocIO a
PandocIO (a -> b) -> PandocIO a -> PandocIO b
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
forall a. a -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO b
forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b
forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PandocIO a -> PandocIO b -> PandocIO a
$c<* :: forall a b. PandocIO a -> PandocIO b -> PandocIO a
*> :: PandocIO a -> PandocIO b -> PandocIO b
$c*> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
liftA2 :: (a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
$cliftA2 :: forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
<*> :: PandocIO (a -> b) -> PandocIO a -> PandocIO b
$c<*> :: forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b
pure :: a -> PandocIO a
$cpure :: forall a. a -> PandocIO a
$cp1Applicative :: Functor PandocIO
Applicative
             , Applicative PandocIO
a -> PandocIO a
Applicative PandocIO =>
(forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO b)
-> (forall a. a -> PandocIO a)
-> Monad PandocIO
PandocIO a -> (a -> PandocIO b) -> PandocIO b
PandocIO a -> PandocIO b -> PandocIO b
forall a. a -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO b
forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PandocIO a
$creturn :: forall a. a -> PandocIO a
>> :: PandocIO a -> PandocIO b -> PandocIO b
$c>> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
>>= :: PandocIO a -> (a -> PandocIO b) -> PandocIO b
$c>>= :: forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b
$cp1Monad :: Applicative PandocIO
Monad
             , MonadError PandocError
             )

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

-- | Show potential IO errors to the user continuing execution anyway
logIOError :: IO () -> PandocIO ()
logIOError :: IO () -> PandocIO ()
logIOError f :: IO ()
f = do
  Either IOError ()
res <- IO (Either IOError ()) -> PandocIO (Either IOError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError ()) -> PandocIO (Either IOError ()))
-> IO (Either IOError ()) -> PandocIO (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 Either IOError ()
res of
    Left e :: IOError
e -> LogMessage -> PandocIO ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> PandocIO ()) -> LogMessage -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredIOError (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.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 _ -> () -> PandocIO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance PandocMonad PandocIO where
  lookupEnv :: Text -> PandocIO (Maybe Text)
lookupEnv = (Maybe String -> Maybe Text)
-> PandocIO (Maybe String) -> PandocIO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) (PandocIO (Maybe String) -> PandocIO (Maybe Text))
-> (Text -> PandocIO (Maybe String))
-> Text
-> PandocIO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe String) -> PandocIO (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> PandocIO (Maybe String))
-> (Text -> IO (Maybe String)) -> Text -> PandocIO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
IO.lookupEnv (String -> IO (Maybe String))
-> (Text -> String) -> Text -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  getCurrentTime :: PandocIO UTCTime
getCurrentTime = IO UTCTime -> PandocIO UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
IO.getCurrentTime
  getCurrentTimeZone :: PandocIO TimeZone
getCurrentTimeZone = IO TimeZone -> PandocIO TimeZone
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
IO.getCurrentTimeZone
  newStdGen :: PandocIO StdGen
newStdGen = IO StdGen -> PandocIO StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
IO.newStdGen
  newUniqueHash :: PandocIO Int
newUniqueHash = Unique -> Int
hashUnique (Unique -> Int) -> PandocIO Unique -> PandocIO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique -> PandocIO Unique
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Unique
IO.newUnique

  openURL :: Text -> PandocIO (ByteString, Maybe Text)
openURL u :: 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) = do
       let (mime :: String
mime, rest :: String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String -> String
unEscapeString String
upath
       let contents :: ByteString
contents = String -> ByteString
UTF8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 String
rest
       (ByteString, Maybe Text) -> PandocIO (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
decodeLenient ByteString
contents, Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
mime))
   | Bool
otherwise = do
       let toReqHeader :: (Text, Text) -> (CI ByteString, ByteString)
toReqHeader (n :: Text
n, v :: Text
v) = (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
UTF8.fromText Text
n), Text -> ByteString
UTF8.fromText Text
v)
       [(CI ByteString, ByteString)]
customHeaders <- ((Text, Text) -> (CI ByteString, ByteString))
-> [(Text, Text)] -> [(CI ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (CI ByteString, ByteString)
toReqHeader ([(Text, Text)] -> [(CI ByteString, ByteString)])
-> PandocIO [(Text, Text)]
-> PandocIO [(CI ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CommonState -> [(Text, Text)]) -> PandocIO [(Text, Text)]
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [(Text, Text)]
stRequestHeaders
       LogMessage -> PandocIO ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> PandocIO ()) -> LogMessage -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
Fetching Text
u
       Either HttpException (ByteString, Maybe Text)
res <- IO (Either HttpException (ByteString, Maybe Text))
-> PandocIO (Either HttpException (ByteString, Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException (ByteString, Maybe Text))
 -> PandocIO (Either HttpException (ByteString, Maybe Text)))
-> IO (Either HttpException (ByteString, Maybe Text))
-> PandocIO (Either HttpException (ByteString, Maybe Text))
forall a b. (a -> b) -> a -> b
$ IO (ByteString, Maybe Text)
-> IO (Either HttpException (ByteString, Maybe Text))
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO (ByteString, Maybe Text)
 -> IO (Either HttpException (ByteString, Maybe Text)))
-> IO (ByteString, Maybe Text)
-> IO (Either HttpException (ByteString, Maybe Text))
forall a b. (a -> b) -> a -> b
$ IO (ByteString, Maybe Text) -> IO (ByteString, Maybe Text)
forall a. IO a -> IO a
withSocketsDo (IO (ByteString, Maybe Text) -> IO (ByteString, Maybe Text))
-> IO (ByteString, Maybe Text) -> IO (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
         let parseReq :: String -> IO Request
parseReq = String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
         Either IOError String
proxy <- IO String -> IO (Either IOError String)
forall a. IO a -> IO (Either IOError a)
tryIOError (String -> IO String
getEnv "http_proxy")
         let addProxy' :: Request -> IO Request
addProxy' x :: Request
x = case Either IOError String
proxy of
                              Left _ -> Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
x
                              Right pr :: String
pr -> String -> IO Request
parseReq String
pr IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: Request
r ->
                                  Request -> IO Request
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)
         Request
req <- String -> IO Request
parseReq (Text -> String
T.unpack Text
u) IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO Request
addProxy'
         let req' :: Request
req' = Request
req{requestHeaders :: [(CI ByteString, ByteString)]
requestHeaders = [(CI ByteString, ByteString)]
customHeaders [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++ Request -> [(CI ByteString, ByteString)]
requestHeaders Request
req}
         Response ByteString
resp <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings IO Manager
-> (Manager -> IO (Response ByteString))
-> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> Manager -> IO (Response ByteString)
httpLbs Request
req'
         (ByteString, Maybe Text) -> IO (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp,
                 ByteString -> Text
UTF8.toText (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
hContentType (Response ByteString -> [(CI ByteString, ByteString)]
forall body. Response body -> [(CI ByteString, ByteString)]
responseHeaders Response ByteString
resp))

       case Either HttpException (ByteString, Maybe Text)
res of
            Right r :: (ByteString, Maybe Text)
r -> (ByteString, Maybe Text) -> PandocIO (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString, Maybe Text)
r
            Left e :: HttpException
e  -> PandocError -> PandocIO (ByteString, Maybe Text)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocIO (ByteString, Maybe Text))
-> PandocError -> PandocIO (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> HttpException -> PandocError
PandocHttpError Text
u HttpException
e

  readFileLazy :: String -> PandocIO ByteString
readFileLazy s :: String
s = (String -> IO ByteString) -> String -> PandocIO ByteString
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO ByteString
BL.readFile String
s
  readFileStrict :: String -> PandocIO ByteString
readFileStrict s :: String
s = (String -> IO ByteString) -> String -> PandocIO ByteString
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO ByteString
B.readFile String
s

  glob :: String -> PandocIO [String]
glob = (String -> IO [String]) -> String -> PandocIO [String]
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO [String]
IO.glob
  fileExists :: String -> PandocIO Bool
fileExists = (String -> IO Bool) -> String -> PandocIO Bool
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO Bool
Directory.doesFileExist
#ifdef EMBED_DATA_FILES
  getDataFileName = return
#else
  getDataFileName :: String -> PandocIO String
getDataFileName = (String -> IO String) -> String -> PandocIO String
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO String
Paths.getDataFileName
#endif
  getModificationTime :: String -> PandocIO UTCTime
getModificationTime = (String -> IO UTCTime) -> String -> PandocIO UTCTime
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO UTCTime
IO.getModificationTime
  getCommonState :: PandocIO CommonState
getCommonState = ExceptT PandocError (StateT CommonState IO) CommonState
-> PandocIO CommonState
forall a.
ExceptT PandocError (StateT CommonState IO) a -> PandocIO a
PandocIO (ExceptT PandocError (StateT CommonState IO) CommonState
 -> PandocIO CommonState)
-> ExceptT PandocError (StateT CommonState IO) CommonState
-> PandocIO CommonState
forall a b. (a -> b) -> a -> b
$ StateT CommonState IO CommonState
-> ExceptT PandocError (StateT CommonState IO) CommonState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT CommonState IO CommonState
forall s (m :: * -> *). MonadState s m => m s
get
  putCommonState :: CommonState -> PandocIO ()
putCommonState x :: CommonState
x = ExceptT PandocError (StateT CommonState IO) () -> PandocIO ()
forall a.
ExceptT PandocError (StateT CommonState IO) a -> PandocIO a
PandocIO (ExceptT PandocError (StateT CommonState IO) () -> PandocIO ())
-> ExceptT PandocError (StateT CommonState IO) () -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState IO ()
-> ExceptT PandocError (StateT CommonState IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState IO ()
 -> ExceptT PandocError (StateT CommonState IO) ())
-> StateT CommonState IO ()
-> ExceptT PandocError (StateT CommonState IO) ()
forall a b. (a -> b) -> a -> b
$ CommonState -> StateT CommonState IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CommonState
x
  logOutput :: LogMessage -> PandocIO ()
logOutput msg :: LogMessage
msg = IO () -> PandocIO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PandocIO ()) -> IO () -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> String -> IO ()
UTF8.hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        "[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Verbosity -> String
forall a. Show a => a -> String
show (LogMessage -> Verbosity
messageVerbosity LogMessage
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "] "
    [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 (m :: * -> *) a. Monad m => a -> m a
return ()
alertIndent (l :: Text
l:ls :: [Text]
ls) = do
  Handle -> String -> IO ()
UTF8.hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack 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 l' :: Text
l' = do Handle -> String -> IO ()
UTF8.hPutStr Handle
stderr "  "
                   Handle -> String -> IO ()
UTF8.hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
l'

-- | Extract media from the mediabag into a directory.
extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc
extractMedia :: String -> Pandoc -> PandocIO Pandoc
extractMedia dir :: String
dir d :: Pandoc
d = do
  MediaBag
media <- PandocIO MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  case [String
fp | (fp :: String
fp, _, _) <- MediaBag -> [(String, Text, Int)]
mediaDirectory MediaBag
media] of
        []  -> Pandoc -> PandocIO Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
d
        fps :: [String]
fps -> do
          (String -> PandocIO ()) -> [String] -> PandocIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> MediaBag -> String -> PandocIO ()
writeMedia String
dir MediaBag
media) [String]
fps
          Pandoc -> PandocIO Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> PandocIO Pandoc) -> Pandoc -> PandocIO Pandoc
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (String -> [String] -> Inline -> Inline
adjustImagePath String
dir [String]
fps) Pandoc
d

-- | Write the contents of a media bag to a path.
writeMedia :: FilePath -> MediaBag -> FilePath -> PandocIO ()
writeMedia :: String -> MediaBag -> String -> PandocIO ()
writeMedia dir :: String
dir mediabag :: MediaBag
mediabag subpath :: String
subpath = do
  -- we join and split to convert a/b/c to a\b\c on Windows;
  -- in zip containers all paths use /
  let fullpath :: String
fullpath = String
dir String -> String -> String
</> String -> String
unEscapeString (String -> String
normalise String
subpath)
  let mbcontents :: Maybe (Text, ByteString)
mbcontents = String -> MediaBag -> Maybe (Text, ByteString)
lookupMedia String
subpath MediaBag
mediabag
  case Maybe (Text, ByteString)
mbcontents of
       Nothing -> PandocError -> PandocIO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocIO ()) -> PandocError -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
subpath
       Just (_, bs :: ByteString
bs) -> do
         LogMessage -> PandocIO ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> PandocIO ()) -> LogMessage -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
Extracting (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
fullpath
         (String -> IO ()) -> String -> PandocIO ()
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True) (String -> String
takeDirectory String
fullpath)
         IO () -> PandocIO ()
logIOError (IO () -> PandocIO ()) -> IO () -> PandocIO ()
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 -> [FilePath] -> Inline -> Inline
adjustImagePath :: String -> [String] -> Inline -> Inline
adjustImagePath dir :: String
dir paths :: [String]
paths (Image attr :: Attr
attr lab :: [Inline]
lab (src :: Text
src, tit :: Text
tit))
   | Text -> String
T.unpack Text
src String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
paths = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (String -> Text
T.pack String
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src, Text
tit)
adjustImagePath _ _ x :: Inline
x = Inline
x