{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
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.ByteString.Base64 (decodeBase64Lenient)
import Data.ByteString.Lazy (toChunks)
import Data.Text (Text, pack, unpack)
import Data.Time (TimeZone, UTCTime)
import Data.Unique (hashUnique)
import Network.Connection (TLSSettings (TLSSettingsSimple))
import Network.HTTP.Client
(httpLbs, responseBody, responseHeaders,
Request(port, host, requestHeaders), parseRequest, newManager)
import Network.HTTP.Client.Internal (addProxy)
import Network.HTTP.Client.TLS (mkManagerSettings)
import Network.HTTP.Types.Header ( hContentType )
import Network.Socket (withSocketsDo)
import Network.URI (unEscapeString)
import System.Directory (createDirectoryIfMissing)
import System.Environment (getEnv)
import System.FilePath ((</>), takeDirectory, normalise)
import qualified System.FilePath.Posix as Posix
import System.IO (stderr)
import System.IO.Error
import System.Random (StdGen)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad
(PandocMonad, getsCommonState, getMediaBag, report)
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.CaseInsensitive as CI
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
#ifndef EMBED_DATA_FILES
import qualified Paths_pandoc as Paths
#endif
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
Either IOError a
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 Either IOError a
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
logIOError :: (PandocMonad m, MonadIO m) => IO () -> m ()
logIOError :: forall (m :: * -> *). (PandocMonad m, MonadIO m) => IO () -> m ()
logIOError IO ()
f = do
Either IOError ()
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 Either IOError ()
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 ()
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
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
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
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
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
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 Text
u'' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"data:" Text
u = do
let mime :: Text
mime = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
',') Text
u''
let contents :: ByteString
contents = String -> ByteString
UTF8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
String -> String
unEscapeString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
',') Text
u''
(ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
decodeBase64Lenient ByteString
contents, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mime)
| 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)
[(HeaderName, ByteString)]
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
Bool
disableCertificateValidation <- (CommonState -> Bool) -> m Bool
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Bool
stNoCheckCertificate
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
Fetching Text
u
Either HttpException (ByteString, Maybe Text)
res <- IO (Either HttpException (ByteString, Maybe Text))
-> m (Either HttpException (ByteString, Maybe Text))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException (ByteString, Maybe Text))
-> m (Either HttpException (ByteString, Maybe Text)))
-> IO (Either HttpException (ByteString, Maybe Text))
-> m (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 String
"http_proxy")
let addProxy' :: Request -> IO Request
addProxy' Request
x = case Either IOError String
proxy of
Left IOError
_ -> Request -> IO Request
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
x
Right String
pr -> String -> IO Request
parseReq String
pr IO Request -> (Request -> IO Request) -> IO Request
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Request
r ->
Request -> IO Request
forall a. a -> IO 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)
Request
req <- String -> IO Request
parseReq (Text -> String
unpack Text
u) IO Request -> (Request -> IO Request) -> IO Request
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO Request
addProxy'
let req' :: Request
req' = Request
req{requestHeaders :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
customHeaders [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. [a] -> [a] -> [a]
++ Request -> [(HeaderName, ByteString)]
requestHeaders Request
req}
let tlsSimple :: TLSSettings
tlsSimple = Bool -> Bool -> Bool -> TLSSettings
TLSSettingsSimple Bool
disableCertificateValidation Bool
False Bool
False
let tlsManagerSettings :: ManagerSettings
tlsManagerSettings = TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettings TLSSettings
tlsSimple Maybe SockSettings
forall a. Maybe a
Nothing
Response ByteString
resp <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings IO Manager
-> (Manager -> IO (Response ByteString))
-> IO (Response ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType (Response ByteString -> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders Response ByteString
resp))
case Either HttpException (ByteString, Maybe Text)
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 -> 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 -> HttpException -> PandocError
PandocHttpError Text
u HttpException
e
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
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
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"
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
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
getDataFileName :: (PandocMonad m, MonadIO m) => FilePath -> m FilePath
#ifdef EMBED_DATA_FILES
getDataFileName :: forall (m :: * -> *).
(PandocMonad m, MonadIO m) =>
String -> m String
getDataFileName = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
#else
getDataFileName = liftIOError Paths.getDataFileName
#endif
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
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
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'
extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc
String
dir Pandoc
d = do
MediaBag
media <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
let items :: [(String, Text, ByteString)]
items = MediaBag -> [(String, Text, ByteString)]
mediaItems MediaBag
media
if [(String, Text, ByteString)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Text, ByteString)]
items
then Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
d
else do
((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
Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (String -> MediaBag -> Inline -> Inline
adjustImagePath String
dir MediaBag
media) Pandoc
d
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
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)
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
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