{-# 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(..)
, getTimestamp
, getPOSIXTime
, getZonedTime
, readFileFromDirs
, report
, setTrace
, setRequestHeader
, setNoCheckCertificate
, getLog
, setVerbosity
, getVerbosity
, getMediaBag
, setMediaBag
, insertMedia
, setUserDataDir
, getUserDataDir
, fetchItem
, getInputFiles
, setInputFiles
, getOutputFile
, setOutputFile
, setResourcePath
, getResourcePath
, readMetadataFile
, toTextM
, fillMediaBag
, toLang
, makeCanonical
, findFileWithDataFallback
, checkUserDataDir
) where
import Control.Monad.Except (MonadError (catchError, throwError))
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad (when)
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, makeRelative)
import System.Random (StdGen)
import Text.Collate.Lang (Lang(..), parseLang)
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 (safeRead, makeCanonical, tshow)
import Text.Pandoc.URI (uriPathToPath)
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 Text.Pandoc.MediaBag as MB
import qualified Data.Text.Encoding as TSE
import qualified Data.Text.Encoding.Error as TSE
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 (CommonState -> a) -> m CommonState -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
modifyCommonState :: (CommonState -> CommonState) -> m ()
modifyCommonState CommonState -> CommonState
f = m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState m CommonState -> (CommonState -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CommonState -> m ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState (CommonState -> m ())
-> (CommonState -> CommonState) -> CommonState -> m ()
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 <- (CommonState -> Bool) -> m Bool
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Bool
stTrace
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tracing (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m () -> m ()
forall a. [Char] -> a -> a
Debug.Trace.trace ([Char]
"[trace] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
setVerbosity :: PandocMonad m => Verbosity -> m ()
setVerbosity :: forall (m :: * -> *). PandocMonad m => Verbosity -> m ()
setVerbosity Verbosity
verbosity =
(CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stVerbosity = verbosity }
getVerbosity :: PandocMonad m => m Verbosity
getVerbosity :: forall (m :: * -> *). PandocMonad m => m Verbosity
getVerbosity = (CommonState -> Verbosity) -> m Verbosity
forall a. (CommonState -> a) -> m a
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 = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> m [LogMessage] -> m [LogMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CommonState -> [LogMessage]) -> m [LogMessage]
forall a. (CommonState -> a) -> m a
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 <- (CommonState -> Verbosity) -> m Verbosity
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Verbosity
stVerbosity
let level :: Verbosity
level = LogMessage -> Verbosity
messageVerbosity LogMessage
msg
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
level Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
<= Verbosity
verbosity) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
logOutput LogMessage
msg
(CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stLog = msg : stLog st }
setTrace :: PandocMonad m => Bool -> m ()
setTrace :: forall (m :: * -> *). PandocMonad m => Bool -> m ()
setTrace Bool
useTracing = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stTrace = useTracing}
setRequestHeader :: PandocMonad m
=> T.Text
-> T.Text
-> m ()
Text
name Text
val = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st ->
CommonState
st{ stRequestHeaders =
(name, val) : filter (\(Text
n,Text
_) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name) (stRequestHeaders st) }
setNoCheckCertificate :: PandocMonad m => Bool -> m ()
setNoCheckCertificate :: forall (m :: * -> *). PandocMonad m => Bool -> m ()
setNoCheckCertificate Bool
noCheckCertificate = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stNoCheckCertificate = noCheckCertificate}
setMediaBag :: PandocMonad m => MediaBag -> m ()
setMediaBag :: forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag MediaBag
mb = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stMediaBag = mb}
getMediaBag :: PandocMonad m => m MediaBag
getMediaBag :: forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag = (CommonState -> MediaBag) -> m MediaBag
forall a. (CommonState -> a) -> m a
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 <- m MediaBag
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
MediaBag -> m ()
forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag MediaBag
mb'
getInputFiles :: PandocMonad m => m [FilePath]
getInputFiles :: forall (m :: * -> *). PandocMonad m => m [[Char]]
getInputFiles = (CommonState -> [[Char]]) -> m [[Char]]
forall a. (CommonState -> a) -> m a
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
[] -> Maybe [Char]
forall a. Maybe a
Nothing
([Char]
x:[[Char]]
_) -> case [Char] -> Maybe URI
parseURI [Char]
x of
Just URI
u
| URI -> [Char]
uriScheme URI
u [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"http:",[Char]
"https:"] ->
[Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
u{ uriQuery = "",
uriFragment = "" }
Maybe URI
_ -> Maybe [Char]
forall a. Maybe a
Nothing
(CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stInputFiles = fs
, stSourceURL = T.pack <$> sourceURL }
getOutputFile :: PandocMonad m => m (Maybe FilePath)
getOutputFile :: forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getOutputFile = (CommonState -> Maybe [Char]) -> m (Maybe [Char])
forall a. (CommonState -> a) -> m a
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 = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stOutputFile = mbf }
getResourcePath :: PandocMonad m => m [FilePath]
getResourcePath :: forall (m :: * -> *). PandocMonad m => m [[Char]]
getResourcePath = (CommonState -> [[Char]]) -> m [[Char]]
forall a. (CommonState -> a) -> m a
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 = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stResourcePath = ps}
getTimestamp :: PandocMonad m => m UTCTime
getTimestamp :: forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp = do
Maybe Text
mbSourceDateEpoch <- Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv Text
"SOURCE_DATE_EPOCH"
case Maybe Text
mbSourceDateEpoch Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead of
Just (Integer
epoch :: Integer) ->
UTCTime -> m UTCTime
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> m UTCTime) -> UTCTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
epoch
Maybe Integer
Nothing -> m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
getPOSIXTime :: PandocMonad m => m POSIXTime
getPOSIXTime :: forall (m :: * -> *). PandocMonad m => m POSIXTime
getPOSIXTime = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime) -> m UTCTime -> m POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp
getZonedTime :: PandocMonad m => m ZonedTime
getZonedTime :: forall (m :: * -> *). PandocMonad m => m ZonedTime
getZonedTime = do
UTCTime
t <- m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp
TimeZone
tz <- m TimeZone
forall (m :: * -> *). PandocMonad m => m TimeZone
getCurrentTimeZone
ZonedTime -> m ZonedTime
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ZonedTime -> m ZonedTime) -> ZonedTime -> m ZonedTime
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]
_ = Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
readFileFromDirs ([Char]
d:[[Char]]
ds) [Char]
f = m (Maybe Text) -> (PandocError -> m (Maybe Text)) -> m (Maybe Text)
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
(Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> m Text -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f) m ByteString -> (ByteString -> m Text) -> m Text
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
[Char] -> ByteString -> m Text
toTextM ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f)))
(\PandocError
_ -> [[Char]] -> [Char] -> m (Maybe Text)
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 = Maybe Lang -> m (Maybe Lang)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing
toLang (Just Text
s) =
case Text -> Either [Char] Lang
parseLang Text
s of
Left [Char]
_ -> do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
InvalidLang Text
s
Maybe Lang -> m (Maybe Lang)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing
Right Lang
l -> Maybe Lang -> m (Maybe Lang)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
l)
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
_] -> Maybe URI
forall a. Maybe a
Nothing
[Char]
_ -> URI -> Maybe URI
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 = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stUserDataDir = mbfp }
getUserDataDir :: PandocMonad m
=> m (Maybe FilePath)
getUserDataDir :: forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir = (CommonState -> Maybe [Char]) -> m (Maybe [Char])
forall a. (CommonState -> a) -> m a
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 <- m 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 -> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
BL.toStrict (MediaItem -> ByteString
mediaContents MediaItem
item),
Text -> Maybe Text
forall a. a -> Maybe a
Just (MediaItem -> Text
mediaMimeType MediaItem
item))
Maybe MediaItem
Nothing -> Text -> m (ByteString, Maybe Text)
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 <- (CommonState -> Maybe Text) -> m (Maybe Text)
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe Text
stSourceURL
case (Maybe Text
sourceURL Maybe Text -> (Text -> Maybe URI) -> Maybe URI
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe URI
parseURIReference' (Text -> Maybe URI) -> (Text -> Text) -> Text -> Maybe URI
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' -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL (Text -> m (ByteString, Maybe Text))
-> Text -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
forall a. Show a => a -> [Char]
show (URI -> [Char]) -> URI -> [Char]
forall a b. (a -> b) -> a -> b
$ URI
u' URI -> URI -> URI
`nonStrictRelativeTo` URI
u
Maybe URI
Nothing -> Text -> m (ByteString, Maybe Text)
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?' ->
case Text -> Maybe URI
parseURIReference' Text
s' of
Just URI
u' -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL (Text -> m (ByteString, Maybe Text))
-> Text -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
forall a. Show a => a -> [Char]
show (URI -> [Char]) -> URI -> [Char]
forall a b. (a -> b) -> a -> b
$ URI
u' URI -> URI -> URI
`nonStrictRelativeTo` URI
httpcolon
Maybe URI
Nothing -> Text -> m (ByteString, Maybe Text)
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' [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"file:" ->
[Char] -> m (ByteString, Maybe Text)
forall {m :: * -> *}.
PandocMonad m =>
[Char] -> m (ByteString, Maybe Text)
readLocalFile ([Char] -> m (ByteString, Maybe Text))
-> [Char] -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
uriPathToPath ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
uriPath URI
u')
Just URI
u' | [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (URI -> [Char]
uriScheme URI
u') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
u')
Maybe URI
_ -> [Char] -> m (ByteString, Maybe Text)
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 <- m [[Char]]
forall (m :: * -> *). PandocMonad m => m [[Char]]
getResourcePath
([Char]
fp', ByteString
cont) <- if [Char] -> Bool
isRelative [Char]
f
then [[Char]]
-> ([Char] -> m ByteString) -> [Char] -> m ([Char], ByteString)
forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [[Char]]
resourcePath [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
f
else ([Char]
f,) (ByteString -> ([Char], ByteString))
-> m ByteString -> m ([Char], ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
f
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> LogMessage
LoadedResource [Char]
f ([Char] -> [Char] -> [Char]
makeRelative [Char]
"." [Char]
fp')
(ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall a. a -> m a
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 = Maybe URIAuth
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#')
fp :: [Char]
fp = [Char] -> [Char]
unEscapeString ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text
dropFragmentAndQuery Text
s
mime :: Maybe Text
mime = [Char] -> Maybe Text
getMimeType ([Char] -> Maybe Text) -> [Char] -> Maybe Text
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 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".svg"
[Char]
x -> [Char]
x
ensureEscaped :: Text -> Text
ensureEscaped = [Char] -> Text
T.pack ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
escapeURIString Char -> Bool
isAllowedInURI ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
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
isRelativeToParentDir :: FilePath -> Bool
isRelativeToParentDir :: [Char] -> Bool
isRelativeToParentDir [Char]
fname =
let canonical :: [Char]
canonical = [Char] -> [Char]
makeCanonical [Char]
fname
in [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
canonical Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
2 [Char]
canonical [Char] -> [Char] -> Bool
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 m (Maybe [Char])
forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
else Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
readMetadataFile :: PandocMonad m => FilePath -> m B.ByteString
readMetadataFile :: forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readMetadataFile [Char]
fname = [Char] -> [Char] -> m (Maybe [Char])
forall (m :: * -> *).
PandocMonad m =>
[Char] -> [Char] -> m (Maybe [Char])
findFileWithDataFallback [Char]
"metadata" [Char]
fname m (Maybe [Char]) -> (Maybe [Char] -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe [Char]
Nothing -> PandocError -> m ByteString
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m ByteString) -> PandocError -> m ByteString
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocCouldNotFindMetadataFileError ([Char] -> Text
T.pack [Char]
fname)
Just [Char]
metadataFile -> [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
metadataFile
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 = PandocError -> m ([Char], a)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m ([Char], a)) -> PandocError -> m ([Char], a)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
fp
withPaths ([Char]
p:[[Char]]
ps) [Char] -> m a
action [Char]
fp =
m ([Char], a) -> (PandocError -> m ([Char], a)) -> m ([Char], a)
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (([Char]
p [Char] -> [Char] -> [Char]
</> [Char]
fp,) (a -> ([Char], a)) -> m a -> m ([Char], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m a
action ([Char]
p [Char] -> [Char] -> [Char]
</> [Char]
fp))
(\PandocError
_ -> [[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [[Char]]
ps [Char] -> m a
action [Char]
fp)
toTextM :: PandocMonad m => FilePath -> B.ByteString -> m T.Text
toTextM :: forall (m :: * -> *).
PandocMonad m =>
[Char] -> ByteString -> m Text
toTextM [Char]
fp ByteString
bs =
case ByteString -> Either UnicodeException Text
TSE.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
filterCRs (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropBOM (ByteString -> Either UnicodeException Text)
-> ByteString -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs of
Left (TSE.DecodeError [Char]
_ (Just Word8
w)) ->
case Word8 -> ByteString -> Maybe Int
B.elemIndex Word8
w ByteString
bs of
Just Int
offset ->
PandocError -> m Text
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Text) -> PandocError -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Word8 -> PandocError
PandocUTF8DecodingError ([Char] -> Text
T.pack [Char]
fp) Int
offset Word8
w
Maybe Int
Nothing -> PandocError -> m Text
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Text) -> PandocError -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Word8 -> PandocError
PandocUTF8DecodingError ([Char] -> Text
T.pack [Char]
fp) Int
0 Word8
w
Left UnicodeException
e -> PandocError -> m Text
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Text) -> PandocError -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocAppError (UnicodeException -> Text
forall a. Show a => a -> Text
tshow UnicodeException
e)
Right Text
t -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
where
dropBOM :: ByteString -> ByteString
dropBOM ByteString
bs' =
if ByteString
"\xEF\xBB\xBF" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
bs'
then Int -> ByteString -> ByteString
B.drop Int
3 ByteString
bs'
else ByteString
bs'
filterCRs :: ByteString -> ByteString
filterCRs = (Word8 -> Bool) -> ByteString -> ByteString
B.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word8
13)
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 <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists [Char]
fp
if Bool
existsInWorkingDir
then Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> m (Maybe [Char]))
-> Maybe [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
fp
else do
Maybe [Char]
mbDataDir <- [Char] -> m (Maybe [Char])
forall (m :: * -> *). PandocMonad m => [Char] -> m (Maybe [Char])
checkUserDataDir [Char]
fp
case Maybe [Char]
mbDataDir of
Maybe [Char]
Nothing -> Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
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 <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists [Char]
datafp
Maybe [Char] -> m (Maybe [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> m (Maybe [Char]))
-> Maybe [Char] -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
existsInDataDir
then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
datafp
else Maybe [Char]
forall a. Maybe a
Nothing
fillMediaBag :: PandocMonad m => Pandoc -> m Pandoc
fillMediaBag :: forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
fillMediaBag Pandoc
d = (Inline -> m Inline) -> Pandoc -> m Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> Pandoc -> m Pandoc
walkM Inline -> m Inline
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)) = m Inline -> (PandocError -> m Inline) -> m Inline
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
(do MediaBag
mediabag <- m 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
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe MediaItem
Nothing -> do
(ByteString
bs, Maybe Text
mt) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
[Char] -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
[Char] -> Maybe Text -> ByteString -> m ()
insertMedia [Char]
fp Maybe Text
mt (ByteString -> ByteString
BL.fromStrict ByteString
bs)
Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
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
PandocIOError Text
text IOError
err -> do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
text (Text -> LogMessage) -> ([Char] -> Text) -> [Char] -> LogMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> LogMessage) -> [Char] -> LogMessage
forall a b. (a -> b) -> a -> b
$
(IOError -> [Char]
forall a. Show a => a -> [Char]
show IOError
err [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\nReplacing image with description.")
Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> [Inline] -> Inline
replacementSpan Attr
attr Text
src Text
tit [Inline]
lab
PandocResourceNotFound Text
_ -> do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
src
Text
"replacing image with description"
Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
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
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
u
([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ HttpException -> [Char]
forall a. Show a => a -> [Char]
show HttpException
er [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\rReplacing image with description.")
Inline -> m Inline
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> [Inline] -> Inline
replacementSpan Attr
attr Text
src Text
tit [Inline]
lab
PandocError
_ -> PandocError -> m Inline
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)
handleImage Inline
x = Inline -> m Inline
forall a. a -> m a
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"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
"placeholder"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
classes
, (Text
"original-image-src", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
(Text
"original-image-title", Text
title) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
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 = m (Maybe Text) -> t m (Maybe Text)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Text) -> t m (Maybe Text))
-> (Text -> m (Maybe Text)) -> Text -> t m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv
getCurrentTime :: t m UTCTime
getCurrentTime = m UTCTime -> t m UTCTime
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
getCurrentTimeZone :: t m TimeZone
getCurrentTimeZone = m TimeZone -> t m TimeZone
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m TimeZone
forall (m :: * -> *). PandocMonad m => m TimeZone
getCurrentTimeZone
newStdGen :: t m StdGen
newStdGen = m StdGen -> t m StdGen
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m StdGen
forall (m :: * -> *). PandocMonad m => m StdGen
newStdGen
newUniqueHash :: t m Int
newUniqueHash = m Int -> t m Int
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). PandocMonad m => m Int
newUniqueHash
openURL :: Text -> t m (ByteString, Maybe Text)
openURL = m (ByteString, Maybe Text) -> t m (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ByteString, Maybe Text) -> t m (ByteString, Maybe Text))
-> (Text -> m (ByteString, Maybe Text))
-> Text
-> t m (ByteString, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL
readFileLazy :: [Char] -> t m ByteString
readFileLazy = m ByteString -> t m ByteString
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString)
-> ([Char] -> m ByteString) -> [Char] -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy
readFileStrict :: [Char] -> t m ByteString
readFileStrict = m ByteString -> t m ByteString
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString)
-> ([Char] -> m ByteString) -> [Char] -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict
readStdinStrict :: t m ByteString
readStdinStrict = m ByteString -> t m ByteString
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). PandocMonad m => m ByteString
readStdinStrict
glob :: [Char] -> t m [[Char]]
glob = m [[Char]] -> t m [[Char]]
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [[Char]] -> t m [[Char]])
-> ([Char] -> m [[Char]]) -> [Char] -> t m [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [[Char]]
forall (m :: * -> *). PandocMonad m => [Char] -> m [[Char]]
glob
fileExists :: [Char] -> t m Bool
fileExists = m Bool -> t m Bool
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> t m Bool) -> ([Char] -> m Bool) -> [Char] -> t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists
getDataFileName :: [Char] -> t m [Char]
getDataFileName = m [Char] -> t m [Char]
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Char] -> t m [Char])
-> ([Char] -> m [Char]) -> [Char] -> t m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
getDataFileName
getModificationTime :: [Char] -> t m UTCTime
getModificationTime = m UTCTime -> t m UTCTime
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> t m UTCTime)
-> ([Char] -> m UTCTime) -> [Char] -> t m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m UTCTime
forall (m :: * -> *). PandocMonad m => [Char] -> m UTCTime
getModificationTime
getCommonState :: t m CommonState
getCommonState = m CommonState -> t m CommonState
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
putCommonState :: CommonState -> t m ()
putCommonState = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (CommonState -> m ()) -> CommonState -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> m ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState
logOutput :: LogMessage -> t m ()
logOutput = m () -> t m ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> t m ()) -> (LogMessage -> m ()) -> LogMessage -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage -> m ()
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 = m (Maybe Text) -> ParsecT s st m (Maybe Text)
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Text) -> ParsecT s st m (Maybe Text))
-> (Text -> m (Maybe Text)) -> Text -> ParsecT s st m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv
getCurrentTime :: ParsecT s st m UTCTime
getCurrentTime = m UTCTime -> ParsecT s st m UTCTime
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
getCurrentTimeZone :: ParsecT s st m TimeZone
getCurrentTimeZone = m TimeZone -> ParsecT s st m TimeZone
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m TimeZone
forall (m :: * -> *). PandocMonad m => m TimeZone
getCurrentTimeZone
newStdGen :: ParsecT s st m StdGen
newStdGen = m StdGen -> ParsecT s st m StdGen
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m StdGen
forall (m :: * -> *). PandocMonad m => m StdGen
newStdGen
newUniqueHash :: ParsecT s st m Int
newUniqueHash = m Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). PandocMonad m => m Int
newUniqueHash
openURL :: Text -> ParsecT s st m (ByteString, Maybe Text)
openURL = m (ByteString, Maybe Text)
-> ParsecT s st m (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ByteString, Maybe Text)
-> ParsecT s st m (ByteString, Maybe Text))
-> (Text -> m (ByteString, Maybe Text))
-> Text
-> ParsecT s st m (ByteString, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL
readFileLazy :: [Char] -> ParsecT s st m ByteString
readFileLazy = m ByteString -> ParsecT s st m ByteString
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ParsecT s st m ByteString)
-> ([Char] -> m ByteString) -> [Char] -> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy
readFileStrict :: [Char] -> ParsecT s st m ByteString
readFileStrict = m ByteString -> ParsecT s st m ByteString
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ParsecT s st m ByteString)
-> ([Char] -> m ByteString) -> [Char] -> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict
readStdinStrict :: ParsecT s st m ByteString
readStdinStrict = m ByteString -> ParsecT s st m ByteString
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). PandocMonad m => m ByteString
readStdinStrict
glob :: [Char] -> ParsecT s st m [[Char]]
glob = m [[Char]] -> ParsecT s st m [[Char]]
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [[Char]] -> ParsecT s st m [[Char]])
-> ([Char] -> m [[Char]]) -> [Char] -> ParsecT s st m [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [[Char]]
forall (m :: * -> *). PandocMonad m => [Char] -> m [[Char]]
glob
fileExists :: [Char] -> ParsecT s st m Bool
fileExists = m Bool -> ParsecT s st m Bool
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ParsecT s st m Bool)
-> ([Char] -> m Bool) -> [Char] -> ParsecT s st m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists
getDataFileName :: [Char] -> ParsecT s st m [Char]
getDataFileName = m [Char] -> ParsecT s st m [Char]
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Char] -> ParsecT s st m [Char])
-> ([Char] -> m [Char]) -> [Char] -> ParsecT s st m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
getDataFileName
getModificationTime :: [Char] -> ParsecT s st m UTCTime
getModificationTime = m UTCTime -> ParsecT s st m UTCTime
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> ParsecT s st m UTCTime)
-> ([Char] -> m UTCTime) -> [Char] -> ParsecT s st m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m UTCTime
forall (m :: * -> *). PandocMonad m => [Char] -> m UTCTime
getModificationTime
getCommonState :: ParsecT s st m CommonState
getCommonState = m CommonState -> ParsecT s st m CommonState
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
putCommonState :: CommonState -> ParsecT s st m ()
putCommonState = m () -> ParsecT s st m ()
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ParsecT s st m ())
-> (CommonState -> m ()) -> CommonState -> ParsecT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommonState -> m ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState
trace :: Text -> ParsecT s st m ()
trace Text
msg = do
Bool
tracing <- (CommonState -> Bool) -> ParsecT s st m Bool
forall a. (CommonState -> a) -> ParsecT s st m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Bool
stTrace
Bool -> ParsecT s st m () -> ParsecT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
tracing (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$ do
SourcePos
pos <- ParsecT s st m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[Char] -> ParsecT s st m () -> ParsecT s st m ()
forall a. [Char] -> a -> a
Debug.Trace.trace
([Char]
"[trace] Parsed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" at line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
Int -> [Char]
forall a. Show a => a -> [Char]
show (SourcePos -> Int
sourceLine SourcePos
pos) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
if SourcePos -> [Char]
sourceName SourcePos
pos [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"chunk"
then [Char]
" of chunk"
else [Char]
"")
(() -> ParsecT s st m ()
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
logOutput :: LogMessage -> ParsecT s st m ()
logOutput = m () -> ParsecT s st m ()
forall (m :: * -> *) a. Monad m => m a -> ParsecT s st m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ParsecT s st m ())
-> (LogMessage -> m ()) -> LogMessage -> ParsecT s st m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
logOutput