{-# 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
Copyright   : Copyright (C) 2016-2020 Jesse Rosenthal, John MacFarlane
License     : GNU GPL, version 2 or above

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

This module defines a type class, 'PandocMonad', for pandoc readers
and writers.
-}

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
  , 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)
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 Text.Pandoc.UTF8 as UTF8

-- | The PandocMonad typeclass contains all the potentially
-- IO-related functions used in pandoc's readers and writers.
-- Instances of this typeclass may implement these functions
-- in IO (as in 'PandocIO') or using an internal state that
-- represents a file system, time, and so on (as in 'PandocPure').
class (Functor m, Applicative m, Monad m, MonadError PandocError m)
      => PandocMonad m where
  -- | Lookup an environment variable.
  lookupEnv :: T.Text -> m (Maybe T.Text)
  -- | Get the current (UTC) time.
  getCurrentTime :: m UTCTime
  -- | Get the locale's time zone.
  getCurrentTimeZone :: m TimeZone
  -- | Return a new generator for random numbers.
  newStdGen :: m StdGen
  -- | Return a new unique integer.
  newUniqueHash :: m Int
  -- | Retrieve contents and mime type from a URL, raising
  -- an error on failure.
  openURL :: T.Text -> m (B.ByteString, Maybe MimeType)
  -- | Read the lazy ByteString contents from a file path,
  -- raising an error on failure.
  readFileLazy :: FilePath -> m BL.ByteString
  -- | Read the strict ByteString contents from a file path,
  -- raising an error on failure.
  readFileStrict :: FilePath -> m B.ByteString
  -- | Read the contents of stdin as a strict ByteString, raising
  -- an error on failure.
  readStdinStrict :: m B.ByteString
  -- | Return a list of paths that match a glob, relative to
  -- the working directory.  See 'System.FilePath.Glob' for
  -- the glob syntax.
  glob :: String -> m [FilePath]
  -- | Returns True if file exists.
  fileExists :: FilePath -> m Bool
  -- | Returns the path of data file.
  getDataFileName :: FilePath -> m FilePath
  -- | Return the modification time of a file.
  getModificationTime :: FilePath -> m UTCTime
  -- | Get the value of the 'CommonState' used by all instances
  -- of 'PandocMonad'.
  getCommonState :: m CommonState
  -- | Set the value of the 'CommonState' used by all instances
  -- of 'PandocMonad'.
  -- | Get the value of a specific field of 'CommonState'.
  putCommonState :: CommonState -> m ()
  -- | Get the value of a specific field of 'CommonState'.
  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
  -- | Modify the 'CommonState'.
  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
  -- | Output a log message.
  logOutput :: LogMessage -> m ()
  -- | Output a debug message to sterr, using 'Debug.Trace.trace',
  -- if tracing is enabled.  Note: this writes to stderr even in
  -- pure instances.
  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 ())

-- * Functions defined for all PandocMonad instances

-- | Set the verbosity level.
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
stVerbosity = Verbosity
verbosity }

-- | Get the verbosity level.
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

-- | Get the accumulated log messages (in temporal order).
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

-- | Log a message using 'logOutput'.  Note that 'logOutput' is
-- called only if the verbosity level exceeds the level of the
-- message, but the message is added to the list of log messages
-- that will be retrieved by 'getLog' regardless of its verbosity level.
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 :: [LogMessage]
stLog = LogMessage
msg LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: CommonState -> [LogMessage]
stLog CommonState
st }

-- | Determine whether tracing is enabled.  This affects
-- the behavior of 'trace'.  If tracing is not enabled,
-- 'trace' does nothing.
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 :: Bool
stTrace = Bool
useTracing}

-- | Set request header to use in HTTP requests.
setRequestHeader :: PandocMonad m
                 => T.Text  -- ^ Header name
                 -> T.Text  -- ^ Value
                 -> m ()
setRequestHeader :: forall (m :: * -> *). PandocMonad m => Text -> Text -> m ()
setRequestHeader 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 :: [(Text, Text)]
stRequestHeaders =
       (Text
name, Text
val) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
n,Text
_) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name) (CommonState -> [(Text, Text)]
stRequestHeaders CommonState
st)  }

-- | Determine whether certificate validation is disabled
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 :: Bool
stNoCheckCertificate = Bool
noCheckCertificate}

-- | Initialize the media bag.
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 :: MediaBag
stMediaBag = MediaBag
mb}

-- | Retrieve the media bag.
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

-- | Insert an item into the media bag.
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'

-- | Retrieve the input filenames.
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

-- | Set the input filenames.
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 :: [Char]
uriQuery = [Char]
"",
                                                     uriFragment :: [Char]
uriFragment = [Char]
"" }
                                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 :: [[Char]]
stInputFiles = [[Char]]
fs
                               , stSourceURL :: Maybe Text
stSourceURL = [Char] -> Text
T.pack ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
sourceURL }

-- | Retrieve the output filename.
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

-- | Set the output filename.
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 :: Maybe [Char]
stOutputFile = Maybe [Char]
mbf }

-- | Retrieve the resource path searched by 'fetchItem'.
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

-- | Set the resource path searched by 'fetchItem'.
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 :: [[Char]]
stResourcePath = [[Char]]
ps}

-- | Get the current UTC time. If the @SOURCE_DATE_EPOCH@ environment
-- variable is set to a unix time (number of seconds since midnight
-- Jan 01 1970 UTC), it is used instead of the current time, to support
-- reproducible builds.
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

-- | Get the POSIX time. If @SOURCE_DATE_EPOCH@ is set to a unix time,
-- it is used instead of the current time.
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

-- | Get the zoned time. If @SOURCE_DATE_EPOCH@ is set to a unix time,
-- value (POSIX time), it is used instead of the current time.
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

-- | Read file, checking in any number of directories.
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)
-> (ByteString -> Text) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (ByteString -> [Char]) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
UTF8.toStringLazy (ByteString -> Maybe Text) -> m ByteString -> 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
readFileLazy ([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)

-- | Convert BCP47 string to a Lang, issuing warning
-- if there are problems.
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)

-- | Specialized version of parseURIReference that disallows
-- single-letter schemes.  Reason:  these are usually windows absolute
-- paths.
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

-- | Set the user data directory in common state.
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 :: Maybe [Char]
stUserDataDir = Maybe [Char]
mbfp }

-- | Get the user data directory from common state.
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

-- | Fetch an image or other item from the local filesystem or the net.
-- Returns raw content and maybe mime type.
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

-- | Returns the content and, if available, the MIME type of a resource.
-- If the given resource location is a valid URI, then download the
-- resource from that URI. Otherwise, treat the resource identifier as a
-- local file name.
--
-- Note that resources are treated relative to the URL of the first
-- input source, if any.
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') -> -- try fetching from relative path at source
       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' -- will throw error
    (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
'?' ->  -- protocol-relative URI
                -- we exclude //? because of //?UNC/ on Windows
       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' -- will throw error
    (Maybe URI
Nothing, Text
s') ->
       case [Char] -> Maybe URI
parseURI (Text -> [Char]
T.unpack Text
s') of  -- requires absolute URI
            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')
            -- We don't want to treat C:/ as a scheme:
            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 -- get from local file system
   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

-- | Checks if the file path is relative to a parent directory.
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]
".."

-- | Returns possible user data directory if the file path refers to a file or
-- subdirectory within it.
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

-- | Read metadata file from the working directory or, if not found there, from
-- the metadata subdirectory of the user data directory.
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

-- | Tries to run an action on a file: for each directory given, a
-- filepath is created from the given filename, and the action is run on
-- that filepath. Returns the result of the first successful execution
-- of the action, or throws a @PandocResourceNotFound@ exception if the
-- action errors for all filepaths.
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)

-- | Returns @fp@ if the file exists in the current directory; otherwise
-- searches for the data file relative to @/subdir/@. Returns @Nothing@
-- if neither file exists.
findFileWithDataFallback :: PandocMonad m
                         => FilePath  -- ^ subdir
                         -> FilePath  -- ^ fp
                         -> m (Maybe FilePath)
findFileWithDataFallback :: forall (m :: * -> *).
PandocMonad m =>
[Char] -> [Char] -> m (Maybe [Char])
findFileWithDataFallback [Char]
subdir [Char]
fp = do
  -- First we check to see if the file is found. If not, and if it's not
  -- an absolute path, we check to see whether it's in @userdir/@. If
  -- not, we leave it unchanged.
  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

-- | Traverse tree, filling media bag for any images that
-- aren't already in the media bag.
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
                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"
                  -- emit alt text
                  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.")
                  -- emit alt text
                  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

-- This requires UndecidableInstances.  We could avoid that
-- by repeating the definitions below for every monad transformer
-- we use: ReaderT, WriterT, StateT, RWST.  But this seems to
-- be harmless.
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