{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Class.PandocMonad
( PandocMonad(..)
, getPOSIXTime
, getZonedTime
, readFileFromDirs
, report
, setTrace
, setRequestHeader
, setNoCheckCertificate
, getLog
, setVerbosity
, getVerbosity
, getMediaBag
, setMediaBag
, insertMedia
, setUserDataDir
, getUserDataDir
, fetchItem
, getInputFiles
, setInputFiles
, getOutputFile
, setOutputFile
, setResourcePath
, getResourcePath
, readDefaultDataFile
, readDataFile
, readMetadataFile
, fillMediaBag
, toLang
, setTranslations
, translateTerm
, makeCanonical
, findFileWithDataFallback
, getTimestamp
) where
import Codec.Archive.Zip
import Control.Monad.Except (MonadError (catchError, throwError),
MonadTrans, lift, when)
import Data.List (foldl')
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds,
posixSecondsToUTCTime)
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
import Network.URI ( escapeURIString, nonStrictRelativeTo,
unEscapeString, parseURIReference, isAllowedInURI,
parseURI, URI(..) )
import System.FilePath ((</>), takeExtension, dropExtension,
isRelative, splitDirectories, makeRelative)
import System.Random (StdGen)
import Text.Collate.Lang (Lang(..), parseLang, renderLang)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.MIME (MimeType, getMimeType)
import Text.Pandoc.MediaBag (MediaBag, lookupMedia, MediaItem(..))
import Text.Pandoc.Shared (uriPathToPath, safeRead)
import Text.Pandoc.Translations (Term(..), Translations, lookupTerm,
readTranslations)
import Text.Pandoc.Walk (walkM)
import Text.Parsec (ParsecT, getPosition, sourceLine, sourceName)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Debug.Trace
import qualified System.FilePath.Posix as Posix
import qualified Text.Pandoc.MediaBag as MB
import qualified Text.Pandoc.UTF8 as UTF8
#ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles)
#endif
class (Functor m, Applicative m, Monad m, MonadError PandocError m)
=> PandocMonad m where
lookupEnv :: T.Text -> m (Maybe T.Text)
getCurrentTime :: m UTCTime
getCurrentTimeZone :: m TimeZone
newStdGen :: m StdGen
newUniqueHash :: m Int
openURL :: T.Text -> m (B.ByteString, Maybe MimeType)
readFileLazy :: FilePath -> m BL.ByteString
readFileStrict :: FilePath -> m B.ByteString
readStdinStrict :: m B.ByteString
glob :: String -> m [FilePath]
fileExists :: FilePath -> m Bool
getDataFileName :: FilePath -> m FilePath
getModificationTime :: FilePath -> m UTCTime
getCommonState :: m CommonState
putCommonState :: CommonState -> m ()
getsCommonState :: (CommonState -> a) -> m a
getsCommonState CommonState -> a
f = CommonState -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
modifyCommonState :: (CommonState -> CommonState) -> m ()
modifyCommonState CommonState -> CommonState
f = forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> CommonState
f
logOutput :: LogMessage -> m ()
trace :: T.Text -> m ()
trace Text
msg = do
Bool
tracing <- forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Bool
stTrace
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tracing forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> a -> a
Debug.Trace.trace ([Char]
"[trace] " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
setVerbosity :: PandocMonad m => Verbosity -> m ()
setVerbosity :: forall (m :: * -> *). PandocMonad m => Verbosity -> m ()
setVerbosity Verbosity
verbosity =
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stVerbosity :: Verbosity
stVerbosity = Verbosity
verbosity }
getVerbosity :: PandocMonad m => m Verbosity
getVerbosity :: forall (m :: * -> *). PandocMonad m => m Verbosity
getVerbosity = forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Verbosity
stVerbosity
getLog :: PandocMonad m => m [LogMessage]
getLog :: forall (m :: * -> *). PandocMonad m => m [LogMessage]
getLog = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [LogMessage]
stLog
report :: PandocMonad m => LogMessage -> m ()
report :: forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report LogMessage
msg = do
Verbosity
verbosity <- forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Verbosity
stVerbosity
let level :: Verbosity
level = LogMessage -> Verbosity
messageVerbosity LogMessage
msg
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
level forall a. Ord a => a -> a -> Bool
<= Verbosity
verbosity) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
logOutput LogMessage
msg
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stLog :: [LogMessage]
stLog = LogMessage
msg forall a. a -> [a] -> [a]
: CommonState -> [LogMessage]
stLog CommonState
st }
getTimestamp :: PandocMonad m => m UTCTime
getTimestamp :: forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp = do
Maybe Text
mbSourceDateEpoch <- forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv Text
"SOURCE_DATE_EPOCH"
case Maybe Text
mbSourceDateEpoch forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead of
Just (Integer
epoch :: Integer) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
epoch
Maybe Integer
Nothing -> forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
setTrace :: PandocMonad m => Bool -> m ()
setTrace :: forall (m :: * -> *). PandocMonad m => Bool -> m ()
setTrace Bool
useTracing = forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stTrace :: Bool
stTrace = Bool
useTracing}
setRequestHeader :: PandocMonad m
=> T.Text
-> T.Text
-> m ()
Text
name Text
val = forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st ->
CommonState
st{ stRequestHeaders :: [(Text, Text)]
stRequestHeaders =
(Text
name, Text
val) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
n,Text
_) -> Text
n forall a. Eq a => a -> a -> Bool
/= Text
name) (CommonState -> [(Text, Text)]
stRequestHeaders CommonState
st) }
setNoCheckCertificate :: PandocMonad m => Bool -> m ()
setNoCheckCertificate :: forall (m :: * -> *). PandocMonad m => Bool -> m ()
setNoCheckCertificate Bool
noCheckCertificate = forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stNoCheckCertificate :: Bool
stNoCheckCertificate = Bool
noCheckCertificate}
setMediaBag :: PandocMonad m => MediaBag -> m ()
setMediaBag :: forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag MediaBag
mb = forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stMediaBag :: MediaBag
stMediaBag = MediaBag
mb}
getMediaBag :: PandocMonad m => m MediaBag
getMediaBag :: forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag = forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> MediaBag
stMediaBag
insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()
insertMedia :: forall (m :: * -> *).
PandocMonad m =>
[Char] -> Maybe Text -> ByteString -> m ()
insertMedia [Char]
fp Maybe Text
mime ByteString
bs = do
MediaBag
mb <- forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
let mb' :: MediaBag
mb' = [Char] -> Maybe Text -> ByteString -> MediaBag -> MediaBag
MB.insertMedia [Char]
fp Maybe Text
mime ByteString
bs MediaBag
mb
forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag MediaBag
mb'
getInputFiles :: PandocMonad m => m [FilePath]
getInputFiles :: forall (m :: * -> *). PandocMonad m => m [[Char]]
getInputFiles = forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [[Char]]
stInputFiles
setInputFiles :: PandocMonad m => [FilePath] -> m ()
setInputFiles :: forall (m :: * -> *). PandocMonad m => [[Char]] -> m ()
setInputFiles [[Char]]
fs = do
let sourceURL :: Maybe [Char]
sourceURL = case [[Char]]
fs of
[] -> forall a. Maybe a
Nothing
([Char]
x:[[Char]]
_) -> case [Char] -> Maybe URI
parseURI [Char]
x of
Just URI
u
| URI -> [Char]
uriScheme URI
u forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"http:",[Char]
"https:"] ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show URI
u{ uriQuery :: [Char]
uriQuery = [Char]
"",
uriFragment :: [Char]
uriFragment = [Char]
"" }
Maybe URI
_ -> forall a. Maybe a
Nothing
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stInputFiles :: [[Char]]
stInputFiles = [[Char]]
fs
, stSourceURL :: Maybe Text
stSourceURL = [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
sourceURL }
getOutputFile :: PandocMonad m => m (Maybe FilePath)
getOutputFile :: forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getOutputFile = forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe [Char]
stOutputFile
setOutputFile :: PandocMonad m => Maybe FilePath -> m ()
setOutputFile :: forall (m :: * -> *). PandocMonad m => Maybe [Char] -> m ()
setOutputFile Maybe [Char]
mbf = forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stOutputFile :: Maybe [Char]
stOutputFile = Maybe [Char]
mbf }
getResourcePath :: PandocMonad m => m [FilePath]
getResourcePath :: forall (m :: * -> *). PandocMonad m => m [[Char]]
getResourcePath = forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [[Char]]
stResourcePath
setResourcePath :: PandocMonad m => [FilePath] -> m ()
setResourcePath :: forall (m :: * -> *). PandocMonad m => [[Char]] -> m ()
setResourcePath [[Char]]
ps = forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stResourcePath :: [[Char]]
stResourcePath = [[Char]]
ps}
getPOSIXTime :: PandocMonad m => m POSIXTime
getPOSIXTime :: forall (m :: * -> *). PandocMonad m => m POSIXTime
getPOSIXTime = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
getZonedTime :: PandocMonad m => m ZonedTime
getZonedTime :: forall (m :: * -> *). PandocMonad m => m ZonedTime
getZonedTime = do
UTCTime
t <- forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
TimeZone
tz <- forall (m :: * -> *). PandocMonad m => m TimeZone
getCurrentTimeZone
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz UTCTime
t
readFileFromDirs :: PandocMonad m => [FilePath] -> FilePath -> m (Maybe T.Text)
readFileFromDirs :: forall (m :: * -> *).
PandocMonad m =>
[[Char]] -> [Char] -> m (Maybe Text)
readFileFromDirs [] [Char]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
readFileFromDirs ([Char]
d:[[Char]]
ds) [Char]
f = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
(forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
UTF8.toStringLazy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f))
(\PandocError
_ -> forall (m :: * -> *).
PandocMonad m =>
[[Char]] -> [Char] -> m (Maybe Text)
readFileFromDirs [[Char]]
ds [Char]
f)
toLang :: PandocMonad m => Maybe T.Text -> m (Maybe Lang)
toLang :: forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang Maybe Text
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
toLang (Just Text
s) =
case Text -> Either [Char] Lang
parseLang Text
s of
Left [Char]
_ -> do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
InvalidLang Text
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Right Lang
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Lang
l)
setTranslations :: PandocMonad m => Lang -> m ()
setTranslations :: forall (m :: * -> *). PandocMonad m => Lang -> m ()
setTranslations Lang
lang =
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. a -> Maybe a
Just (Lang
lang, forall a. Maybe a
Nothing) }
getTranslations :: PandocMonad m => m Translations
getTranslations :: forall (m :: * -> *). PandocMonad m => m Translations
getTranslations = do
Maybe (Lang, Maybe Translations)
mbtrans <- forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe (Lang, Maybe Translations)
stTranslations
case Maybe (Lang, Maybe Translations)
mbtrans of
Maybe (Lang, Maybe Translations)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Just (Lang
_, Just Translations
t) -> forall (m :: * -> *) a. Monad m => a -> m a
return Translations
t
Just (Lang
lang, Maybe Translations
Nothing) -> do
let translationFile :: Text
translationFile = Text
"translations/" forall a. Semigroup a => a -> a -> a
<> Lang -> Text
renderLang Lang
lang forall a. Semigroup a => a -> a -> a
<> Text
".yaml"
let fallbackFile :: Text
fallbackFile = Text
"translations/" forall a. Semigroup a => a -> a -> a
<> Lang -> Text
langLanguage Lang
lang forall a. Semigroup a => a -> a -> a
<> Text
".yaml"
let getTrans :: [Char] -> m Translations
getTrans [Char]
fp = do
ByteString
bs <- forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile [Char]
fp
case Text -> Either Text Translations
readTranslations (ByteString -> Text
UTF8.toText ByteString
bs) of
Left Text
e -> do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotLoadTranslations (Lang -> Text
renderLang Lang
lang)
([Char] -> Text
T.pack [Char]
fp forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
e)
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st ->
CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. Maybe a
Nothing }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Right Translations
t -> do
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st ->
CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. a -> Maybe a
Just (Lang
lang, forall a. a -> Maybe a
Just Translations
t) }
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
t
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall {m :: * -> *}. PandocMonad m => [Char] -> m Translations
getTrans forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
translationFile)
(\PandocError
_ ->
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall {m :: * -> *}. PandocMonad m => [Char] -> m Translations
getTrans forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
fallbackFile)
(\PandocError
e -> do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotLoadTranslations (Lang -> Text
renderLang Lang
lang)
forall a b. (a -> b) -> a -> b
$ case PandocError
e of
PandocCouldNotFindDataFileError Text
_ ->
Text
"data file " forall a. Semigroup a => a -> a -> a
<> Text
fallbackFile forall a. Semigroup a => a -> a -> a
<> Text
" not found"
PandocError
_ -> Text
""
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = forall a. Maybe a
Nothing }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty))
translateTerm :: PandocMonad m => Term -> m T.Text
translateTerm :: forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
term = do
Translations
translations <- forall (m :: * -> *). PandocMonad m => m Translations
getTranslations
case Term -> Translations -> Maybe Text
lookupTerm Term
term Translations
translations of
Just Text
s -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
Maybe Text
Nothing -> do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
NoTranslation forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Term
term
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
parseURIReference' :: T.Text -> Maybe URI
parseURIReference' :: Text -> Maybe URI
parseURIReference' Text
s = do
URI
u <- [Char] -> Maybe URI
parseURIReference (Text -> [Char]
T.unpack Text
s)
case URI -> [Char]
uriScheme URI
u of
[Char
_] -> forall a. Maybe a
Nothing
[Char]
_ -> forall a. a -> Maybe a
Just URI
u
setUserDataDir :: PandocMonad m
=> Maybe FilePath
-> m ()
setUserDataDir :: forall (m :: * -> *). PandocMonad m => Maybe [Char] -> m ()
setUserDataDir Maybe [Char]
mbfp = forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stUserDataDir :: Maybe [Char]
stUserDataDir = Maybe [Char]
mbfp }
getUserDataDir :: PandocMonad m
=> m (Maybe FilePath)
getUserDataDir :: forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir = forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe [Char]
stUserDataDir
fetchItem :: PandocMonad m
=> T.Text
-> m (B.ByteString, Maybe MimeType)
fetchItem :: forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
s = do
MediaBag
mediabag <- forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
case [Char] -> MediaBag -> Maybe MediaItem
lookupMedia (Text -> [Char]
T.unpack Text
s) MediaBag
mediabag of
Just MediaItem
item -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
BL.toStrict (MediaItem -> ByteString
mediaContents MediaItem
item),
forall a. a -> Maybe a
Just (MediaItem -> Text
mediaMimeType MediaItem
item))
Maybe MediaItem
Nothing -> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
downloadOrRead Text
s
downloadOrRead :: PandocMonad m
=> T.Text
-> m (B.ByteString, Maybe MimeType)
downloadOrRead :: forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
downloadOrRead Text
s = do
Maybe Text
sourceURL <- forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe Text
stSourceURL
case (Maybe Text
sourceURL forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe URI
parseURIReference' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text
ensureEscaped, Text -> Text
ensureEscaped Text
s) of
(Just URI
u, Text
s') ->
case Text -> Maybe URI
parseURIReference' Text
s' of
Just URI
u' -> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ URI
u' URI -> URI -> URI
`nonStrictRelativeTo` URI
u
Maybe URI
Nothing -> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
s'
(Maybe URI
Nothing, s' :: Text
s'@(Text -> [Char]
T.unpack -> (Char
'/':Char
'/':Char
c:[Char]
_))) | Char
c forall a. Eq a => a -> a -> Bool
/= Char
'?' ->
case Text -> Maybe URI
parseURIReference' Text
s' of
Just URI
u' -> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ URI
u' URI -> URI -> URI
`nonStrictRelativeTo` URI
httpcolon
Maybe URI
Nothing -> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
s'
(Maybe URI
Nothing, Text
s') ->
case [Char] -> Maybe URI
parseURI (Text -> [Char]
T.unpack Text
s') of
Just URI
u' | URI -> [Char]
uriScheme URI
u' forall a. Eq a => a -> a -> Bool
== [Char]
"file:" ->
forall {m :: * -> *}.
PandocMonad m =>
[Char] -> m (ByteString, Maybe Text)
readLocalFile forall a b. (a -> b) -> a -> b
$ Text -> [Char]
uriPathToPath ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ URI -> [Char]
uriPath URI
u')
Just URI
u' | forall (t :: * -> *) a. Foldable t => t a -> Int
length (URI -> [Char]
uriScheme URI
u') forall a. Ord a => a -> a -> Bool
> Int
2 -> forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show URI
u')
Maybe URI
_ -> forall {m :: * -> *}.
PandocMonad m =>
[Char] -> m (ByteString, Maybe Text)
readLocalFile [Char]
fp
where readLocalFile :: [Char] -> m (ByteString, Maybe Text)
readLocalFile [Char]
f = do
[[Char]]
resourcePath <- forall (m :: * -> *). PandocMonad m => m [[Char]]
getResourcePath
([Char]
fp', ByteString
cont) <- if [Char] -> Bool
isRelative [Char]
f
then forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [[Char]]
resourcePath forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
f
else ([Char]
f,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
f
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> LogMessage
LoadedResource [Char]
f ([Char] -> [Char] -> [Char]
makeRelative [Char]
"." [Char]
fp')
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
cont, Maybe Text
mime)
httpcolon :: URI
httpcolon = URI{ uriScheme :: [Char]
uriScheme = [Char]
"http:",
uriAuthority :: Maybe URIAuth
uriAuthority = forall a. Maybe a
Nothing,
uriPath :: [Char]
uriPath = [Char]
"",
uriQuery :: [Char]
uriQuery = [Char]
"",
uriFragment :: [Char]
uriFragment = [Char]
"" }
dropFragmentAndQuery :: Text -> Text
dropFragmentAndQuery = (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
'#')
fp :: [Char]
fp = [Char] -> [Char]
unEscapeString forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
dropFragmentAndQuery Text
s
mime :: Maybe Text
mime = [Char] -> Maybe Text
getMimeType forall a b. (a -> b) -> a -> b
$ case [Char] -> [Char]
takeExtension [Char]
fp of
[Char]
".gz" -> [Char] -> [Char]
dropExtension [Char]
fp
[Char]
".svgz" -> [Char] -> [Char]
dropExtension [Char]
fp forall a. [a] -> [a] -> [a]
++ [Char]
".svg"
[Char]
x -> [Char]
x
ensureEscaped :: Text -> Text
ensureEscaped = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
escapeURIString Char -> Bool
isAllowedInURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
convertSlash
convertSlash :: Char -> Char
convertSlash Char
'\\' = Char
'/'
convertSlash Char
x = Char
x
getDefaultReferenceDocx :: PandocMonad m => m Archive
getDefaultReferenceDocx :: forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceDocx = do
let paths :: [[Char]]
paths = [[Char]
"[Content_Types].xml",
[Char]
"_rels/.rels",
[Char]
"docProps/app.xml",
[Char]
"docProps/core.xml",
[Char]
"docProps/custom.xml",
[Char]
"word/document.xml",
[Char]
"word/fontTable.xml",
[Char]
"word/footnotes.xml",
[Char]
"word/comments.xml",
[Char]
"word/numbering.xml",
[Char]
"word/settings.xml",
[Char]
"word/webSettings.xml",
[Char]
"word/styles.xml",
[Char]
"word/_rels/document.xml.rels",
[Char]
"word/_rels/footnotes.xml.rels",
[Char]
"word/theme/theme1.xml"]
let toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
BL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
let pathToEntry :: [Char] -> m Entry
pathToEntry [Char]
path = do
Integer
epochtime <- forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp
ByteString
contents <- ByteString -> ByteString
toLazy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile ([Char]
"docx/" forall a. [a] -> [a] -> [a]
++ [Char]
path)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Integer -> ByteString -> Entry
toEntry [Char]
path Integer
epochtime ByteString
contents
Maybe [Char]
datadir <- forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
Maybe [Char]
mbArchive <- case Maybe [Char]
datadir of
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just [Char]
d -> do
Bool
exists <- forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.docx")
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.docx"))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
case Maybe [Char]
mbArchive of
Just [Char]
arch -> ByteString -> Archive
toArchive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy [Char]
arch
Maybe [Char]
Nothing -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive 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 => [Char] -> m Entry
pathToEntry [[Char]]
paths
getDefaultReferenceODT :: PandocMonad m => m Archive
getDefaultReferenceODT :: forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceODT = do
let paths :: [[Char]]
paths = [[Char]
"mimetype",
[Char]
"manifest.rdf",
[Char]
"styles.xml",
[Char]
"content.xml",
[Char]
"meta.xml",
[Char]
"settings.xml",
[Char]
"Configurations2/accelerator/current.xml",
[Char]
"Thumbnails/thumbnail.png",
[Char]
"META-INF/manifest.xml"]
let pathToEntry :: [Char] -> m Entry
pathToEntry [Char]
path = do Integer
epochtime <- forall a b. (RealFrac a, Integral b) => a -> b
floor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *). PandocMonad m => m POSIXTime
getPOSIXTime
ByteString
contents <- ([ByteString] -> ByteString
BL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile ([Char]
"odt/" forall a. [a] -> [a] -> [a]
++ [Char]
path)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Integer -> ByteString -> Entry
toEntry [Char]
path Integer
epochtime ByteString
contents
Maybe [Char]
datadir <- forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
Maybe [Char]
mbArchive <- case Maybe [Char]
datadir of
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just [Char]
d -> do
Bool
exists <- forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.odt")
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.odt"))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
case Maybe [Char]
mbArchive of
Just [Char]
arch -> ByteString -> Archive
toArchive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy [Char]
arch
Maybe [Char]
Nothing -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive 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 => [Char] -> m Entry
pathToEntry [[Char]]
paths
getDefaultReferencePptx :: PandocMonad m => m Archive
getDefaultReferencePptx :: forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferencePptx = do
let paths :: [[Char]]
paths = [ [Char]
"[Content_Types].xml"
, [Char]
"_rels/.rels"
, [Char]
"docProps/app.xml"
, [Char]
"docProps/core.xml"
, [Char]
"ppt/_rels/presentation.xml.rels"
, [Char]
"ppt/presProps.xml"
, [Char]
"ppt/presentation.xml"
, [Char]
"ppt/slideLayouts/_rels/slideLayout1.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout2.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout3.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout4.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout5.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout6.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout7.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout8.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout9.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout10.xml.rels"
, [Char]
"ppt/slideLayouts/_rels/slideLayout11.xml.rels"
, [Char]
"ppt/slideLayouts/slideLayout1.xml"
, [Char]
"ppt/slideLayouts/slideLayout10.xml"
, [Char]
"ppt/slideLayouts/slideLayout11.xml"
, [Char]
"ppt/slideLayouts/slideLayout2.xml"
, [Char]
"ppt/slideLayouts/slideLayout3.xml"
, [Char]
"ppt/slideLayouts/slideLayout4.xml"
, [Char]
"ppt/slideLayouts/slideLayout5.xml"
, [Char]
"ppt/slideLayouts/slideLayout6.xml"
, [Char]
"ppt/slideLayouts/slideLayout7.xml"
, [Char]
"ppt/slideLayouts/slideLayout8.xml"
, [Char]
"ppt/slideLayouts/slideLayout9.xml"
, [Char]
"ppt/slideMasters/_rels/slideMaster1.xml.rels"
, [Char]
"ppt/slideMasters/slideMaster1.xml"
, [Char]
"ppt/slides/_rels/slide1.xml.rels"
, [Char]
"ppt/slides/slide1.xml"
, [Char]
"ppt/slides/_rels/slide2.xml.rels"
, [Char]
"ppt/slides/slide2.xml"
, [Char]
"ppt/slides/_rels/slide3.xml.rels"
, [Char]
"ppt/slides/slide3.xml"
, [Char]
"ppt/slides/_rels/slide4.xml.rels"
, [Char]
"ppt/slides/slide4.xml"
, [Char]
"ppt/tableStyles.xml"
, [Char]
"ppt/theme/theme1.xml"
, [Char]
"ppt/viewProps.xml"
, [Char]
"ppt/notesMasters/notesMaster1.xml"
, [Char]
"ppt/notesMasters/_rels/notesMaster1.xml.rels"
, [Char]
"ppt/notesSlides/notesSlide1.xml"
, [Char]
"ppt/notesSlides/_rels/notesSlide1.xml.rels"
, [Char]
"ppt/notesSlides/notesSlide2.xml"
, [Char]
"ppt/notesSlides/_rels/notesSlide2.xml.rels"
, [Char]
"ppt/theme/theme2.xml"
]
let toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
BL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
let pathToEntry :: [Char] -> m Entry
pathToEntry [Char]
path = do
Integer
epochtime <- forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
ByteString
contents <- ByteString -> ByteString
toLazy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile ([Char]
"pptx/" forall a. [a] -> [a] -> [a]
++ [Char]
path)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Integer -> ByteString -> Entry
toEntry [Char]
path Integer
epochtime ByteString
contents
Maybe [Char]
datadir <- forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
Maybe [Char]
mbArchive <- case Maybe [Char]
datadir of
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just [Char]
d -> do
Bool
exists <- forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.pptx")
if Bool
exists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.pptx"))
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
case Maybe [Char]
mbArchive of
Just [Char]
arch -> ByteString -> Archive
toArchive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy [Char]
arch
Maybe [Char]
Nothing -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive 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 => [Char] -> m Entry
pathToEntry [[Char]]
paths
isRelativeToParentDir :: FilePath -> Bool
isRelativeToParentDir :: [Char] -> Bool
isRelativeToParentDir [Char]
fname =
let canonical :: [Char]
canonical = [Char] -> [Char]
makeCanonical [Char]
fname
in forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
canonical forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
2 [Char]
canonical forall a. Eq a => a -> a -> Bool
== [Char]
".."
checkUserDataDir :: PandocMonad m => FilePath -> m (Maybe FilePath)
checkUserDataDir :: forall (m :: * -> *). PandocMonad m => [Char] -> m (Maybe [Char])
checkUserDataDir [Char]
fname =
if [Char] -> Bool
isRelative [Char]
fname Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char] -> Bool
isRelativeToParentDir [Char]
fname)
then forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
readDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDataFile :: forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile [Char]
fname = do
Maybe [Char]
datadir <- forall (m :: * -> *). PandocMonad m => [Char] -> m (Maybe [Char])
checkUserDataDir [Char]
fname
case Maybe [Char]
datadir of
Maybe [Char]
Nothing -> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDefaultDataFile [Char]
fname
Just [Char]
userDir -> do
Bool
exists <- forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
userDir [Char] -> [Char] -> [Char]
</> [Char]
fname)
if Bool
exists
then forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict ([Char]
userDir [Char] -> [Char] -> [Char]
</> [Char]
fname)
else forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDefaultDataFile [Char]
fname
readMetadataFile :: PandocMonad m => FilePath -> m B.ByteString
readMetadataFile :: forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readMetadataFile [Char]
fname = forall (m :: * -> *).
PandocMonad m =>
[Char] -> [Char] -> m (Maybe [Char])
findFileWithDataFallback [Char]
"metadata" [Char]
fname forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe [Char]
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocCouldNotFindMetadataFileError ([Char] -> Text
T.pack [Char]
fname)
Just [Char]
metadataFile -> forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
metadataFile
readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDefaultDataFile :: forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDefaultDataFile [Char]
"reference.docx" =
[ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> ByteString
fromArchive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceDocx
readDefaultDataFile [Char]
"reference.pptx" =
[ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> ByteString
fromArchive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferencePptx
readDefaultDataFile [Char]
"reference.odt" =
[ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> ByteString
fromArchive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceODT
readDefaultDataFile [Char]
fname =
#ifdef EMBED_DATA_FILES
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([Char] -> [Char]
makeCanonical [Char]
fname) [([Char], ByteString)]
dataFiles of
Maybe ByteString
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocCouldNotFindDataFileError forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
fname
Just ByteString
contents -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
contents
#else
getDataFileName fname' >>= checkExistence >>= readFileStrict
where fname' = if fname == "MANUAL.txt" then fname else "data" </> fname
checkExistence :: PandocMonad m => FilePath -> m FilePath
checkExistence fn = do
exists <- fileExists fn
if exists
then return fn
else throwError $ PandocCouldNotFindDataFileError $ T.pack fn
#endif
makeCanonical :: FilePath -> FilePath
makeCanonical :: [Char] -> [Char]
makeCanonical = [[Char]] -> [Char]
Posix.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
transformPathParts forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories
where transformPathParts :: [[Char]] -> [[Char]]
transformPathParts = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. (Eq a, IsString a) => [a] -> a -> [a]
go []
go :: [a] -> a -> [a]
go [a]
as a
"." = [a]
as
go (a
"..":[a]
as) a
".." = [a
"..", a
".."] forall a. Semigroup a => a -> a -> a
<> [a]
as
go (a
_:[a]
as) a
".." = [a]
as
go [a]
as a
x = a
x forall a. a -> [a] -> [a]
: [a]
as
withPaths :: PandocMonad m
=> [FilePath] -> (FilePath -> m a) -> FilePath -> m (FilePath, a)
withPaths :: forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [] [Char] -> m a
_ [Char]
fp = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
fp
withPaths ([Char]
p:[[Char]]
ps) [Char] -> m a
action [Char]
fp =
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (([Char]
p [Char] -> [Char] -> [Char]
</> [Char]
fp,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m a
action ([Char]
p [Char] -> [Char] -> [Char]
</> [Char]
fp))
(\PandocError
_ -> forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [[Char]]
ps [Char] -> m a
action [Char]
fp)
findFileWithDataFallback :: PandocMonad m
=> FilePath
-> FilePath
-> m (Maybe FilePath)
findFileWithDataFallback :: forall (m :: * -> *).
PandocMonad m =>
[Char] -> [Char] -> m (Maybe [Char])
findFileWithDataFallback [Char]
subdir [Char]
fp = do
Bool
existsInWorkingDir <- forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists [Char]
fp
if Bool
existsInWorkingDir
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Char]
fp
else do
Maybe [Char]
mbDataDir <- forall (m :: * -> *). PandocMonad m => [Char] -> m (Maybe [Char])
checkUserDataDir [Char]
fp
case Maybe [Char]
mbDataDir of
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just [Char]
datadir -> do
let datafp :: [Char]
datafp = [Char]
datadir [Char] -> [Char] -> [Char]
</> [Char]
subdir [Char] -> [Char] -> [Char]
</> [Char]
fp
Bool
existsInDataDir <- forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists [Char]
datafp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
existsInDataDir
then forall a. a -> Maybe a
Just [Char]
datafp
else forall a. Maybe a
Nothing
fillMediaBag :: PandocMonad m => Pandoc -> m Pandoc
fillMediaBag :: forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
fillMediaBag Pandoc
d = forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM forall (m :: * -> *). PandocMonad m => Inline -> m Inline
handleImage Pandoc
d
where handleImage :: PandocMonad m => Inline -> m Inline
handleImage :: forall (m :: * -> *). PandocMonad m => Inline -> m Inline
handleImage (Image Attr
attr [Inline]
lab (Text
src, Text
tit)) = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
(do MediaBag
mediabag <- forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
let fp :: [Char]
fp = Text -> [Char]
T.unpack Text
src
case [Char] -> MediaBag -> Maybe MediaItem
lookupMedia [Char]
fp MediaBag
mediabag of
Just MediaItem
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe MediaItem
Nothing -> do
(ByteString
bs, Maybe Text
mt) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
forall (m :: * -> *).
PandocMonad m =>
[Char] -> Maybe Text -> ByteString -> m ()
insertMedia [Char]
fp Maybe Text
mt (ByteString -> ByteString
BL.fromStrict ByteString
bs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (Text
src, Text
tit))
(\PandocError
e ->
case PandocError
e of
PandocResourceNotFound Text
_ -> do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src
Text
"replacing image with description"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> [Inline] -> Inline
replacementSpan Attr
attr Text
src Text
tit [Inline]
lab
PandocHttpError Text
u HttpException
er -> do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
u
([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show HttpException
er forall a. [a] -> [a] -> [a]
++ [Char]
"\rReplacing image with description.")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> [Inline] -> Inline
replacementSpan Attr
attr Text
src Text
tit [Inline]
lab
PandocError
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)
handleImage Inline
x = forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
replacementSpan :: Attr -> Text -> Text -> [Inline] -> Inline
replacementSpan (Text
ident, [Text]
classes, [(Text, Text)]
attribs) Text
src Text
title [Inline]
descr =
Attr -> [Inline] -> Inline
Span ( Text
ident
, Text
"image"forall a. a -> [a] -> [a]
:Text
"placeholder"forall a. a -> [a] -> [a]
:[Text]
classes
, (Text
"original-image-src", Text
src) forall a. a -> [a] -> [a]
:
(Text
"original-image-title", Text
title) forall a. a -> [a] -> [a]
:
[(Text, Text)]
attribs
)
[Inline]
descr
instance (MonadTrans t, PandocMonad m, Functor (t m),
MonadError PandocError (t m), Monad (t m),
Applicative (t m)) => PandocMonad (t m) where
lookupEnv :: Text -> t m (Maybe Text)
lookupEnv = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv
getCurrentTime :: t m UTCTime
getCurrentTime = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
getCurrentTimeZone :: t m TimeZone
getCurrentTimeZone = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m TimeZone
getCurrentTimeZone
newStdGen :: t m StdGen
newStdGen = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m StdGen
newStdGen
newUniqueHash :: t m Int
newUniqueHash = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m Int
newUniqueHash
openURL :: Text -> t m (ByteString, Maybe Text)
openURL = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL
readFileLazy :: [Char] -> t m ByteString
readFileLazy = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy
readFileStrict :: [Char] -> t m ByteString
readFileStrict = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict
readStdinStrict :: t m ByteString
readStdinStrict = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m ByteString
readStdinStrict
glob :: [Char] -> t m [[Char]]
glob = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m [[Char]]
glob
fileExists :: [Char] -> t m Bool
fileExists = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists
getDataFileName :: [Char] -> t m [Char]
getDataFileName = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
getDataFileName
getModificationTime :: [Char] -> t m UTCTime
getModificationTime = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m UTCTime
getModificationTime
getCommonState :: t m CommonState
getCommonState = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
putCommonState :: CommonState -> t m ()
putCommonState = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState
logOutput :: LogMessage -> t m ()
logOutput = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
logOutput
instance {-# OVERLAPS #-} PandocMonad m => PandocMonad (ParsecT s st m) where
lookupEnv :: Text -> ParsecT s st m (Maybe Text)
lookupEnv = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv
getCurrentTime :: ParsecT s st m UTCTime
getCurrentTime = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
getCurrentTimeZone :: ParsecT s st m TimeZone
getCurrentTimeZone = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m TimeZone
getCurrentTimeZone
newStdGen :: ParsecT s st m StdGen
newStdGen = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m StdGen
newStdGen
newUniqueHash :: ParsecT s st m Int
newUniqueHash = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m Int
newUniqueHash
openURL :: Text -> ParsecT s st m (ByteString, Maybe Text)
openURL = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL
readFileLazy :: [Char] -> ParsecT s st m ByteString
readFileLazy = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy
readFileStrict :: [Char] -> ParsecT s st m ByteString
readFileStrict = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict
readStdinStrict :: ParsecT s st m ByteString
readStdinStrict = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m ByteString
readStdinStrict
glob :: [Char] -> ParsecT s st m [[Char]]
glob = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m [[Char]]
glob
fileExists :: [Char] -> ParsecT s st m Bool
fileExists = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists
getDataFileName :: [Char] -> ParsecT s st m [Char]
getDataFileName = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
getDataFileName
getModificationTime :: [Char] -> ParsecT s st m UTCTime
getModificationTime = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => [Char] -> m UTCTime
getModificationTime
getCommonState :: ParsecT s st m CommonState
getCommonState = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
putCommonState :: CommonState -> ParsecT s st m ()
putCommonState = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState
trace :: Text -> ParsecT s st m ()
trace Text
msg = do
Bool
tracing <- forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Bool
stTrace
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tracing forall a b. (a -> b) -> a -> b
$ do
SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
forall a. [Char] -> a -> a
Debug.Trace.trace
([Char]
"[trace] Parsed " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg forall a. [a] -> [a] -> [a]
++ [Char]
" at line " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> [Char]
show (SourcePos -> Int
sourceLine SourcePos
pos) forall a. [a] -> [a] -> [a]
++
if SourcePos -> [Char]
sourceName SourcePos
pos forall a. Eq a => a -> a -> Bool
== [Char]
"chunk"
then [Char]
" of chunk"
else [Char]
"")
(forall (m :: * -> *) a. Monad m => a -> m a
return ())
logOutput :: LogMessage -> ParsecT s st m ()
logOutput = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
logOutput