{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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(..)
  , getPOSIXTime
  , getZonedTime
  , readFileFromDirs
  , report
  , setTrace
  , setRequestHeader
  , setNoCheckCertificate
  , getLog
  , setVerbosity
  , getVerbosity
  , getMediaBag
  , setMediaBag
  , insertMedia
  , setUserDataDir
  , getUserDataDir
  , fetchItem
  , getInputFiles
  , setInputFiles
  , getOutputFile
  , setOutputFile
  , setResourcePath
  , getResourcePath
  , readDefaultDataFile
  , readDataFile
  , fillMediaBag
  , toLang
  , setTranslations
  , translateTerm
  , makeCanonical
  , getTimestamp
  ) where

import Codec.Archive.Zip
import Control.Monad.Except (MonadError (catchError, throwError),
                             MonadTrans, lift, when)
import Data.List (foldl')
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds,
                             posixSecondsToUTCTime)
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime)
import Network.URI ( escapeURIString, nonStrictRelativeTo,
                     unEscapeString, parseURIReference, isAllowedInURI,
                     parseURI, URI(..) )
import System.FilePath ((</>), takeExtension, dropExtension,
                        isRelative, splitDirectories, makeRelative)
import System.Random (StdGen)
import Text.Collate.Lang (Lang(..), parseLang, renderLang)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Logging
import Text.Pandoc.MIME (MimeType, getMimeType)
import Text.Pandoc.MediaBag (MediaBag, lookupMedia, MediaItem(..))
import Text.Pandoc.Shared (uriPathToPath, safeRead)
import Text.Pandoc.Translations (Term(..), Translations, lookupTerm,
                                 readTranslations)
import Text.Pandoc.Walk (walkM)
import Text.Parsec (ParsecT, getPosition, sourceLine, sourceName)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Debug.Trace
import qualified System.FilePath.Posix as Posix
import qualified Text.Pandoc.MediaBag as MB
import qualified Text.Pandoc.UTF8 as UTF8
#ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles)
#endif

-- | 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
  -- | 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 (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 (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
$ String -> m () -> m ()
forall a. String -> a -> a
Debug.Trace.trace (String
"[trace] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
msg) (() -> m ()
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 :: 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 :: m Verbosity
getVerbosity = (CommonState -> Verbosity) -> m Verbosity
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 :: 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 (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 :: LogMessage -> m ()
report LogMessage
msg = do
  Verbosity
verbosity <- (CommonState -> Verbosity) -> m Verbosity
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 }

-- | Get the time from the @SOURCE_DATE_EPOCH@
-- environment variable. The variable should contain a
-- unix time stamp, the number of seconds since midnight Jan 01
-- 1970 UTC.  If the variable is not set or cannot be
-- parsed as a unix time stamp, the current time is returned.
-- This function is designed to make possible reproducible
-- builds in formats that include a creation timestamp.
getTimestamp :: PandocMonad m => m UTCTime
getTimestamp :: 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 (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 (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

-- | 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 :: 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 :: 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 :: 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 :: 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 :: m MediaBag
getMediaBag = (CommonState -> MediaBag) -> m MediaBag
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 :: String -> Maybe Text -> ByteString -> m ()
insertMedia String
fp Maybe Text
mime ByteString
bs = do
  MediaBag
mb <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  let mb' :: MediaBag
mb' = String -> Maybe Text -> ByteString -> MediaBag -> MediaBag
MB.insertMedia String
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 :: m [String]
getInputFiles = (CommonState -> [String]) -> m [String]
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [String]
stInputFiles

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

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

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

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

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

-- | Get the POSIX time.
getPOSIXTime :: PandocMonad m => m POSIXTime
getPOSIXTime :: 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
getCurrentTime

-- | Get the zoned time.
getZonedTime :: PandocMonad m => m ZonedTime
getZonedTime :: m ZonedTime
getZonedTime = do
  UTCTime
t <- m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
  TimeZone
tz <- m TimeZone
forall (m :: * -> *). PandocMonad m => m TimeZone
getCurrentTimeZone
  ZonedTime -> m ZonedTime
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 :: [String] -> String -> m (Maybe Text)
readFileFromDirs [] String
_ = Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
readFileFromDirs (String
d:[String]
ds) String
f = m (Maybe Text) -> (PandocError -> m (Maybe Text)) -> m (Maybe Text)
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
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
UTF8.toStringLazy (ByteString -> Maybe Text) -> m ByteString -> m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileLazy (String
d String -> String -> String
</> String
f))
    (\PandocError
_ -> [String] -> String -> m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[String] -> String -> m (Maybe Text)
readFileFromDirs [String]
ds String
f)

-- | Convert BCP47 string to a Lang, issuing warning
-- if there are problems.
toLang :: PandocMonad m => Maybe T.Text -> m (Maybe Lang)
toLang :: Maybe Text -> m (Maybe Lang)
toLang Maybe Text
Nothing = Maybe Lang -> m (Maybe Lang)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing
toLang (Just Text
s) =
  case Text -> Either String Lang
parseLang Text
s of
       Left String
_ -> 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 (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing
       Right Lang
l -> Maybe Lang -> m (Maybe Lang)
forall (m :: * -> *) a. Monad m => a -> m a
return (Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
l)

-- | Select the language to use with 'translateTerm'.
-- Note that this does not read a translation file;
-- that is only done the first time 'translateTerm' is
-- used.
setTranslations :: PandocMonad m => Lang -> m ()
setTranslations :: Lang -> m ()
setTranslations Lang
lang =
  (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{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = (Lang, Maybe Translations) -> Maybe (Lang, Maybe Translations)
forall a. a -> Maybe a
Just (Lang
lang, Maybe Translations
forall a. Maybe a
Nothing) }

-- | Load term map.
getTranslations :: PandocMonad m => m Translations
getTranslations :: m Translations
getTranslations = do
  Maybe (Lang, Maybe Translations)
mbtrans <- (CommonState -> Maybe (Lang, Maybe Translations))
-> m (Maybe (Lang, Maybe Translations))
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe (Lang, Maybe Translations)
stTranslations
  case Maybe (Lang, Maybe Translations)
mbtrans of
       Maybe (Lang, Maybe Translations)
Nothing -> Translations -> m Translations
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
forall a. Monoid a => a
mempty  -- no language defined
       Just (Lang
_, Just Translations
t) -> Translations -> m Translations
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
t
       Just (Lang
lang, Maybe Translations
Nothing) -> do  -- read from file
         let translationFile :: Text
translationFile = Text
"translations/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Lang -> Text
renderLang Lang
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".yaml"
         let fallbackFile :: Text
fallbackFile = Text
"translations/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Lang -> Text
langLanguage Lang
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".yaml"
         let getTrans :: String -> m Translations
getTrans String
fp = do
               ByteString
bs <- String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
fp
               case Text -> Either Text Translations
readTranslations (ByteString -> Text
UTF8.toText ByteString
bs) of
                    Left Text
e   -> do
                      LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotLoadTranslations (Lang -> Text
renderLang Lang
lang)
                        (String -> Text
T.pack String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e)
                      -- make sure we don't try again...
                      (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{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = Maybe (Lang, Maybe Translations)
forall a. Maybe a
Nothing }
                      Translations -> m Translations
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
forall a. Monoid a => a
mempty
                    Right Translations
t -> do
                      (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{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = (Lang, Maybe Translations) -> Maybe (Lang, Maybe Translations)
forall a. a -> Maybe a
Just (Lang
lang, Translations -> Maybe Translations
forall a. a -> Maybe a
Just Translations
t) }
                      Translations -> m Translations
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
t
         m Translations -> (PandocError -> m Translations) -> m Translations
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (String -> m Translations
forall (m :: * -> *). PandocMonad m => String -> m Translations
getTrans (String -> m Translations) -> String -> m Translations
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
translationFile)
           (\PandocError
_ ->
             m Translations -> (PandocError -> m Translations) -> m Translations
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (String -> m Translations
forall (m :: * -> *). PandocMonad m => String -> m Translations
getTrans (String -> m Translations) -> String -> m Translations
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fallbackFile)
               (\PandocError
e -> do
                 LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotLoadTranslations (Lang -> Text
renderLang Lang
lang)
                          (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ case PandocError
e of
                               PandocCouldNotFindDataFileError Text
_ ->
                                 Text
"data file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fallbackFile Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found"
                               PandocError
_ -> Text
""
                 -- make sure we don't try again...
                 (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{ stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = Maybe (Lang, Maybe Translations)
forall a. Maybe a
Nothing }
                 Translations -> m Translations
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
forall a. Monoid a => a
mempty))

-- | Get a translation from the current term map.
-- Issue a warning if the term is not defined.
translateTerm :: PandocMonad m => Term -> m T.Text
translateTerm :: Term -> m Text
translateTerm Term
term = do
  Translations
translations <- m Translations
forall (m :: * -> *). PandocMonad m => m Translations
getTranslations
  case Term -> Translations -> Maybe Text
lookupTerm Term
term Translations
translations of
       Just Text
s -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
       Maybe Text
Nothing -> do
         LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
NoTranslation (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term
         Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""

-- | 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 <- String -> Maybe URI
parseURIReference (Text -> String
T.unpack Text
s)
  case URI -> String
uriScheme URI
u of
       [Char
_] -> Maybe URI
forall a. Maybe a
Nothing
       String
_   -> 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 :: Maybe String -> m ()
setUserDataDir Maybe String
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 String
stUserDataDir = Maybe String
mbfp }

-- | Get the user data directory from common state.
getUserDataDir :: PandocMonad m
               => m (Maybe FilePath)
getUserDataDir :: m (Maybe String)
getUserDataDir = (CommonState -> Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe String
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 :: Text -> m (ByteString, Maybe Text)
fetchItem Text
s = do
  MediaBag
mediabag <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  case String -> MediaBag -> Maybe MediaItem
lookupMedia (Text -> String
T.unpack Text
s) MediaBag
mediabag of
    Just MediaItem
item -> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
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 :: Text -> m (ByteString, Maybe Text)
downloadOrRead Text
s = do
  Maybe Text
sourceURL <- (CommonState -> Maybe Text) -> m (Maybe Text)
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 (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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show (URI -> String) -> URI -> String
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 -> String
T.unpack -> (Char
'/':Char
'/':Char
c:String
_))) | 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
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show (URI -> String) -> URI -> String
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 String -> Maybe URI
parseURI (Text -> String
T.unpack Text
s') of  -- requires absolute URI
            Just URI
u' | URI -> String
uriScheme URI
u' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"file:" ->
                 String -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
String -> m (ByteString, Maybe Text)
readLocalFile (String -> m (ByteString, Maybe Text))
-> String -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> String
uriPathToPath (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
uriPath URI
u')
            -- We don't want to treat C:/ as a scheme:
            Just URI
u' | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (URI -> String
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 (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show URI
u')
            Maybe URI
_ -> String -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
String -> m (ByteString, Maybe Text)
readLocalFile String
fp -- get from local file system
   where readLocalFile :: String -> m (ByteString, Maybe Text)
readLocalFile String
f = do
             [String]
resourcePath <- m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getResourcePath
             (String
fp', ByteString
cont) <- if String -> Bool
isRelative String
f
                               then [String]
-> (String -> m ByteString) -> String -> m (String, ByteString)
forall (m :: * -> *) a.
PandocMonad m =>
[String] -> (String -> m a) -> String -> m (String, a)
withPaths [String]
resourcePath String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict String
f
                               else (String
f,) (ByteString -> (String, ByteString))
-> m ByteString -> m (String, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict String
f
             LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> LogMessage
LoadedResource String
f (String -> String -> String
makeRelative String
"." String
fp')
             (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
cont, Maybe Text
mime)
         httpcolon :: URI
httpcolon = URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI{ uriScheme :: String
uriScheme = String
"http:",
                          uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing,
                          uriPath :: String
uriPath = String
"",
                          uriQuery :: String
uriQuery = String
"",
                          uriFragment :: String
uriFragment = String
"" }
         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 :: String
fp = String -> String
unEscapeString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
dropFragmentAndQuery Text
s
         mime :: Maybe Text
mime = String -> Maybe Text
getMimeType (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ case String -> String
takeExtension String
fp of
                     String
".gz" -> String -> String
dropExtension String
fp
                     String
".svgz" -> String -> String
dropExtension String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".svg"
                     String
x     -> String
x
         ensureEscaped :: Text -> Text
ensureEscaped = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isAllowedInURI (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
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

-- | Retrieve default reference.docx.
getDefaultReferenceDocx :: PandocMonad m => m Archive
getDefaultReferenceDocx :: m Archive
getDefaultReferenceDocx = do
  let paths :: [String]
paths = [String
"[Content_Types].xml",
               String
"_rels/.rels",
               String
"docProps/app.xml",
               String
"docProps/core.xml",
               String
"docProps/custom.xml",
               String
"word/document.xml",
               String
"word/fontTable.xml",
               String
"word/footnotes.xml",
               String
"word/comments.xml",
               String
"word/numbering.xml",
               String
"word/settings.xml",
               String
"word/webSettings.xml",
               String
"word/styles.xml",
               String
"word/_rels/document.xml.rels",
               String
"word/_rels/footnotes.xml.rels",
               String
"word/theme/theme1.xml"]
  let toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
  let pathToEntry :: String -> m Entry
pathToEntry String
path = do
        Integer
epochtime <- POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Integer) -> m UTCTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
        ByteString
contents <- ByteString -> ByteString
toLazy (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile (String
"docx/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)
        Entry -> m Entry
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> m Entry) -> Entry -> m Entry
forall a b. (a -> b) -> a -> b
$ String -> Integer -> ByteString -> Entry
toEntry String
path Integer
epochtime ByteString
contents
  Maybe String
datadir <- m (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
  Maybe String
mbArchive <- case Maybe String
datadir of
                    Maybe String
Nothing   -> Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    Just String
d    -> do
                       Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists (String
d String -> String -> String
</> String
"reference.docx")
                       if Bool
exists
                          then Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just (String
d String -> String -> String
</> String
"reference.docx"))
                          else Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  case Maybe String
mbArchive of
     Just String
arch -> ByteString -> Archive
toArchive (ByteString -> Archive) -> m ByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileLazy String
arch
     Maybe String
Nothing   -> (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> m [Entry] -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     (String -> m Entry) -> [String] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m Entry
forall (m :: * -> *). PandocMonad m => String -> m Entry
pathToEntry [String]
paths

-- | Retrieve default reference.odt.
getDefaultReferenceODT :: PandocMonad m => m Archive
getDefaultReferenceODT :: m Archive
getDefaultReferenceODT = do
  let paths :: [String]
paths = [String
"mimetype",
               String
"manifest.rdf",
               String
"styles.xml",
               String
"content.xml",
               String
"meta.xml",
               String
"settings.xml",
               String
"Configurations2/accelerator/current.xml",
               String
"Thumbnails/thumbnail.png",
               String
"META-INF/manifest.xml"]
  let pathToEntry :: String -> m Entry
pathToEntry String
path = do Integer
epochtime <- POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer) -> m POSIXTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` m POSIXTime
forall (m :: * -> *). PandocMonad m => m POSIXTime
getPOSIXTime
                            ByteString
contents <- ([ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])) (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
                                          String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile (String
"odt/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)
                            Entry -> m Entry
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> m Entry) -> Entry -> m Entry
forall a b. (a -> b) -> a -> b
$ String -> Integer -> ByteString -> Entry
toEntry String
path Integer
epochtime ByteString
contents
  Maybe String
datadir <- m (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
  Maybe String
mbArchive <- case Maybe String
datadir of
                    Maybe String
Nothing   -> Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    Just String
d    -> do
                       Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists (String
d String -> String -> String
</> String
"reference.odt")
                       if Bool
exists
                          then Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just (String
d String -> String -> String
</> String
"reference.odt"))
                          else Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  case Maybe String
mbArchive of
     Just String
arch -> ByteString -> Archive
toArchive (ByteString -> Archive) -> m ByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileLazy String
arch
     Maybe String
Nothing   -> (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> m [Entry] -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     (String -> m Entry) -> [String] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m Entry
forall (m :: * -> *). PandocMonad m => String -> m Entry
pathToEntry [String]
paths

-- | Retrieve default reference.pptx.
getDefaultReferencePptx :: PandocMonad m => m Archive
getDefaultReferencePptx :: m Archive
getDefaultReferencePptx = do
  -- We're going to narrow this down substantially once we get it
  -- working.
  let paths :: [String]
paths = [ String
"[Content_Types].xml"
              , String
"_rels/.rels"
              , String
"docProps/app.xml"
              , String
"docProps/core.xml"
              , String
"ppt/_rels/presentation.xml.rels"
              , String
"ppt/presProps.xml"
              , String
"ppt/presentation.xml"
              , String
"ppt/slideLayouts/_rels/slideLayout1.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout2.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout3.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout4.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout5.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout6.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout7.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout8.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout9.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout10.xml.rels"
              , String
"ppt/slideLayouts/_rels/slideLayout11.xml.rels"
              , String
"ppt/slideLayouts/slideLayout1.xml"
              , String
"ppt/slideLayouts/slideLayout10.xml"
              , String
"ppt/slideLayouts/slideLayout11.xml"
              , String
"ppt/slideLayouts/slideLayout2.xml"
              , String
"ppt/slideLayouts/slideLayout3.xml"
              , String
"ppt/slideLayouts/slideLayout4.xml"
              , String
"ppt/slideLayouts/slideLayout5.xml"
              , String
"ppt/slideLayouts/slideLayout6.xml"
              , String
"ppt/slideLayouts/slideLayout7.xml"
              , String
"ppt/slideLayouts/slideLayout8.xml"
              , String
"ppt/slideLayouts/slideLayout9.xml"
              , String
"ppt/slideMasters/_rels/slideMaster1.xml.rels"
              , String
"ppt/slideMasters/slideMaster1.xml"
              , String
"ppt/slides/_rels/slide1.xml.rels"
              , String
"ppt/slides/slide1.xml"
              , String
"ppt/slides/_rels/slide2.xml.rels"
              , String
"ppt/slides/slide2.xml"
              , String
"ppt/slides/_rels/slide3.xml.rels"
              , String
"ppt/slides/slide3.xml"
              , String
"ppt/slides/_rels/slide4.xml.rels"
              , String
"ppt/slides/slide4.xml"
              , String
"ppt/tableStyles.xml"
              , String
"ppt/theme/theme1.xml"
              , String
"ppt/viewProps.xml"
              -- These relate to notes slides.
              , String
"ppt/notesMasters/notesMaster1.xml"
              , String
"ppt/notesMasters/_rels/notesMaster1.xml.rels"
              , String
"ppt/notesSlides/notesSlide1.xml"
              , String
"ppt/notesSlides/_rels/notesSlide1.xml.rels"
              , String
"ppt/notesSlides/notesSlide2.xml"
              , String
"ppt/notesSlides/_rels/notesSlide2.xml.rels"
              , String
"ppt/theme/theme2.xml"
              ]
  let toLazy :: ByteString -> ByteString
toLazy = [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])
  let pathToEntry :: String -> m Entry
pathToEntry String
path = do
        Integer
epochtime <- POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Integer) -> m UTCTime -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). PandocMonad m => m UTCTime
getCurrentTime
        ByteString
contents <- ByteString -> ByteString
toLazy (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile (String
"pptx/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)
        Entry -> m Entry
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> m Entry) -> Entry -> m Entry
forall a b. (a -> b) -> a -> b
$ String -> Integer -> ByteString -> Entry
toEntry String
path Integer
epochtime ByteString
contents
  Maybe String
datadir <- m (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
  Maybe String
mbArchive <- case Maybe String
datadir of
                    Maybe String
Nothing   -> Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    Just String
d    -> do
                       Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists (String
d String -> String -> String
</> String
"reference.pptx")
                       if Bool
exists
                          then Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just (String
d String -> String -> String
</> String
"reference.pptx"))
                          else Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  case Maybe String
mbArchive of
     Just String
arch -> ByteString -> Archive
toArchive (ByteString -> Archive) -> m ByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileLazy String
arch
     Maybe String
Nothing   -> (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
emptyArchive ([Entry] -> Archive) -> m [Entry] -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                     (String -> m Entry) -> [String] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> m Entry
forall (m :: * -> *). PandocMonad m => String -> m Entry
pathToEntry [String]
paths

-- | Read file from user data directory or,
-- if not found there, from the default data files.
readDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDataFile :: String -> m ByteString
readDataFile String
fname = do
  Maybe String
datadir <- m (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
  case Maybe String
datadir of
       Maybe String
Nothing -> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDefaultDataFile String
fname
       Just String
userDir -> do
         Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists (String
userDir String -> String -> String
</> String
fname)
         if Bool
exists
            then String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict (String
userDir String -> String -> String
</> String
fname)
            else String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDefaultDataFile String
fname

-- | Read file from from the default data files.
readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDefaultDataFile :: String -> m ByteString
readDefaultDataFile String
"reference.docx" =
  [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Archive -> [ByteString]) -> Archive -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString])
-> (Archive -> ByteString) -> Archive -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> ByteString
fromArchive (Archive -> ByteString) -> m Archive -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Archive
forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceDocx
readDefaultDataFile String
"reference.pptx" =
  [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Archive -> [ByteString]) -> Archive -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString])
-> (Archive -> ByteString) -> Archive -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> ByteString
fromArchive (Archive -> ByteString) -> m Archive -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Archive
forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferencePptx
readDefaultDataFile String
"reference.odt" =
  [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Archive -> [ByteString]) -> Archive -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString])
-> (Archive -> ByteString) -> Archive -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> ByteString
fromArchive (Archive -> ByteString) -> m Archive -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Archive
forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceODT
readDefaultDataFile String
fname =
#ifdef EMBED_DATA_FILES
  case lookup (makeCanonical fname) dataFiles of
    Nothing       -> throwError $ PandocCouldNotFindDataFileError $ T.pack fname
    Just contents -> return contents
#else
  String -> m String
forall (m :: * -> *). PandocMonad m => String -> m String
getDataFileName String
fname' m String -> (String -> m String) -> m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> m String
forall (m :: * -> *). PandocMonad m => String -> m String
checkExistence m String -> (String -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict
    where fname' :: String
fname' = if String
fname String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"MANUAL.txt" then String
fname else String
"data" String -> String -> String
</> String
fname

-- | Returns the input filename unchanged if the file exits, and throws
-- a `PandocCouldNotFindDataFileError` if it doesn't.
checkExistence :: PandocMonad m => FilePath -> m FilePath
checkExistence :: String -> m String
checkExistence String
fn = do
  Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists String
fn
  if Bool
exists
     then String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
fn
     else PandocError -> m String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m String) -> PandocError -> m String
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocCouldNotFindDataFileError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
fn
#endif

-- | Canonicalizes a file path by removing redundant @.@ and @..@.
makeCanonical :: FilePath -> FilePath
makeCanonical :: String -> String
makeCanonical = [String] -> String
Posix.joinPath ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
transformPathParts ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories
 where  transformPathParts :: [String] -> [String]
transformPathParts = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String -> [String])
-> [String] -> [String] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [String] -> String -> [String]
forall a. (Eq a, IsString a) => [a] -> a -> [a]
go []
        go :: [a] -> a -> [a]
go [a]
as     a
"."  = [a]
as
        go (a
_:[a]
as) a
".." = [a]
as
        go [a]
as     a
x    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as

-- | 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 :: [String] -> (String -> m a) -> String -> m (String, a)
withPaths [] String -> m a
_ String
fp = PandocError -> m (String, a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m (String, a)) -> PandocError -> m (String, a)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
fp
withPaths (String
p:[String]
ps) String -> m a
action String
fp =
  m (String, a) -> (PandocError -> m (String, a)) -> m (String, a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ((String
p String -> String -> String
</> String
fp,) (a -> (String, a)) -> m a -> m (String, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m a
action (String
p String -> String -> String
</> String
fp))
             (\PandocError
_ -> [String] -> (String -> m a) -> String -> m (String, a)
forall (m :: * -> *) a.
PandocMonad m =>
[String] -> (String -> m a) -> String -> m (String, a)
withPaths [String]
ps String -> m a
action String
fp)

-- | Traverse tree, filling media bag for any images that
-- aren't already in the media bag.
fillMediaBag :: PandocMonad m => Pandoc -> m Pandoc
fillMediaBag :: 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
walkM Inline -> m Inline
forall (m :: * -> *). PandocMonad m => Inline -> m Inline
handleImage Pandoc
d
  where handleImage :: PandocMonad m => Inline -> m Inline
        handleImage :: Inline -> m Inline
handleImage (Image Attr
attr [Inline]
lab (Text
src, Text
tit)) = m Inline -> (PandocError -> m Inline) -> m Inline
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 :: String
fp = Text -> String
T.unpack Text
src
              case String -> MediaBag -> Maybe MediaItem
lookupMedia String
fp MediaBag
mediabag of
                Just MediaItem
_ -> () -> m ()
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
                  String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
fp Maybe Text
mt (ByteString -> ByteString
BL.fromStrict ByteString
bs)
              Inline -> m Inline
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 (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"image"],[]) [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
                            (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ HttpException -> String
forall a. Show a => a -> String
show HttpException
er String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\rReplacing image with description.")
                  -- emit alt text
                  Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> m Inline) -> Inline -> m Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> Inline
Span (Text
"",[Text
"image"],[]) [Inline]
lab
                PandocError
_ -> PandocError -> m Inline
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)
        handleImage Inline
x = Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

-- 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 (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 (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 (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 (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 (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 (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 :: String -> t m ByteString
readFileLazy = m ByteString -> t m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString)
-> (String -> m ByteString) -> String -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileLazy
  readFileStrict :: String -> t m ByteString
readFileStrict = m ByteString -> t m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString)
-> (String -> m ByteString) -> String -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict
  glob :: String -> t m [String]
glob = m [String] -> t m [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [String] -> t m [String])
-> (String -> m [String]) -> String -> t m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m [String]
forall (m :: * -> *). PandocMonad m => String -> m [String]
glob
  fileExists :: String -> t m Bool
fileExists = m Bool -> t m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> t m Bool) -> (String -> m Bool) -> String -> t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists
  getDataFileName :: String -> t m String
getDataFileName = m String -> t m String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m String -> t m String)
-> (String -> m String) -> String -> t m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m String
forall (m :: * -> *). PandocMonad m => String -> m String
getDataFileName
  getModificationTime :: String -> t m UTCTime
getModificationTime = m UTCTime -> t m UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> t m UTCTime)
-> (String -> m UTCTime) -> String -> t m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m UTCTime
forall (m :: * -> *). PandocMonad m => String -> m UTCTime
getModificationTime
  getCommonState :: t m CommonState
getCommonState = m CommonState -> t m CommonState
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 (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 (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 (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 (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 (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 (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 (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 (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 :: String -> ParsecT s st m ByteString
readFileLazy = m ByteString -> ParsecT s st m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ParsecT s st m ByteString)
-> (String -> m ByteString) -> String -> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileLazy
  readFileStrict :: String -> ParsecT s st m ByteString
readFileStrict = m ByteString -> ParsecT s st m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ParsecT s st m ByteString)
-> (String -> m ByteString) -> String -> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict
  glob :: String -> ParsecT s st m [String]
glob = m [String] -> ParsecT s st m [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [String] -> ParsecT s st m [String])
-> (String -> m [String]) -> String -> ParsecT s st m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m [String]
forall (m :: * -> *). PandocMonad m => String -> m [String]
glob
  fileExists :: String -> ParsecT s st m Bool
fileExists = m Bool -> ParsecT s st m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ParsecT s st m Bool)
-> (String -> m Bool) -> String -> ParsecT s st m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists
  getDataFileName :: String -> ParsecT s st m String
getDataFileName = m String -> ParsecT s st m String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m String -> ParsecT s st m String)
-> (String -> m String) -> String -> ParsecT s st m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m String
forall (m :: * -> *). PandocMonad m => String -> m String
getDataFileName
  getModificationTime :: String -> ParsecT s st m UTCTime
getModificationTime = m UTCTime -> ParsecT s st m UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> ParsecT s st m UTCTime)
-> (String -> m UTCTime) -> String -> ParsecT s st m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m UTCTime
forall (m :: * -> *). PandocMonad m => String -> m UTCTime
getModificationTime
  getCommonState :: ParsecT s st m CommonState
getCommonState = m CommonState -> ParsecT s st m CommonState
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 (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 (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
      String -> ParsecT s st m () -> ParsecT s st m ()
forall a. String -> a -> a
Debug.Trace.trace
        (String
"[trace] Parsed " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at line " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            Int -> String
forall a. Show a => a -> String
show (SourcePos -> Int
sourceLine SourcePos
pos) String -> String -> String
forall a. [a] -> [a] -> [a]
++
            if SourcePos -> String
sourceName SourcePos
pos String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"chunk"
               then String
" of chunk"
               else String
"")
        (() -> ParsecT s st m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  logOutput :: LogMessage -> ParsecT s st m ()
logOutput = m () -> ParsecT s st m ()
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