{-# LANGUAGE BangPatterns #-}
{-# 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
  , runSilently
  , setRequestHeader
  , setNoCheckCertificate
  , getLog
  , setVerbosity
  , getVerbosity
  , setTrace
  , getTrace
  , getMediaBag
  , setMediaBag
  , insertMedia
  , setUserDataDir
  , getUserDataDir
  , fetchItem
  , extractURIData
  , getInputFiles
  , setInputFiles
  , getOutputFile
  , setOutputFile
  , setResourcePath
  , getResourcePath
  , setRequestHeaders
  , getRequestHeaders
  , getSourceURL
  , 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.Char (chr, digitToInt, isHexDigit, toLower)
import Data.List (intercalate)
import Data.Word (Word8)
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, splitDirectories)
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, pBase64DataURI)
import qualified Data.Attoparsec.Text as A
import Text.Pandoc.Walk (walkM)
import Data.ByteString.Base64 (decodeLenient)
import Text.Parsec (ParsecT, getPosition, sourceLine, sourceName)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
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

-- | 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'.
  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
    tracing <- (CommonState -> Bool) -> m Bool
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Bool
stTrace
    when tracing $ Debug.Trace.trace ("[trace] " ++ T.unpack msg) (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 }

-- | 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

-- | Set tracing. 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
enabled = (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 = enabled }

-- | Get tracing status.
getTrace :: PandocMonad m => m Bool
getTrace :: forall (m :: * -> *). PandocMonad m => m Bool
getTrace = (CommonState -> Bool) -> m Bool
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Bool
stTrace

-- | 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 <- (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 = LogMessage -> Verbosity
messageVerbosity LogMessage
msg
  when (level <= verbosity) $ logOutput msg
  modifyCommonState $ \CommonState
st -> CommonState
st{ stLog = msg : stLog st }

-- | Run an action, but suppress the output of any log messages;
-- instead, all messages reported by @action@ are returned separately
-- and not added to the main log.
runSilently :: PandocMonad m => m a -> m (a, [LogMessage])
runSilently :: forall (m :: * -> *) a. PandocMonad m => m a -> m (a, [LogMessage])
runSilently m a
action = do
  -- get current settings
  origLog <- (CommonState -> [LogMessage]) -> m [LogMessage]
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [LogMessage]
stLog
  origVerbosity <- getVerbosity
  let restore = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState
        (\CommonState
st -> CommonState
st { stVerbosity = origVerbosity, stLog = origLog })
  -- reset log level and set verbosity to the minimum
  modifyCommonState (\CommonState
st -> CommonState
st { stVerbosity = ERROR, stLog = []})
  -- restore the original log and verbosity even if the action fails
  result <- action `catchError` (\PandocError
e -> m ()
restore m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PandocError -> m a
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)
  -- get log messages reported while running `action`
  newLog <- getsCommonState stLog
  restore
  return (result, newLog)

-- | 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 =
       (name, val) : filter (\(Text
n,Text
_) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name) (stRequestHeaders 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 = noCheckCertificate
#ifdef PANDOC_HTTP_SUPPORT
    -- discard any cached HTTP manager, since it was created with
    -- TLS settings based on the previous value of this option
    , stManager = if stNoCheckCertificate st == noCheckCertificate
                     then stManager st
                     else Nothing
#endif
    }

-- | 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 = 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 =>
FilePath -> Maybe Text -> ByteString -> m ()
insertMedia FilePath
fp Maybe Text
mime ByteString
bs = do
  mb <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  let mb' = FilePath -> Maybe Text -> ByteString -> MediaBag -> MediaBag
MB.insertMedia FilePath
fp Maybe Text
mime ByteString
bs MediaBag
mb
  setMediaBag mb'

-- | Retrieve the input filenames.
getInputFiles :: PandocMonad m => m [FilePath]
getInputFiles :: forall (m :: * -> *). PandocMonad m => m [FilePath]
getInputFiles = (CommonState -> [FilePath]) -> m [FilePath]
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [FilePath]
stInputFiles

-- | Set the input filenames.
setInputFiles :: PandocMonad m => [FilePath] -> m ()
setInputFiles :: forall (m :: * -> *). PandocMonad m => [FilePath] -> m ()
setInputFiles [FilePath]
fs = do
  let sourceURL :: Maybe FilePath
sourceURL = case [FilePath]
fs of
                    []    -> Maybe FilePath
forall a. Maybe a
Nothing
                    (FilePath
x:[FilePath]
_) -> case FilePath -> Maybe URI
parseURI FilePath
x of
                                Just URI
u
                                  | URI -> FilePath
uriScheme URI
u FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"http:",FilePath
"https:"] ->
                                      FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ URI -> FilePath
forall a. Show a => a -> FilePath
show URI
u{ uriQuery = "",
                                                     uriFragment = "" }
                                Maybe URI
_ -> Maybe FilePath
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 }

-- | Retrieve the output filename.
getOutputFile :: PandocMonad m => m (Maybe FilePath)
getOutputFile :: forall (m :: * -> *). PandocMonad m => m (Maybe FilePath)
getOutputFile = (CommonState -> Maybe FilePath) -> m (Maybe FilePath)
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe FilePath
stOutputFile

-- | Set the output filename.
setOutputFile :: PandocMonad m => Maybe FilePath -> m ()
setOutputFile :: forall (m :: * -> *). PandocMonad m => Maybe FilePath -> m ()
setOutputFile Maybe FilePath
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 }

-- | Retrieve the resource path searched by 'fetchItem'.
getResourcePath :: PandocMonad m => m [FilePath]
getResourcePath :: forall (m :: * -> *). PandocMonad m => m [FilePath]
getResourcePath = (CommonState -> [FilePath]) -> m [FilePath]
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [FilePath]
stResourcePath

-- | Set the resource path searched by 'fetchItem'.
setResourcePath :: PandocMonad m => [FilePath] -> m ()
setResourcePath :: forall (m :: * -> *). PandocMonad m => [FilePath] -> m ()
setResourcePath [FilePath]
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}

-- | Retrieve the request headers to add for HTTP requests.
getRequestHeaders :: PandocMonad m => m [(T.Text, T.Text)]
getRequestHeaders :: forall (m :: * -> *). PandocMonad m => m [(Text, Text)]
getRequestHeaders = (CommonState -> [(Text, Text)]) -> m [(Text, Text)]
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [(Text, Text)]
stRequestHeaders

-- | Set the request headers to add for HTTP requests.
setRequestHeaders :: PandocMonad m => [(T.Text, T.Text)] -> m ()
setRequestHeaders :: forall (m :: * -> *). PandocMonad m => [(Text, Text)] -> m ()
setRequestHeaders [(Text, Text)]
hs = (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 = hs }

-- | Get the absolute URL or directory of first source file.
getSourceURL :: PandocMonad m => m (Maybe T.Text)
getSourceURL :: forall (m :: * -> *). PandocMonad m => m (Maybe Text)
getSourceURL = (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

-- | 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
  mbSourceDateEpoch <- Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv Text
"SOURCE_DATE_EPOCH"
  case mbSourceDateEpoch >>= 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
  t <- m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp
  tz <- getCurrentTimeZone
  return $ utcToZonedTime tz t

-- | Read file, checking in any number of directories.
readFileFromDirs :: PandocMonad m => [FilePath] -> FilePath -> m (Maybe T.Text)
readFileFromDirs :: forall (m :: * -> *).
PandocMonad m =>
[FilePath] -> FilePath -> m (Maybe Text)
readFileFromDirs [] FilePath
_ = 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 (FilePath
d:[FilePath]
ds) FilePath
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
<$> (FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileStrict (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
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
>>= FilePath -> ByteString -> m Text
forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f)))
    (\PandocError
_ -> [FilePath] -> FilePath -> m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[FilePath] -> FilePath -> m (Maybe Text)
readFileFromDirs [FilePath]
ds FilePath
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 FilePath Lang
parseLang Text
s of
       Left FilePath
_ -> 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
  u <- FilePath -> Maybe URI
parseURIReference (Text -> FilePath
T.unpack Text
s)
  case uriScheme u of
       [Char
_] -> Maybe URI
forall a. Maybe a
Nothing
       FilePath
_   -> 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 FilePath -> m ()
setUserDataDir Maybe FilePath
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 }

-- | Get the user data directory from common state.
getUserDataDir :: PandocMonad m
               => m (Maybe FilePath)
getUserDataDir :: forall (m :: * -> *). PandocMonad m => m (Maybe FilePath)
getUserDataDir = (CommonState -> Maybe FilePath) -> m (Maybe FilePath)
forall a. (CommonState -> a) -> m a
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe FilePath
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 <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  case lookupMedia (T.unpack s) 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
 | Text -> Text
T.toLower (Int -> Text -> Text
T.take Int
5 Text
s) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"data:",
   Right (ByteString
bs, Text
mt) <- Parser (ByteString, Text)
-> Text -> Either FilePath (ByteString, Text)
forall a. Parser a -> Text -> Either FilePath a
A.parseOnly (Parser (ByteString, Text)
pBase64DataURI Parser (ByteString, Text)
-> Parser Text () -> Parser (ByteString, Text)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput) Text
s
   = (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
bs, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mt)
 | Bool
otherwise = do
  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 (sourceURL >>= parseURIReference' . ensureEscaped, ensureEscaped 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
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ URI -> FilePath
forall a. Show a => a -> FilePath
show (URI -> FilePath) -> URI -> FilePath
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 -> FilePath
T.unpack -> (Char
'/':Char
'/':Char
c:FilePath
_))) | 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
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ URI -> FilePath
forall a. Show a => a -> FilePath
show (URI -> FilePath) -> URI -> FilePath
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 FilePath -> Maybe URI
parseURI (Text -> FilePath
T.unpack Text
s') of  -- requires absolute URI
            Just URI{ uriScheme :: URI -> FilePath
uriScheme = FilePath
sch, uriPath :: URI -> FilePath
uriPath = FilePath
upath}
              | (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
sch FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"file:"
              -> FilePath -> m (ByteString, Maybe Text)
forall {m :: * -> *}.
PandocMonad m =>
FilePath -> m (ByteString, Maybe Text)
readLocalFile (FilePath -> m (ByteString, Maybe Text))
-> FilePath -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
uriPathToPath (FilePath -> Text
T.pack FilePath
upath)
              | (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
sch FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"data:"
              -> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString, Maybe Text) -> m (ByteString, Maybe Text))
-> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> (ByteString, Maybe Text)
extractURIData FilePath
upath
            -- We don't want to treat C:/ as a scheme:
            Just URI
u' | FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (URI -> FilePath
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 (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ URI -> FilePath
forall a. Show a => a -> FilePath
show URI
u')
            Maybe URI
_ -> FilePath -> m (ByteString, Maybe Text)
forall {m :: * -> *}.
PandocMonad m =>
FilePath -> m (ByteString, Maybe Text)
readLocalFile FilePath
fp -- get from local file system
   where readLocalFile :: FilePath -> m (ByteString, Maybe Text)
readLocalFile FilePath
f = do
             resourcePath <- m [FilePath]
forall (m :: * -> *). PandocMonad m => m [FilePath]
getResourcePath
             (fp', cont) <- if isRelative f
                               then withPaths resourcePath readFileStrict f
                               else (f,) <$> readFileStrict f
             report $ LoadedResource f (makeRelative "." fp')
             return (cont, mime)
         httpcolon :: URI
httpcolon = URI{ uriScheme :: FilePath
uriScheme = FilePath
"http:",
                          uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing,
                          uriPath :: FilePath
uriPath = FilePath
"",
                          uriQuery :: FilePath
uriQuery = FilePath
"",
                          uriFragment :: FilePath
uriFragment = FilePath
"" }
         fp :: FilePath
fp = FilePath -> FilePath
unEscapeString (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
s
         mime :: Maybe Text
mime = FilePath -> Maybe Text
getMimeType (FilePath -> Maybe Text) -> FilePath -> Maybe Text
forall a b. (a -> b) -> a -> b
$ case FilePath -> FilePath
takeExtension FilePath
fp of
                     FilePath
".gz" -> FilePath -> FilePath
dropExtension FilePath
fp
                     FilePath
".svgz" -> FilePath -> FilePath
dropExtension FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".svg"
                     FilePath
x     -> FilePath
x
         ensureEscaped :: Text -> Text
ensureEscaped = FilePath -> Text
T.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
escapeURIString Char -> Bool
isAllowedInURI (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
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

-- Extract data from a data URI's path component.
extractURIData :: String -> (B.ByteString, Maybe MimeType)
extractURIData :: FilePath -> (ByteString, Maybe Text)
extractURIData FilePath
upath =
  if Bool
isBase64
     then (ByteString -> ByteString
decodeLenient ByteString
contents, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mime)
     else (ByteString
contents, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mime)
  where
    (FilePath
mimespec, FilePath
rest) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') FilePath
upath
    -- The base64 indicator is the final parameter of the media type
    -- and may follow other parameters, e.g.
    -- data:text/plain;charset=utf-8;base64,...
    metaParts :: [FilePath]
metaParts = FilePath -> [FilePath]
splitParts ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (FilePath -> FilePath
unEscapeString FilePath
mimespec))
    splitParts :: FilePath -> [FilePath]
splitParts FilePath
s = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';') FilePath
s of
                     (FilePath
x, [])    -> [FilePath
x]
                     (FilePath
x, Char
_:FilePath
s')  -> FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
splitParts FilePath
s'
    isBase64 :: Bool
isBase64 = [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
metaParts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
last [FilePath]
metaParts FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"base64"
    mime :: Text
mime = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
";" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
             if Bool
isBase64 then [FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
init [FilePath]
metaParts else [FilePath]
metaParts
    -- Percent-escapes in a data URI represent raw octets (RFC 2397),
    -- so we decode them to bytes directly.  (unEscapeString cannot be
    -- used here: it UTF-8-decodes consecutive escapes, which corrupts
    -- binary data when the result is re-encoded.)
    contents :: ByteString
contents = FilePath -> ByteString
unEscapeBytes (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
rest
    unEscapeBytes :: FilePath -> ByteString
unEscapeBytes = FilePath -> ByteString
B8.pack (FilePath -> ByteString)
-> (FilePath -> FilePath) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
go
      where
        go :: FilePath -> FilePath
go (Char
'%':Char
x:Char
y:FilePath
cs)
          | Char -> Bool
isHexDigit Char
x, Char -> Bool
isHexDigit Char
y
            = Int -> Char
chr (Char -> Int
digitToInt Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
y) Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
go FilePath
cs
        go (Char
c:FilePath
cs) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
go FilePath
cs
        go [] = []

-- | Checks if the file path is relative to a parent directory.
isRelativeToParentDir :: FilePath -> Bool
isRelativeToParentDir :: FilePath -> Bool
isRelativeToParentDir FilePath
fname =
  case FilePath -> [FilePath]
splitDirectories (FilePath -> FilePath
makeCanonical FilePath
fname) of
    FilePath
"..":[FilePath]
_ -> Bool
True
    [FilePath]
_      -> Bool
False

-- | 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 =>
FilePath -> m (Maybe FilePath)
checkUserDataDir FilePath
fname =
  if FilePath -> Bool
isRelative FilePath
fname Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
isRelativeToParentDir FilePath
fname)
     then m (Maybe FilePath)
forall (m :: * -> *). PandocMonad m => m (Maybe FilePath)
getUserDataDir
     else Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
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 => FilePath -> m ByteString
readMetadataFile FilePath
fname = FilePath -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
PandocMonad m =>
FilePath -> FilePath -> m (Maybe FilePath)
findFileWithDataFallback FilePath
"metadata" FilePath
fname m (Maybe FilePath)
-> (Maybe FilePath -> 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 FilePath
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 (FilePath -> Text
T.pack FilePath
fname)
  Just FilePath
metadataFile -> FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileStrict FilePath
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 =>
[FilePath] -> (FilePath -> m a) -> FilePath -> m (FilePath, a)
withPaths [] FilePath -> m a
_ FilePath
fp = PandocError -> m (FilePath, a)
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (FilePath, a)) -> PandocError -> m (FilePath, a)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
fp
withPaths (FilePath
p:[FilePath]
ps) FilePath -> m a
action FilePath
fp =
  m (FilePath, a)
-> (PandocError -> m (FilePath, a)) -> m (FilePath, 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 ((FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
fp,) (a -> (FilePath, a)) -> m a -> m (FilePath, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m a
action (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
fp))
             (\PandocError
_ -> [FilePath] -> (FilePath -> m a) -> FilePath -> m (FilePath, a)
forall (m :: * -> *) a.
PandocMonad m =>
[FilePath] -> (FilePath -> m a) -> FilePath -> m (FilePath, a)
withPaths [FilePath]
ps FilePath -> m a
action FilePath
fp)

-- | A variant of Text.Pandoc.UTF8.toText that takes a FilePath
-- as well as the file's contents as parameter, and traps UTF8
-- decoding errors so it can issue a more informative PandocUTF8DecodingError
-- with source position.
toTextM :: PandocMonad m => FilePath -> B.ByteString -> m T.Text
toTextM :: forall (m :: * -> *).
PandocMonad m =>
FilePath -> ByteString -> m Text
toTextM FilePath
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 FilePath
_ (Just Word8
w)) ->
      case ByteString -> Maybe (Int, Word8)
findDecodingError ByteString
bs of
        Just (Int
offset, Word8
w') ->
          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 (FilePath -> Text
T.pack FilePath
fp) Int
offset Word8
w'
        Maybe (Int, Word8)
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 (FilePath -> Text
T.pack FilePath
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'
   -- Only allocate a filtered copy if a CR is actually present;
   -- B.elem compiles to a fast memchr.
   filterCRs :: ByteString -> ByteString
filterCRs ByteString
bs' = if Word8
13 Word8 -> ByteString -> Bool
`B.elem` ByteString
bs'
                      then (Word8 -> Bool) -> ByteString -> ByteString
B.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word8
13) ByteString
bs'
                      else ByteString
bs'

-- Find the offset and value of the first byte at which UTF-8 decoding
-- fails (RFC 3629).  Used to give an accurate position in decoding
-- error messages.  (The BOM and CR bytes stripped before decoding are
-- themselves valid UTF-8, so scanning the unstripped input finds the
-- same error, at its offset in the original file.)
findDecodingError :: B.ByteString -> Maybe (Int, Word8)
findDecodingError :: ByteString -> Maybe (Int, Word8)
findDecodingError = Int -> ByteString -> Maybe (Int, Word8)
forall {t}. Num t => t -> ByteString -> Maybe (t, Word8)
go Int
0
 where
  go :: t -> ByteString -> Maybe (t, Word8)
go !t
i ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs of
    Maybe (Word8, ByteString)
Nothing -> Maybe (t, Word8)
forall a. Maybe a
Nothing
    Just (Word8
w, ByteString
rest)
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80  -> t -> ByteString -> Maybe (t, Word8)
go (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) ByteString
rest
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0xC2  -> (t, Word8) -> Maybe (t, Word8)
forall a. a -> Maybe a
Just (t
i, Word8
w)  -- continuation byte or overlong lead
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xE0 -> t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w ByteString
rest [(Word8
0xA0,Word8
0xBF),(Word8
0x80,Word8
0xBF)]
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xED -> t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w ByteString
rest [(Word8
0x80,Word8
0x9F),(Word8
0x80,Word8
0xBF)]  -- no surrogates
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0xE0  -> t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w ByteString
rest [(Word8
0x80,Word8
0xBF)]
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<  Word8
0xF0 -> t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w ByteString
rest [(Word8
0x80,Word8
0xBF),(Word8
0x80,Word8
0xBF)]
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xF0 -> t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w ByteString
rest [(Word8
0x90,Word8
0xBF),(Word8
0x80,Word8
0xBF),(Word8
0x80,Word8
0xBF)]
      | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xF4 -> t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w ByteString
rest [(Word8
0x80,Word8
0x8F),(Word8
0x80,Word8
0xBF),(Word8
0x80,Word8
0xBF)]
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<  Word8
0xF4 -> t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w ByteString
rest [(Word8
0x80,Word8
0xBF),(Word8
0x80,Word8
0xBF),(Word8
0x80,Word8
0xBF)]
      | Bool
otherwise -> (t, Word8) -> Maybe (t, Word8)
forall a. a -> Maybe a
Just (t
i, Word8
w)  -- above U+10FFFF
  -- check that the bytes following the lead byte w at offset i fall
  -- into the given ranges; report the first byte that does not
  cont :: t -> Word8 -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
cont t
i Word8
w = t -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
go' (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
   where
    go' :: t -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
go' !t
j ByteString
rest [] = t -> ByteString -> Maybe (t, Word8)
go t
j ByteString
rest
    go' !t
j ByteString
rest ((Word8
lo,Word8
hi):[(Word8, Word8)]
ranges) =
      case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
rest of
        Just (Word8
b, ByteString
rest')
          | Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
lo Bool -> Bool -> Bool
&& Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
hi -> t -> ByteString -> [(Word8, Word8)] -> Maybe (t, Word8)
go' (t
j t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) ByteString
rest' [(Word8, Word8)]
ranges
          | Bool
otherwise          -> (t, Word8) -> Maybe (t, Word8)
forall a. a -> Maybe a
Just (t
j, Word8
b)
        -- input ends in the middle of a sequence: report the lead byte
        Maybe (Word8, ByteString)
Nothing -> (t, Word8) -> Maybe (t, Word8)
forall a. a -> Maybe a
Just (t
i, Word8
w)

-- | 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 =>
FilePath -> FilePath -> m (Maybe FilePath)
findFileWithDataFallback FilePath
subdir FilePath
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.
  existsInWorkingDir <- FilePath -> m Bool
forall (m :: * -> *). PandocMonad m => FilePath -> m Bool
fileExists FilePath
fp
  if existsInWorkingDir
     then return $ Just fp
     else do
       mbDataDir <- checkUserDataDir fp
       case mbDataDir of
         Maybe FilePath
Nothing -> Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
         Just FilePath
datadir -> do
           let datafp :: FilePath
datafp = FilePath
datadir FilePath -> FilePath -> FilePath
</> FilePath
subdir FilePath -> FilePath -> FilePath
</> FilePath
fp
           existsInDataDir <- FilePath -> m Bool
forall (m :: * -> *). PandocMonad m => FilePath -> m Bool
fileExists FilePath
datafp
           return $ if existsInDataDir
                    then Just datafp
                    else 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 <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
              let fp = Text -> FilePath
T.unpack Text
src
              case lookupMedia fp mediabag of
                Just MediaItem
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe MediaItem
Nothing -> do
                  (bs, mt) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
                  insertMedia fp mt (BL.fromStrict bs)
              return $ Image attr lab (src, 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)
-> (FilePath -> Text) -> FilePath -> LogMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> LogMessage) -> FilePath -> LogMessage
forall a b. (a -> b) -> a -> b
$
                            (IOError -> FilePath
forall a. Show a => a -> FilePath
show IOError
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\nReplacing 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
                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 Text
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
                            (Text
er Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nReplacing 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 :: FilePath -> 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)
-> (FilePath -> m ByteString) -> FilePath -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileLazy
  readFileStrict :: FilePath -> 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)
-> (FilePath -> m ByteString) -> FilePath -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> 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 :: FilePath -> t m [FilePath]
glob = m [FilePath] -> t m [FilePath]
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 [FilePath] -> t m [FilePath])
-> (FilePath -> m [FilePath]) -> FilePath -> t m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m [FilePath]
forall (m :: * -> *). PandocMonad m => FilePath -> m [FilePath]
glob
  fileExists :: FilePath -> 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)
-> (FilePath -> m Bool) -> FilePath -> t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m Bool
forall (m :: * -> *). PandocMonad m => FilePath -> m Bool
fileExists
  getDataFileName :: FilePath -> t m FilePath
getDataFileName = m FilePath -> t m FilePath
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 FilePath -> t m FilePath)
-> (FilePath -> m FilePath) -> FilePath -> t m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m FilePath
forall (m :: * -> *). PandocMonad m => FilePath -> m FilePath
getDataFileName
  getModificationTime :: FilePath -> 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)
-> (FilePath -> m UTCTime) -> FilePath -> t m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m UTCTime
forall (m :: * -> *). PandocMonad m => FilePath -> 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 :: FilePath -> 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)
-> (FilePath -> m ByteString)
-> FilePath
-> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> m ByteString
readFileLazy
  readFileStrict :: FilePath -> 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)
-> (FilePath -> m ByteString)
-> FilePath
-> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ByteString
forall (m :: * -> *). PandocMonad m => FilePath -> 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 :: FilePath -> ParsecT s st m [FilePath]
glob = m [FilePath] -> ParsecT s st m [FilePath]
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 [FilePath] -> ParsecT s st m [FilePath])
-> (FilePath -> m [FilePath])
-> FilePath
-> ParsecT s st m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m [FilePath]
forall (m :: * -> *). PandocMonad m => FilePath -> m [FilePath]
glob
  fileExists :: FilePath -> 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)
-> (FilePath -> m Bool) -> FilePath -> ParsecT s st m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m Bool
forall (m :: * -> *). PandocMonad m => FilePath -> m Bool
fileExists
  getDataFileName :: FilePath -> ParsecT s st m FilePath
getDataFileName = m FilePath -> ParsecT s st m FilePath
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 FilePath -> ParsecT s st m FilePath)
-> (FilePath -> m FilePath) -> FilePath -> ParsecT s st m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m FilePath
forall (m :: * -> *). PandocMonad m => FilePath -> m FilePath
getDataFileName
  getModificationTime :: FilePath -> 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)
-> (FilePath -> m UTCTime) -> FilePath -> ParsecT s st m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m UTCTime
forall (m :: * -> *). PandocMonad m => FilePath -> 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
    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
    when tracing $ do
      pos <- getPosition
      Debug.Trace.trace
        ("[trace] Parsed " ++ T.unpack msg ++ " at line " ++
            show (sourceLine pos) ++
            if sourceName pos == "chunk"
               then " of chunk"
               else "")
        (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