{-# 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
  -- | Read the contents of stdin as a strict ByteString, raising
  -- an error on failure.
  readStdinStrict :: m B.ByteString
  -- | Return a list of paths that match a glob, relative to
  -- the working directory.  See 'System.FilePath.Glob' for
  -- the glob syntax.
  glob :: String -> m [FilePath]
  -- | Returns True if file exists.
  fileExists :: FilePath -> m Bool
  -- | Returns the path of data file.
  getDataFileName :: FilePath -> m FilePath
  -- | Return the modification time of a file.
  getModificationTime :: FilePath -> m UTCTime
  -- | Get the value of the 'CommonState' used by all instances
  -- of 'PandocMonad'.
  getCommonState :: m CommonState
  -- | Set the value of the 'CommonState' used by all instances
  -- of 'PandocMonad'.
  -- | Get the value of a specific field of 'CommonState'.
  putCommonState :: CommonState -> m ()
  -- | Get the value of a specific field of 'CommonState'.
  getsCommonState :: (CommonState -> a) -> m a
  getsCommonState CommonState -> a
f = CommonState -> a
f (CommonState -> a) -> m CommonState -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  -- | Modify the 'CommonState'.
  modifyCommonState :: (CommonState -> CommonState) -> m ()
  modifyCommonState CommonState -> CommonState
f = m CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState m CommonState -> (CommonState -> m ()) -> m ()
forall (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
$ [Char] -> m () -> m ()
forall a. [Char] -> a -> a
Debug.Trace.trace ([Char]
"[trace] " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- * Functions defined for all PandocMonad instances

-- | Set the verbosity level.
setVerbosity :: PandocMonad m => Verbosity -> m ()
setVerbosity :: forall (m :: * -> *). PandocMonad m => Verbosity -> m ()
setVerbosity Verbosity
verbosity =
  (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stVerbosity :: Verbosity
stVerbosity = Verbosity
verbosity }

-- | Get the verbosity level.
getVerbosity :: PandocMonad m => m Verbosity
getVerbosity :: forall (m :: * -> *). PandocMonad m => m Verbosity
getVerbosity = (CommonState -> Verbosity) -> m Verbosity
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Verbosity
stVerbosity

-- | Get the accumulated log messages (in temporal order).
getLog :: PandocMonad m => m [LogMessage]
getLog :: forall (m :: * -> *). PandocMonad m => m [LogMessage]
getLog = [LogMessage] -> [LogMessage]
forall a. [a] -> [a]
reverse ([LogMessage] -> [LogMessage]) -> m [LogMessage] -> m [LogMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CommonState -> [LogMessage]) -> m [LogMessage]
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [LogMessage]
stLog

-- | Log a message using 'logOutput'.  Note that 'logOutput' is
-- called only if the verbosity level exceeds the level of the
-- message, but the message is added to the list of log messages
-- that will be retrieved by 'getLog' regardless of its verbosity level.
report :: PandocMonad m => LogMessage -> m ()
report :: forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report LogMessage
msg = do
  Verbosity
verbosity <- (CommonState -> Verbosity) -> m Verbosity
forall (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 :: forall (m :: * -> *). PandocMonad m => m UTCTime
getTimestamp = do
  Maybe Text
mbSourceDateEpoch <- Text -> m (Maybe Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Maybe Text)
lookupEnv Text
"SOURCE_DATE_EPOCH"
  case Maybe Text
mbSourceDateEpoch Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (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 :: forall (m :: * -> *). PandocMonad m => Bool -> m ()
setTrace Bool
useTracing = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stTrace :: Bool
stTrace = Bool
useTracing}

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

-- | Determine whether certificate validation is disabled
setNoCheckCertificate :: PandocMonad m => Bool -> m ()
setNoCheckCertificate :: forall (m :: * -> *). PandocMonad m => Bool -> m ()
setNoCheckCertificate Bool
noCheckCertificate = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stNoCheckCertificate :: Bool
stNoCheckCertificate = Bool
noCheckCertificate}

-- | Initialize the media bag.
setMediaBag :: PandocMonad m => MediaBag -> m ()
setMediaBag :: forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag MediaBag
mb = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stMediaBag :: MediaBag
stMediaBag = MediaBag
mb}

-- | Retrieve the media bag.
getMediaBag :: PandocMonad m => m MediaBag
getMediaBag :: forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag = (CommonState -> MediaBag) -> m MediaBag
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> MediaBag
stMediaBag

-- | Insert an item into the media bag.
insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()
insertMedia :: forall (m :: * -> *).
PandocMonad m =>
[Char] -> Maybe Text -> ByteString -> m ()
insertMedia [Char]
fp Maybe Text
mime ByteString
bs = do
  MediaBag
mb <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  let mb' :: MediaBag
mb' = [Char] -> Maybe Text -> ByteString -> MediaBag -> MediaBag
MB.insertMedia [Char]
fp Maybe Text
mime ByteString
bs MediaBag
mb
  MediaBag -> m ()
forall (m :: * -> *). PandocMonad m => MediaBag -> m ()
setMediaBag MediaBag
mb'

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

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

  (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stInputFiles :: [[Char]]
stInputFiles = [[Char]]
fs
                               , stSourceURL :: Maybe Text
stSourceURL = [Char] -> Text
T.pack ([Char] -> Text) -> Maybe [Char] -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
sourceURL }

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

-- | Set the output filename.
setOutputFile :: PandocMonad m => Maybe FilePath -> m ()
setOutputFile :: forall (m :: * -> *). PandocMonad m => Maybe [Char] -> m ()
setOutputFile Maybe [Char]
mbf = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stOutputFile :: Maybe [Char]
stOutputFile = Maybe [Char]
mbf }

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

-- | Set the resource path searched by 'fetchItem'.
setResourcePath :: PandocMonad m => [FilePath] -> m ()
setResourcePath :: forall (m :: * -> *). PandocMonad m => [[Char]] -> m ()
setResourcePath [[Char]]
ps = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{stResourcePath :: [[Char]]
stResourcePath = [[Char]]
ps}

-- | Get the POSIX 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
getCurrentTime

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

-- | Convert BCP47 string to a Lang, issuing warning
-- if there are problems.
toLang :: PandocMonad m => Maybe T.Text -> m (Maybe Lang)
toLang :: forall (m :: * -> *). PandocMonad m => Maybe Text -> m (Maybe Lang)
toLang Maybe Text
Nothing = Maybe Lang -> m (Maybe Lang)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing
toLang (Just Text
s) =
  case Text -> Either [Char] Lang
parseLang Text
s of
       Left [Char]
_ -> do
         LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
InvalidLang Text
s
         Maybe Lang -> m (Maybe Lang)
forall (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 :: forall (m :: * -> *). PandocMonad m => 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 :: forall (m :: * -> *). PandocMonad m => 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 :: [Char] -> m Translations
getTrans [Char]
fp = do
               ByteString
bs <- [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile [Char]
fp
               case Text -> Either Text Translations
readTranslations (ByteString -> Text
UTF8.toText ByteString
bs) of
                    Left Text
e   -> do
                      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)
                        ([Char] -> Text
T.pack [Char]
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 ([Char] -> m Translations
forall {m :: * -> *}. PandocMonad m => [Char] -> m Translations
getTrans ([Char] -> m Translations) -> [Char] -> m Translations
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
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 ([Char] -> m Translations
forall {m :: * -> *}. PandocMonad m => [Char] -> m Translations
getTrans ([Char] -> m Translations) -> [Char] -> m Translations
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
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 :: forall (m :: * -> *). PandocMonad m => 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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Term -> [Char]
forall a. Show a => a -> [Char]
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 <- [Char] -> Maybe URI
parseURIReference (Text -> [Char]
T.unpack Text
s)
  case URI -> [Char]
uriScheme URI
u of
       [Char
_] -> Maybe URI
forall a. Maybe a
Nothing
       [Char]
_   -> URI -> Maybe URI
forall a. a -> Maybe a
Just URI
u

-- | Set the user data directory in common state.
setUserDataDir :: PandocMonad m
               => Maybe FilePath
               -> m ()
setUserDataDir :: forall (m :: * -> *). PandocMonad m => Maybe [Char] -> m ()
setUserDataDir Maybe [Char]
mbfp = (CommonState -> CommonState) -> m ()
forall (m :: * -> *).
PandocMonad m =>
(CommonState -> CommonState) -> m ()
modifyCommonState ((CommonState -> CommonState) -> m ())
-> (CommonState -> CommonState) -> m ()
forall a b. (a -> b) -> a -> b
$ \CommonState
st -> CommonState
st{ stUserDataDir :: Maybe [Char]
stUserDataDir = Maybe [Char]
mbfp }

-- | Get the user data directory from common state.
getUserDataDir :: PandocMonad m
               => m (Maybe FilePath)
getUserDataDir :: forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir = (CommonState -> Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> Maybe [Char]
stUserDataDir

-- | Fetch an image or other item from the local filesystem or the net.
-- Returns raw content and maybe mime type.
fetchItem :: PandocMonad m
          => T.Text
          -> m (B.ByteString, Maybe MimeType)
fetchItem :: forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
s = do
  MediaBag
mediabag <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  case [Char] -> MediaBag -> Maybe MediaItem
lookupMedia (Text -> [Char]
T.unpack Text
s) MediaBag
mediabag of
    Just MediaItem
item -> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
BL.toStrict (MediaItem -> ByteString
mediaContents MediaItem
item),
                         Text -> Maybe Text
forall a. a -> Maybe a
Just (MediaItem -> Text
mediaMimeType MediaItem
item))
    Maybe MediaItem
Nothing -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
downloadOrRead Text
s

-- | Returns the content and, if available, the MIME type of a resource.
-- If the given resource location is a valid URI, then download the
-- resource from that URI. Otherwise, treat the resource identifier as a
-- local file name.
--
-- Note that resources are treated relative to the URL of the first
-- input source, if any.
downloadOrRead :: PandocMonad m
               => T.Text
               -> m (B.ByteString, Maybe MimeType)
downloadOrRead :: forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
downloadOrRead Text
s = do
  Maybe Text
sourceURL <- (CommonState -> Maybe Text) -> m (Maybe Text)
forall (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
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
forall a. Show a => a -> [Char]
show (URI -> [Char]) -> URI -> [Char]
forall a b. (a -> b) -> a -> b
$ URI
u' URI -> URI -> URI
`nonStrictRelativeTo` URI
u
            Maybe URI
Nothing -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
s' -- will throw error
    (Maybe URI
Nothing, s' :: Text
s'@(Text -> [Char]
T.unpack -> (Char
'/':Char
'/':Char
c:[Char]
_))) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?' ->  -- protocol-relative URI
                -- we exclude //? because of //?UNC/ on Windows
       case Text -> Maybe URI
parseURIReference' Text
s' of
            Just URI
u' -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL (Text -> m (ByteString, Maybe Text))
-> Text -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
forall a. Show a => a -> [Char]
show (URI -> [Char]) -> URI -> [Char]
forall a b. (a -> b) -> a -> b
$ URI
u' URI -> URI -> URI
`nonStrictRelativeTo` URI
httpcolon
            Maybe URI
Nothing -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
s' -- will throw error
    (Maybe URI
Nothing, Text
s') ->
       case [Char] -> Maybe URI
parseURI (Text -> [Char]
T.unpack Text
s') of  -- requires absolute URI
            Just URI
u' | URI -> [Char]
uriScheme URI
u' [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"file:" ->
                 [Char] -> m (ByteString, Maybe Text)
forall {m :: * -> *}.
PandocMonad m =>
[Char] -> m (ByteString, Maybe Text)
readLocalFile ([Char] -> m (ByteString, Maybe Text))
-> [Char] -> m (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
uriPathToPath ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
uriPath URI
u')
            -- We don't want to treat C:/ as a scheme:
            Just URI
u' | [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (URI -> [Char]
uriScheme URI
u') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ URI -> [Char]
forall a. Show a => a -> [Char]
show URI
u')
            Maybe URI
_ -> [Char] -> m (ByteString, Maybe Text)
forall {m :: * -> *}.
PandocMonad m =>
[Char] -> m (ByteString, Maybe Text)
readLocalFile [Char]
fp -- get from local file system
   where readLocalFile :: [Char] -> m (ByteString, Maybe Text)
readLocalFile [Char]
f = do
             [[Char]]
resourcePath <- m [[Char]]
forall (m :: * -> *). PandocMonad m => m [[Char]]
getResourcePath
             ([Char]
fp', ByteString
cont) <- if [Char] -> Bool
isRelative [Char]
f
                               then [[Char]]
-> ([Char] -> m ByteString) -> [Char] -> m ([Char], ByteString)
forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [[Char]]
resourcePath [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
f
                               else ([Char]
f,) (ByteString -> ([Char], ByteString))
-> m ByteString -> m ([Char], ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict [Char]
f
             LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> LogMessage
LoadedResource [Char]
f ([Char] -> [Char] -> [Char]
makeRelative [Char]
"." [Char]
fp')
             (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
cont, Maybe Text
mime)
         httpcolon :: URI
httpcolon = URI :: [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
URI{ uriScheme :: [Char]
uriScheme = [Char]
"http:",
                          uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing,
                          uriPath :: [Char]
uriPath = [Char]
"",
                          uriQuery :: [Char]
uriQuery = [Char]
"",
                          uriFragment :: [Char]
uriFragment = [Char]
"" }
         dropFragmentAndQuery :: Text -> Text
dropFragmentAndQuery = (Char -> Bool) -> Text -> Text
T.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#')
         fp :: [Char]
fp = [Char] -> [Char]
unEscapeString ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text
dropFragmentAndQuery Text
s
         mime :: Maybe Text
mime = [Char] -> Maybe Text
getMimeType ([Char] -> Maybe Text) -> [Char] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ case [Char] -> [Char]
takeExtension [Char]
fp of
                     [Char]
".gz" -> [Char] -> [Char]
dropExtension [Char]
fp
                     [Char]
".svgz" -> [Char] -> [Char]
dropExtension [Char]
fp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".svg"
                     [Char]
x     -> [Char]
x
         ensureEscaped :: Text -> Text
ensureEscaped = [Char] -> Text
T.pack ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
escapeURIString Char -> Bool
isAllowedInURI ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
T.map Char -> Char
convertSlash
         convertSlash :: Char -> Char
convertSlash Char
'\\' = Char
'/'
         convertSlash Char
x    = Char
x

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

-- | Retrieve default reference.odt.
getDefaultReferenceODT :: PandocMonad m => m Archive
getDefaultReferenceODT :: forall (m :: * -> *). PandocMonad m => m Archive
getDefaultReferenceODT = do
  let paths :: [[Char]]
paths = [[Char]
"mimetype",
               [Char]
"manifest.rdf",
               [Char]
"styles.xml",
               [Char]
"content.xml",
               [Char]
"meta.xml",
               [Char]
"settings.xml",
               [Char]
"Configurations2/accelerator/current.xml",
               [Char]
"Thumbnails/thumbnail.png",
               [Char]
"META-INF/manifest.xml"]
  let pathToEntry :: [Char] -> m Entry
pathToEntry [Char]
path = do Integer
epochtime <- 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`
                                          [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDataFile ([Char]
"odt/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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
$ [Char] -> Integer -> ByteString -> Entry
toEntry [Char]
path Integer
epochtime ByteString
contents
  Maybe [Char]
datadir <- m (Maybe [Char])
forall (m :: * -> *). PandocMonad m => m (Maybe [Char])
getUserDataDir
  Maybe [Char]
mbArchive <- case Maybe [Char]
datadir of
                    Maybe [Char]
Nothing   -> Maybe [Char] -> m (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
                    Just [Char]
d    -> do
                       Bool
exists <- [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.odt")
                       if Bool
exists
                          then Maybe [Char] -> m (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
"reference.odt"))
                          else Maybe [Char] -> m (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
  case Maybe [Char]
mbArchive of
     Just [Char]
arch -> ByteString -> Archive
toArchive (ByteString -> Archive) -> m ByteString -> m Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy [Char]
arch
     Maybe [Char]
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
<$>
                     ([Char] -> m Entry) -> [[Char]] -> m [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> m Entry
forall {m :: * -> *}. PandocMonad m => [Char] -> m Entry
pathToEntry [[Char]]
paths

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

-- | Read file from from the default data files.
readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDefaultDataFile :: forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readDefaultDataFile [Char]
"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 [Char]
"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 [Char]
"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 [Char]
fname =
#ifdef EMBED_DATA_FILES
  case [Char] -> [([Char], ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([Char] -> [Char]
makeCanonical [Char]
fname) [([Char], ByteString)]
dataFiles of
    Maybe ByteString
Nothing       -> PandocError -> m ByteString
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
PandocCouldNotFindDataFileError (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
fname
    Just ByteString
contents -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
contents
#else
  getDataFileName fname' >>= checkExistence >>= readFileStrict
    where fname' = if fname == "MANUAL.txt" then fname else "data" </> fname

-- | Returns the input filename unchanged if the file exits, and throws
-- a `PandocCouldNotFindDataFileError` if it doesn't.
checkExistence :: PandocMonad m => FilePath -> m FilePath
checkExistence fn = do
  exists <- fileExists fn
  if exists
     then return fn
     else throwError $ PandocCouldNotFindDataFileError $ T.pack fn
#endif

-- | Canonicalizes a file path by removing redundant @.@ and @..@.
makeCanonical :: FilePath -> FilePath
makeCanonical :: [Char] -> [Char]
makeCanonical = [[Char]] -> [Char]
Posix.joinPath ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
transformPathParts ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories
 where  transformPathParts :: [[Char]] -> [[Char]]
transformPathParts = [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [Char] -> [[Char]])
-> [[Char]] -> [[Char]] -> [[Char]]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [[Char]] -> [Char] -> [[Char]]
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 :: forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [] [Char] -> m a
_ [Char]
fp = PandocError -> m ([Char], a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m ([Char], a)) -> PandocError -> m ([Char], a)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
fp
withPaths ([Char]
p:[[Char]]
ps) [Char] -> m a
action [Char]
fp =
  m ([Char], a) -> (PandocError -> m ([Char], a)) -> m ([Char], a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (([Char]
p [Char] -> [Char] -> [Char]
</> [Char]
fp,) (a -> ([Char], a)) -> m a -> m ([Char], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> m a
action ([Char]
p [Char] -> [Char] -> [Char]
</> [Char]
fp))
             (\PandocError
_ -> [[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
forall (m :: * -> *) a.
PandocMonad m =>
[[Char]] -> ([Char] -> m a) -> [Char] -> m ([Char], a)
withPaths [[Char]]
ps [Char] -> m a
action [Char]
fp)

-- | 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
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 e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
          (do MediaBag
mediabag <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
              let fp :: [Char]
fp = Text -> [Char]
T.unpack Text
src
              case [Char] -> MediaBag -> Maybe MediaItem
lookupMedia [Char]
fp MediaBag
mediabag of
                Just MediaItem
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe MediaItem
Nothing -> do
                  (ByteString
bs, Maybe Text
mt) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
                  [Char] -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
[Char] -> Maybe Text -> ByteString -> m ()
insertMedia [Char]
fp Maybe Text
mt (ByteString -> ByteString
BL.fromStrict ByteString
bs)
              Inline -> m Inline
forall (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
                            ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ HttpException -> [Char]
forall a. Show a => a -> [Char]
show HttpException
er [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\rReplacing image with description.")
                  -- emit alt text
                  Inline -> m Inline
forall (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 :: [Char] -> 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)
-> ([Char] -> m ByteString) -> [Char] -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy
  readFileStrict :: [Char] -> t m ByteString
readFileStrict = m ByteString -> t m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString)
-> ([Char] -> m ByteString) -> [Char] -> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict
  readStdinStrict :: t m ByteString
readStdinStrict = m ByteString -> t m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). PandocMonad m => m ByteString
readStdinStrict
  glob :: [Char] -> t m [[Char]]
glob = m [[Char]] -> t m [[Char]]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [[Char]] -> t m [[Char]])
-> ([Char] -> m [[Char]]) -> [Char] -> t m [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [[Char]]
forall (m :: * -> *). PandocMonad m => [Char] -> m [[Char]]
glob
  fileExists :: [Char] -> t m Bool
fileExists = m Bool -> t m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> t m Bool) -> ([Char] -> m Bool) -> [Char] -> t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists
  getDataFileName :: [Char] -> t m [Char]
getDataFileName = m [Char] -> t m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Char] -> t m [Char])
-> ([Char] -> m [Char]) -> [Char] -> t m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
getDataFileName
  getModificationTime :: [Char] -> t m UTCTime
getModificationTime = m UTCTime -> t m UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> t m UTCTime)
-> ([Char] -> m UTCTime) -> [Char] -> t m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m UTCTime
forall (m :: * -> *). PandocMonad m => [Char] -> m UTCTime
getModificationTime
  getCommonState :: t m CommonState
getCommonState = m CommonState -> t m CommonState
forall (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 :: [Char] -> 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)
-> ([Char] -> m ByteString) -> [Char] -> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileLazy
  readFileStrict :: [Char] -> ParsecT s st m ByteString
readFileStrict = m ByteString -> ParsecT s st m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ParsecT s st m ByteString)
-> ([Char] -> m ByteString) -> [Char] -> ParsecT s st m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m ByteString
forall (m :: * -> *). PandocMonad m => [Char] -> m ByteString
readFileStrict
  readStdinStrict :: ParsecT s st m ByteString
readStdinStrict = m ByteString -> ParsecT s st m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
forall (m :: * -> *). PandocMonad m => m ByteString
readStdinStrict
  glob :: [Char] -> ParsecT s st m [[Char]]
glob = m [[Char]] -> ParsecT s st m [[Char]]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [[Char]] -> ParsecT s st m [[Char]])
-> ([Char] -> m [[Char]]) -> [Char] -> ParsecT s st m [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [[Char]]
forall (m :: * -> *). PandocMonad m => [Char] -> m [[Char]]
glob
  fileExists :: [Char] -> ParsecT s st m Bool
fileExists = m Bool -> ParsecT s st m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ParsecT s st m Bool)
-> ([Char] -> m Bool) -> [Char] -> ParsecT s st m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m Bool
forall (m :: * -> *). PandocMonad m => [Char] -> m Bool
fileExists
  getDataFileName :: [Char] -> ParsecT s st m [Char]
getDataFileName = m [Char] -> ParsecT s st m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Char] -> ParsecT s st m [Char])
-> ([Char] -> m [Char]) -> [Char] -> ParsecT s st m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). PandocMonad m => [Char] -> m [Char]
getDataFileName
  getModificationTime :: [Char] -> ParsecT s st m UTCTime
getModificationTime = m UTCTime -> ParsecT s st m UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> ParsecT s st m UTCTime)
-> ([Char] -> m UTCTime) -> [Char] -> ParsecT s st m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m UTCTime
forall (m :: * -> *). PandocMonad m => [Char] -> m UTCTime
getModificationTime
  getCommonState :: ParsecT s st m CommonState
getCommonState = m CommonState -> ParsecT s st m CommonState
forall (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
      [Char] -> ParsecT s st m () -> ParsecT s st m ()
forall a. [Char] -> a -> a
Debug.Trace.trace
        ([Char]
"[trace] Parsed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" at line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            Int -> [Char]
forall a. Show a => a -> [Char]
show (SourcePos -> Int
sourceLine SourcePos
pos) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            if SourcePos -> [Char]
sourceName SourcePos
pos [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"chunk"
               then [Char]
" of chunk"
               else [Char]
"")
        (() -> ParsecT s st m ()
forall (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