{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{- |
   Module      : Text.Pandoc.Class
   Copyright   : Copyright (C) 2016-17 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. A pure instance 'PandocPure' and an impure instance
'PandocIO' are provided.  This allows users of the library to choose
whether they want conversions to perform IO operations (such as
reading include files or images).
-}

module Text.Pandoc.Class ( PandocMonad(..)
                         , CommonState(..)
                         , PureState(..)
                         , getPureState
                         , getsPureState
                         , putPureState
                         , modifyPureState
                         , getPOSIXTime
                         , getZonedTime
                         , readFileFromDirs
                         , report
                         , setTrace
                         , setRequestHeader
                         , getLog
                         , setVerbosity
                         , getVerbosity
                         , getMediaBag
                         , setMediaBag
                         , insertMedia
                         , setUserDataDir
                         , getUserDataDir
                         , fetchItem
                         , getInputFiles
                         , setInputFiles
                         , getOutputFile
                         , setOutputFile
                         , setResourcePath
                         , getResourcePath
                         , PandocIO(..)
                         , PandocPure(..)
                         , FileTree
                         , FileInfo(..)
                         , addToFileTree
                         , insertInFileTree
                         , runIO
                         , runIOorExplode
                         , runPure
                         , readDefaultDataFile
                         , readDataFile
                         , fetchMediaResource
                         , fillMediaBag
                         , extractMedia
                         , toLang
                         , setTranslations
                         , translateTerm
                         , Translations
                         ) where

import Prelude
import System.Random (StdGen, next, mkStdGen)
import qualified System.Random as IO (newStdGen)
import Codec.Archive.Zip
import qualified Data.CaseInsensitive as CI
import Data.Unique (hashUnique)
import qualified Data.Unique as IO (newUnique)
import qualified Text.Pandoc.UTF8 as UTF8
import qualified System.Directory as Directory
import Data.Time (UTCTime)
import Text.Pandoc.Logging
import Text.Pandoc.Shared (uriPathToPath)
import Text.Parsec (ParsecT, getPosition, sourceLine, sourceName)
import qualified Data.Time as IO (getCurrentTime)
import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
import Text.Pandoc.Definition
import Text.DocTemplates (TemplateMonad(..))
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Maybe (fromMaybe)
import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds
                             , posixSecondsToUTCTime
                             , POSIXTime )
import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime, utc)
import Data.ByteString.Base64 (decodeLenient)
import Network.URI ( escapeURIString, nonStrictRelativeTo,
                     unEscapeString, parseURIReference, isAllowedInURI,
                     parseURI, URI(..) )
import Network.HTTP.Client
       (httpLbs, responseBody, responseHeaders,
        Request(port, host, requestHeaders), parseRequest, newManager)
import Network.HTTP.Client.Internal (addProxy)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Environment (getEnv)
import Network.HTTP.Types.Header ( hContentType )
import Network.Socket (withSocketsDo)
import Data.ByteString.Lazy (toChunks)
import qualified Control.Exception as E
import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)
import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)
import Text.Pandoc.Walk (walkM, walk)
import qualified Text.Pandoc.MediaBag as MB
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified System.Environment as IO (lookupEnv)
import System.FilePath.Glob (match, compile)
import System.Directory (createDirectoryIfMissing, getDirectoryContents,
                          doesDirectoryExist)
import System.FilePath
       ((</>), (<.>), takeDirectory, takeExtension, dropExtension,
        isRelative, normalise, splitDirectories)
import qualified System.FilePath.Glob as IO (glob)
import qualified System.FilePath.Posix as Posix
import qualified System.Directory as IO (getModificationTime)
import Control.Monad.State.Strict
import Control.Monad.Except
import Data.Word (Word8)
import Data.Default
import System.IO.Error
import System.IO (stderr)
import qualified Data.Map as M
import qualified Data.Text as T
import Text.Pandoc.Error
import Text.Pandoc.BCP47 (Lang(..), parseBCP47, renderLang)
import Text.Pandoc.Translations (Term(..), Translations, lookupTerm,
                                 readTranslations)
import qualified Debug.Trace
#ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles)
#else
import qualified Paths_pandoc as Paths
#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 f :: 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 f :: 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 msg :: 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 ("[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
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
$ \st :: 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 accomulated 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 msg :: 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
$ \st :: CommonState
st -> CommonState
st{ stLog :: [LogMessage]
stLog = LogMessage
msg LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
: CommonState -> [LogMessage]
stLog CommonState
st }

-- | Determine whether tracing is enabled.  This affects
-- the behavior of 'trace'.  If tracing is not enabled,
-- 'trace' does nothing.
setTrace :: PandocMonad m => Bool -> m ()
setTrace :: Bool -> m ()
setTrace useTracing :: 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
$ \st :: 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 name :: Text
name val :: 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
$ \st :: 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 (\(n :: Text
n,_) -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name) (CommonState -> [(Text, Text)]
stRequestHeaders CommonState
st)  }

-- | Initialize the media bag.
setMediaBag :: PandocMonad m => MediaBag -> m ()
setMediaBag :: MediaBag -> m ()
setMediaBag mb :: 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
$ \st :: 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 fp :: String
fp mime :: Maybe Text
mime bs :: 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 fs :: [String]
fs = do
  let sourceURL :: Maybe String
sourceURL = case [String]
fs of
                    []    -> Maybe String
forall a. Maybe a
Nothing
                    (x :: String
x:_) -> case String -> Maybe URI
parseURI String
x of
                                Just u :: URI
u
                                  | URI -> String
uriScheme URI
u String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["http:","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 = "",
                                                     uriFragment :: String
uriFragment = "" }
                                _ -> 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
$ \st :: 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 mbf :: 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
$ \st :: 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 ps :: [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
$ \st :: 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 [] _ = Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
readFileFromDirs (d :: String
d:ds :: [String]
ds) f :: 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))
    (\_ -> [String] -> String -> m (Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
[String] -> String -> m (Maybe Text)
readFileFromDirs [String]
ds String
f)

instance TemplateMonad PandocIO where
  getPartial :: String -> PandocIO Text
getPartial fp :: String
fp = ByteString -> Text
UTF8.toText (ByteString -> Text) -> PandocIO ByteString -> PandocIO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PandocIO ByteString
-> (PandocError -> PandocIO ByteString) -> PandocIO ByteString
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
                      (String -> PandocIO ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict String
fp)
                      (\_ -> String -> PandocIO ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile ("templates" String -> String -> String
</> String
fp))

instance TemplateMonad PandocPure where
  getPartial :: String -> PandocPure Text
getPartial fp :: String
fp = ByteString -> Text
UTF8.toText (ByteString -> Text) -> PandocPure ByteString -> PandocPure Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PandocPure ByteString
-> (PandocError -> PandocPure ByteString) -> PandocPure ByteString
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
                      (String -> PandocPure ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict String
fp)
                      (\_ -> String -> PandocPure ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile ("templates" String -> String -> String
</> String
fp))

-- | 'CommonState' represents state that is used by all
-- instances of 'PandocMonad'.  Normally users should not
-- need to interact with it directly; instead, auxiliary
-- functions like 'setVerbosity' and 'withMediaBag' should be used.
data CommonState = CommonState { CommonState -> [LogMessage]
stLog          :: [LogMessage]
                                 -- ^ A list of log messages in reverse order
                               , CommonState -> Maybe String
stUserDataDir  :: Maybe FilePath
                                 -- ^ Directory to search for data files
                               , CommonState -> Maybe Text
stSourceURL    :: Maybe T.Text
                                 -- ^ Absolute URL + dir of 1st source file
                               , CommonState -> [(Text, Text)]
stRequestHeaders :: [(T.Text, T.Text)]
                                 -- ^ Headers to add for HTTP requests
                               , CommonState -> MediaBag
stMediaBag     :: MediaBag
                                 -- ^ Media parsed from binary containers
                               , CommonState -> Maybe (Lang, Maybe Translations)
stTranslations :: Maybe
                                                  (Lang, Maybe Translations)
                                 -- ^ Translations for localization
                               , CommonState -> [String]
stInputFiles   :: [FilePath]
                                 -- ^ List of input files from command line
                               , CommonState -> Maybe String
stOutputFile   :: Maybe FilePath
                                 -- ^ Output file from command line
                               , CommonState -> [String]
stResourcePath :: [FilePath]
                                 -- ^ Path to search for resources like
                                 -- included images
                               , CommonState -> Verbosity
stVerbosity    :: Verbosity
                                 -- ^ Verbosity level
                               , CommonState -> Bool
stTrace        :: Bool
                                 -- ^ Controls whether tracing messages are
                                 -- issued.
                               }

instance Default CommonState where
  def :: CommonState
def = CommonState :: [LogMessage]
-> Maybe String
-> Maybe Text
-> [(Text, Text)]
-> MediaBag
-> Maybe (Lang, Maybe Translations)
-> [String]
-> Maybe String
-> [String]
-> Verbosity
-> Bool
-> CommonState
CommonState { stLog :: [LogMessage]
stLog = []
                    , stUserDataDir :: Maybe String
stUserDataDir = Maybe String
forall a. Maybe a
Nothing
                    , stSourceURL :: Maybe Text
stSourceURL = Maybe Text
forall a. Maybe a
Nothing
                    , stRequestHeaders :: [(Text, Text)]
stRequestHeaders = []
                    , stMediaBag :: MediaBag
stMediaBag = MediaBag
forall a. Monoid a => a
mempty
                    , stTranslations :: Maybe (Lang, Maybe Translations)
stTranslations = Maybe (Lang, Maybe Translations)
forall a. Maybe a
Nothing
                    , stInputFiles :: [String]
stInputFiles = []
                    , stOutputFile :: Maybe String
stOutputFile = Maybe String
forall a. Maybe a
Nothing
                    , stResourcePath :: [String]
stResourcePath = ["."]
                    , stVerbosity :: Verbosity
stVerbosity = Verbosity
WARNING
                    , stTrace :: Bool
stTrace = Bool
False
                    }

-- | 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 Nothing = Maybe Lang -> m (Maybe Lang)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Lang
forall a. Maybe a
Nothing
toLang (Just s :: Text
s) =
  case Text -> Either Text Lang
parseBCP47 Text
s of
       Left _ -> 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 l :: 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
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
$ \st :: 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
       Nothing -> Translations -> m Translations
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
forall a. Monoid a => a
mempty  -- no language defined
       Just (_, Just t :: Translations
t) -> Translations -> m Translations
forall (m :: * -> *) a. Monad m => a -> m a
return Translations
t
       Just (lang :: Lang
lang, Nothing) -> do  -- read from file
         let translationFile :: Text
translationFile = "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
<> ".yaml"
         let fallbackFile :: Text
fallbackFile = "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
<> ".yaml"
         let getTrans :: String -> m Translations
getTrans fp :: 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 e :: 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
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
$ \st :: 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 t :: 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
$ \st :: 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)
           (\_ ->
             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)
               (\e :: 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 _ ->
                                 "data file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fallbackFile Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " not found"
                               _ -> ""
                 -- 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
$ \st :: 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
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 s :: Text
s -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
       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 ""

-- | Evaluate a 'PandocIO' operation.
runIO :: PandocIO a -> IO (Either PandocError a)
runIO :: PandocIO a -> IO (Either PandocError a)
runIO ma :: PandocIO a
ma = (StateT CommonState IO (Either PandocError a)
 -> CommonState -> IO (Either PandocError a))
-> CommonState
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CommonState IO (Either PandocError a)
-> CommonState -> IO (Either PandocError a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CommonState
forall a. Default a => a
def (StateT CommonState IO (Either PandocError a)
 -> IO (Either PandocError a))
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PandocError (StateT CommonState IO) a
 -> StateT CommonState IO (Either PandocError a))
-> ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
forall a.
PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
unPandocIO PandocIO a
ma

-- | Evaluate a 'PandocIO' operation, handling any errors
-- by exiting with an appropriate message and error status.
runIOorExplode :: PandocIO a -> IO a
runIOorExplode :: PandocIO a -> IO a
runIOorExplode ma :: PandocIO a
ma = PandocIO a -> IO (Either PandocError a)
forall a. PandocIO a -> IO (Either PandocError a)
runIO PandocIO a
ma IO (Either PandocError a) -> (Either PandocError a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either PandocError a -> IO a
forall a. Either PandocError a -> IO a
handleError

newtype PandocIO a = PandocIO {
  PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
unPandocIO :: ExceptT PandocError (StateT CommonState IO) a
  } deriving ( Monad PandocIO
Monad PandocIO =>
(forall a. IO a -> PandocIO a) -> MonadIO PandocIO
IO a -> PandocIO a
forall a. IO a -> PandocIO a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> PandocIO a
$cliftIO :: forall a. IO a -> PandocIO a
$cp1MonadIO :: Monad PandocIO
MonadIO
             , a -> PandocIO b -> PandocIO a
(a -> b) -> PandocIO a -> PandocIO b
(forall a b. (a -> b) -> PandocIO a -> PandocIO b)
-> (forall a b. a -> PandocIO b -> PandocIO a) -> Functor PandocIO
forall a b. a -> PandocIO b -> PandocIO a
forall a b. (a -> b) -> PandocIO a -> PandocIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PandocIO b -> PandocIO a
$c<$ :: forall a b. a -> PandocIO b -> PandocIO a
fmap :: (a -> b) -> PandocIO a -> PandocIO b
$cfmap :: forall a b. (a -> b) -> PandocIO a -> PandocIO b
Functor
             , Functor PandocIO
a -> PandocIO a
Functor PandocIO =>
(forall a. a -> PandocIO a)
-> (forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b)
-> (forall a b c.
    (a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO b)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO a)
-> Applicative PandocIO
PandocIO a -> PandocIO b -> PandocIO b
PandocIO a -> PandocIO b -> PandocIO a
PandocIO (a -> b) -> PandocIO a -> PandocIO b
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
forall a. a -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO b
forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b
forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PandocIO a -> PandocIO b -> PandocIO a
$c<* :: forall a b. PandocIO a -> PandocIO b -> PandocIO a
*> :: PandocIO a -> PandocIO b -> PandocIO b
$c*> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
liftA2 :: (a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
$cliftA2 :: forall a b c.
(a -> b -> c) -> PandocIO a -> PandocIO b -> PandocIO c
<*> :: PandocIO (a -> b) -> PandocIO a -> PandocIO b
$c<*> :: forall a b. PandocIO (a -> b) -> PandocIO a -> PandocIO b
pure :: a -> PandocIO a
$cpure :: forall a. a -> PandocIO a
$cp1Applicative :: Functor PandocIO
Applicative
             , Applicative PandocIO
a -> PandocIO a
Applicative PandocIO =>
(forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b)
-> (forall a b. PandocIO a -> PandocIO b -> PandocIO b)
-> (forall a. a -> PandocIO a)
-> Monad PandocIO
PandocIO a -> (a -> PandocIO b) -> PandocIO b
PandocIO a -> PandocIO b -> PandocIO b
forall a. a -> PandocIO a
forall a b. PandocIO a -> PandocIO b -> PandocIO b
forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PandocIO a
$creturn :: forall a. a -> PandocIO a
>> :: PandocIO a -> PandocIO b -> PandocIO b
$c>> :: forall a b. PandocIO a -> PandocIO b -> PandocIO b
>>= :: PandocIO a -> (a -> PandocIO b) -> PandocIO b
$c>>= :: forall a b. PandocIO a -> (a -> PandocIO b) -> PandocIO b
$cp1Monad :: Applicative PandocIO
Monad
             , MonadError PandocError
             )

-- | Utility function to lift IO errors into 'PandocError's.
liftIOError :: (String -> IO a) -> String -> PandocIO a
liftIOError :: (String -> IO a) -> String -> PandocIO a
liftIOError f :: String -> IO a
f u :: String
u = do
  Either IOError a
res <- IO (Either IOError a) -> PandocIO (Either IOError a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError a) -> PandocIO (Either IOError a))
-> IO (Either IOError a) -> PandocIO (Either IOError a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
tryIOError (IO a -> IO (Either IOError a)) -> IO a -> IO (Either IOError a)
forall a b. (a -> b) -> a -> b
$ String -> IO a
f String
u
  case Either IOError a
res of
         Left e :: IOError
e  -> PandocError -> PandocIO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocIO a) -> PandocError -> PandocIO a
forall a b. (a -> b) -> a -> b
$ Text -> IOError -> PandocError
PandocIOError (String -> Text
T.pack String
u) IOError
e
         Right r :: a
r -> a -> PandocIO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Show potential IO errors to the user continuing execution anyway
logIOError :: IO () -> PandocIO ()
logIOError :: IO () -> PandocIO ()
logIOError f :: IO ()
f = do
  Either IOError ()
res <- IO (Either IOError ()) -> PandocIO (Either IOError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError ()) -> PandocIO (Either IOError ()))
-> IO (Either IOError ()) -> PandocIO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIOError IO ()
f
  case Either IOError ()
res of
    Left e :: IOError
e -> LogMessage -> PandocIO ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> PandocIO ()) -> LogMessage -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
IgnoredIOError (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
$ IOError -> String
forall e. Exception e => e -> String
E.displayException IOError
e
    Right _ -> () -> PandocIO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance PandocMonad PandocIO where
  lookupEnv :: Text -> PandocIO (Maybe Text)
lookupEnv = (Maybe String -> Maybe Text)
-> PandocIO (Maybe String) -> PandocIO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) (PandocIO (Maybe String) -> PandocIO (Maybe Text))
-> (Text -> PandocIO (Maybe String))
-> Text
-> PandocIO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe String) -> PandocIO (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> PandocIO (Maybe String))
-> (Text -> IO (Maybe String)) -> Text -> PandocIO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
IO.lookupEnv (String -> IO (Maybe String))
-> (Text -> String) -> Text -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  getCurrentTime :: PandocIO UTCTime
getCurrentTime = IO UTCTime -> PandocIO UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
IO.getCurrentTime
  getCurrentTimeZone :: PandocIO TimeZone
getCurrentTimeZone = IO TimeZone -> PandocIO TimeZone
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO TimeZone
IO.getCurrentTimeZone
  newStdGen :: PandocIO StdGen
newStdGen = IO StdGen -> PandocIO StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
IO.newStdGen
  newUniqueHash :: PandocIO Int
newUniqueHash = Unique -> Int
hashUnique (Unique -> Int) -> PandocIO Unique -> PandocIO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique -> PandocIO Unique
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Unique
IO.newUnique

  openURL :: Text -> PandocIO (ByteString, Maybe Text)
openURL u :: Text
u
   | Just u'' :: Text
u'' <- Text -> Text -> Maybe Text
T.stripPrefix "data:" Text
u = do
       let mime :: Text
mime     = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=',') Text
u''
       let contents :: ByteString
contents = String -> ByteString
UTF8.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
                       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
$ Int -> Text -> Text
T.drop 1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=',') Text
u''
       (ByteString, Maybe Text) -> PandocIO (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
decodeLenient ByteString
contents, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mime)
   | Bool
otherwise = do
       let toReqHeader :: (Text, Text) -> (CI ByteString, ByteString)
toReqHeader (n :: Text
n, v :: Text
v) = (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
UTF8.fromText Text
n), Text -> ByteString
UTF8.fromText Text
v)
       [(CI ByteString, ByteString)]
customHeaders <- ((Text, Text) -> (CI ByteString, ByteString))
-> [(Text, Text)] -> [(CI ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (CI ByteString, ByteString)
toReqHeader ([(Text, Text)] -> [(CI ByteString, ByteString)])
-> PandocIO [(Text, Text)]
-> PandocIO [(CI ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CommonState -> [(Text, Text)]) -> PandocIO [(Text, Text)]
forall (m :: * -> *) a. PandocMonad m => (CommonState -> a) -> m a
getsCommonState CommonState -> [(Text, Text)]
stRequestHeaders
       LogMessage -> PandocIO ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> PandocIO ()) -> LogMessage -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
Fetching Text
u
       Either HttpException (ByteString, Maybe Text)
res <- IO (Either HttpException (ByteString, Maybe Text))
-> PandocIO (Either HttpException (ByteString, Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException (ByteString, Maybe Text))
 -> PandocIO (Either HttpException (ByteString, Maybe Text)))
-> IO (Either HttpException (ByteString, Maybe Text))
-> PandocIO (Either HttpException (ByteString, Maybe Text))
forall a b. (a -> b) -> a -> b
$ IO (ByteString, Maybe Text)
-> IO (Either HttpException (ByteString, Maybe Text))
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO (ByteString, Maybe Text)
 -> IO (Either HttpException (ByteString, Maybe Text)))
-> IO (ByteString, Maybe Text)
-> IO (Either HttpException (ByteString, Maybe Text))
forall a b. (a -> b) -> a -> b
$ IO (ByteString, Maybe Text) -> IO (ByteString, Maybe Text)
forall a. IO a -> IO a
withSocketsDo (IO (ByteString, Maybe Text) -> IO (ByteString, Maybe Text))
-> IO (ByteString, Maybe Text) -> IO (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
         let parseReq :: String -> IO Request
parseReq = String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest
         Either IOError String
proxy <- IO String -> IO (Either IOError String)
forall a. IO a -> IO (Either IOError a)
tryIOError (String -> IO String
getEnv "http_proxy")
         let addProxy' :: Request -> IO Request
addProxy' x :: Request
x = case Either IOError String
proxy of
                              Left _ -> Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
x
                              Right pr :: String
pr -> String -> IO Request
parseReq String
pr IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: Request
r ->
                                  Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Int -> Request -> Request
addProxy (Request -> ByteString
host Request
r) (Request -> Int
port Request
r) Request
x)
         Request
req <- String -> IO Request
parseReq (Text -> String
T.unpack Text
u) IO Request -> (Request -> IO Request) -> IO Request
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO Request
addProxy'
         let req' :: Request
req' = Request
req{requestHeaders :: [(CI ByteString, ByteString)]
requestHeaders = [(CI ByteString, ByteString)]
customHeaders [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++ Request -> [(CI ByteString, ByteString)]
requestHeaders Request
req}
         Response ByteString
resp <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings IO Manager
-> (Manager -> IO (Response ByteString))
-> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> Manager -> IO (Response ByteString)
httpLbs Request
req'
         (ByteString, Maybe Text) -> IO (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp,
                 ByteString -> Text
UTF8.toText (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
hContentType (Response ByteString -> [(CI ByteString, ByteString)]
forall body. Response body -> [(CI ByteString, ByteString)]
responseHeaders Response ByteString
resp))

       case Either HttpException (ByteString, Maybe Text)
res of
            Right r :: (ByteString, Maybe Text)
r -> (ByteString, Maybe Text) -> PandocIO (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString, Maybe Text)
r
            Left e :: HttpException
e  -> PandocError -> PandocIO (ByteString, Maybe Text)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocIO (ByteString, Maybe Text))
-> PandocError -> PandocIO (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> HttpException -> PandocError
PandocHttpError Text
u HttpException
e

  readFileLazy :: String -> PandocIO ByteString
readFileLazy s :: String
s = (String -> IO ByteString) -> String -> PandocIO ByteString
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO ByteString
BL.readFile String
s
  readFileStrict :: String -> PandocIO ByteString
readFileStrict s :: String
s = (String -> IO ByteString) -> String -> PandocIO ByteString
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO ByteString
B.readFile String
s

  glob :: String -> PandocIO [String]
glob = (String -> IO [String]) -> String -> PandocIO [String]
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO [String]
IO.glob
  fileExists :: String -> PandocIO Bool
fileExists = (String -> IO Bool) -> String -> PandocIO Bool
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO Bool
Directory.doesFileExist
#ifdef EMBED_DATA_FILES
  getDataFileName = return
#else
  getDataFileName :: String -> PandocIO String
getDataFileName = (String -> IO String) -> String -> PandocIO String
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO String
Paths.getDataFileName
#endif
  getModificationTime :: String -> PandocIO UTCTime
getModificationTime = (String -> IO UTCTime) -> String -> PandocIO UTCTime
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError String -> IO UTCTime
IO.getModificationTime
  getCommonState :: PandocIO CommonState
getCommonState = ExceptT PandocError (StateT CommonState IO) CommonState
-> PandocIO CommonState
forall a.
ExceptT PandocError (StateT CommonState IO) a -> PandocIO a
PandocIO (ExceptT PandocError (StateT CommonState IO) CommonState
 -> PandocIO CommonState)
-> ExceptT PandocError (StateT CommonState IO) CommonState
-> PandocIO CommonState
forall a b. (a -> b) -> a -> b
$ StateT CommonState IO CommonState
-> ExceptT PandocError (StateT CommonState IO) CommonState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT CommonState IO CommonState
forall s (m :: * -> *). MonadState s m => m s
get
  putCommonState :: CommonState -> PandocIO ()
putCommonState x :: CommonState
x = ExceptT PandocError (StateT CommonState IO) () -> PandocIO ()
forall a.
ExceptT PandocError (StateT CommonState IO) a -> PandocIO a
PandocIO (ExceptT PandocError (StateT CommonState IO) () -> PandocIO ())
-> ExceptT PandocError (StateT CommonState IO) () -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState IO ()
-> ExceptT PandocError (StateT CommonState IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState IO ()
 -> ExceptT PandocError (StateT CommonState IO) ())
-> StateT CommonState IO ()
-> ExceptT PandocError (StateT CommonState IO) ()
forall a b. (a -> b) -> a -> b
$ CommonState -> StateT CommonState IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CommonState
x
  logOutput :: LogMessage -> PandocIO ()
logOutput msg :: LogMessage
msg = IO () -> PandocIO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PandocIO ()) -> IO () -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> String -> IO ()
UTF8.hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        "[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Verbosity -> String
forall a. Show a => a -> String
show (LogMessage -> Verbosity
messageVerbosity LogMessage
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "] "
    [Text] -> IO ()
alertIndent ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ LogMessage -> Text
showLogMessage LogMessage
msg

alertIndent :: [T.Text] -> IO ()
alertIndent :: [Text] -> IO ()
alertIndent [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
alertIndent (l :: Text
l:ls :: [Text]
ls) = do
  Handle -> String -> IO ()
UTF8.hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
l
  (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
go [Text]
ls
  where go :: Text -> IO ()
go l' :: Text
l' = do Handle -> String -> IO ()
UTF8.hPutStr Handle
stderr "  "
                   Handle -> String -> IO ()
UTF8.hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
l'

-- | Specialized version of parseURIReference that disallows
-- single-letter schemes.  Reason:  these are usually windows absolute
-- paths.
parseURIReference' :: T.Text -> Maybe URI
parseURIReference' :: Text -> Maybe URI
parseURIReference' s :: Text
s =
  case String -> Maybe URI
parseURIReference (Text -> String
T.unpack Text
s) of
       Just u :: 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
> 2  -> URI -> Maybe URI
forall a. a -> Maybe a
Just URI
u
         | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriScheme URI
u)        -> URI -> Maybe URI
forall a. a -> Maybe a
Just URI
u  -- protocol-relative
       _                             -> Maybe URI
forall a. Maybe a
Nothing

-- | Set the user data directory in common state.
setUserDataDir :: PandocMonad m
               => Maybe FilePath
               -> m ()
setUserDataDir :: Maybe String -> m ()
setUserDataDir mbfp :: 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
$ \st :: 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 s :: Text
s = do
  MediaBag
mediabag <- m MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  case String -> MediaBag -> Maybe (Text, ByteString)
lookupMedia (Text -> String
T.unpack Text
s) MediaBag
mediabag of
    Just (mime :: Text
mime, bs :: ByteString
bs) -> (ByteString, Maybe Text) -> m (ByteString, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
BL.toStrict ByteString
bs, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mime)
    Nothing -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
downloadOrRead Text
s

downloadOrRead :: PandocMonad m
               => T.Text
               -> m (B.ByteString, Maybe MimeType)
downloadOrRead :: Text -> m (ByteString, Maybe Text)
downloadOrRead s :: 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 u :: URI
u, s' :: Text
s') -> -- try fetching from relative path at source
       case Text -> Maybe URI
parseURIReference' Text
s' of
            Just u' :: 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
            Nothing -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
s' -- will throw error
    (Nothing, s' :: Text
s'@(Text -> String
T.unpack -> ('/':'/':c :: Char
c:_))) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '?' ->  -- protocol-relative URI
                -- we exclude //? because of //?UNC/ on Windows
       case Text -> Maybe URI
parseURIReference' Text
s' of
            Just u' :: 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
            Nothing -> Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
openURL Text
s' -- will throw error
    (Nothing, s' :: Text
s') ->
       case String -> Maybe URI
parseURI (Text -> String
T.unpack Text
s') of  -- requires absolute URI
            Just u' :: URI
u' | URI -> String
uriScheme URI
u' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "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 u' :: 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
> 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')
            _ -> 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 f :: String
f = do
             [String]
resourcePath <- m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getResourcePath
             ByteString
cont <- if String -> Bool
isRelative String
f
                        then [String] -> (String -> m ByteString) -> String -> m ByteString
forall (m :: * -> *) a.
PandocMonad m =>
[String] -> (String -> m a) -> String -> m a
withPaths [String]
resourcePath String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict String
f
                        else String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readFileStrict String
f
             (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 = "http:",
                          uriAuthority :: Maybe URIAuth
uriAuthority = Maybe URIAuth
forall a. Maybe a
Nothing,
                          uriPath :: String
uriPath = "",
                          uriQuery :: String
uriQuery = "",
                          uriFragment :: String
uriFragment = "" }
         dropFragmentAndQuery :: Text -> Text
dropFragmentAndQuery = (Char -> Bool) -> Text -> Text
T.takeWhile (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '?' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '#')
         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 = case String -> String
takeExtension String
fp of
                     ".gz" -> String -> Maybe Text
getMimeType (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
fp
                     ".svgz" -> String -> Maybe Text
getMimeType (String -> Maybe Text) -> String -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
fp String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".svg"
                     x :: String
x     -> String -> Maybe Text
getMimeType 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 '\\' = '/'
         convertSlash x :: Char
x    = Char
x

-- Retrieve default reference.docx.
getDefaultReferenceDocx :: PandocMonad m => m Archive
getDefaultReferenceDocx :: m Archive
getDefaultReferenceDocx = do
  let paths :: [String]
paths = ["[Content_Types].xml",
               "_rels/.rels",
               "docProps/app.xml",
               "docProps/core.xml",
               "docProps/custom.xml",
               "word/document.xml",
               "word/fontTable.xml",
               "word/footnotes.xml",
               "word/comments.xml",
               "word/numbering.xml",
               "word/settings.xml",
               "word/webSettings.xml",
               "word/styles.xml",
               "word/_rels/document.xml.rels",
               "word/_rels/footnotes.xml.rels",
               "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 path :: 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 ("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
                    Nothing   -> Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    Just d :: String
d    -> do
                       Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists (String
d 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
</> "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 arch :: 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
     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 = ["mimetype",
               "manifest.rdf",
               "styles.xml",
               "content.xml",
               "meta.xml",
               "settings.xml",
               "Configurations2/accelerator/current.xml",
               "Thumbnails/thumbnail.png",
               "META-INF/manifest.xml"]
  let pathToEntry :: String -> m Entry
pathToEntry path :: 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 ("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
                    Nothing   -> Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    Just d :: String
d    -> do
                       Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists (String
d 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
</> "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 arch :: 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
     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

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 = [ "[Content_Types].xml"
              , "_rels/.rels"
              , "docProps/app.xml"
              , "docProps/core.xml"
              , "ppt/_rels/presentation.xml.rels"
              , "ppt/presProps.xml"
              , "ppt/presentation.xml"
              , "ppt/slideLayouts/_rels/slideLayout1.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout2.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout3.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout4.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout5.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout6.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout7.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout8.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout9.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout10.xml.rels"
              , "ppt/slideLayouts/_rels/slideLayout11.xml.rels"
              , "ppt/slideLayouts/slideLayout1.xml"
              , "ppt/slideLayouts/slideLayout10.xml"
              , "ppt/slideLayouts/slideLayout11.xml"
              , "ppt/slideLayouts/slideLayout2.xml"
              , "ppt/slideLayouts/slideLayout3.xml"
              , "ppt/slideLayouts/slideLayout4.xml"
              , "ppt/slideLayouts/slideLayout5.xml"
              , "ppt/slideLayouts/slideLayout6.xml"
              , "ppt/slideLayouts/slideLayout7.xml"
              , "ppt/slideLayouts/slideLayout8.xml"
              , "ppt/slideLayouts/slideLayout9.xml"
              , "ppt/slideMasters/_rels/slideMaster1.xml.rels"
              , "ppt/slideMasters/slideMaster1.xml"
              , "ppt/slides/_rels/slide1.xml.rels"
              , "ppt/slides/slide1.xml"
              , "ppt/slides/_rels/slide2.xml.rels"
              , "ppt/slides/slide2.xml"
              , "ppt/slides/_rels/slide3.xml.rels"
              , "ppt/slides/slide3.xml"
              , "ppt/slides/_rels/slide4.xml.rels"
              , "ppt/slides/slide4.xml"
              , "ppt/tableStyles.xml"
              , "ppt/theme/theme1.xml"
              , "ppt/viewProps.xml"
              -- These relate to notes slides.
              , "ppt/notesMasters/notesMaster1.xml"
              , "ppt/notesMasters/_rels/notesMaster1.xml.rels"
              , "ppt/notesSlides/notesSlide1.xml"
              , "ppt/notesSlides/_rels/notesSlide1.xml.rels"
              , "ppt/notesSlides/notesSlide2.xml"
              , "ppt/notesSlides/_rels/notesSlide2.xml.rels"
              , "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 path :: 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 ("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
                    Nothing   -> Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                    Just d :: String
d    -> do
                       Bool
exists <- String -> m Bool
forall (m :: * -> *). PandocMonad m => String -> m Bool
fileExists (String
d 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
</> "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 arch :: 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
     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 Cabal data directory.
readDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDataFile :: String -> m ByteString
readDataFile fname :: String
fname = do
  Maybe String
datadir <- m (Maybe String)
forall (m :: * -> *). PandocMonad m => m (Maybe String)
getUserDataDir
  case Maybe String
datadir of
       Nothing -> String -> m ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDefaultDataFile String
fname
       Just userDir :: 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 Cabal data directory.
readDefaultDataFile :: PandocMonad m => FilePath -> m B.ByteString
readDefaultDataFile :: String -> m ByteString
readDefaultDataFile "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 "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 "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 fname :: 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
== "MANUAL.txt" then String
fname else "data" String -> String -> String
</> String
fname

checkExistence :: PandocMonad m => FilePath -> m FilePath
checkExistence :: String -> m String
checkExistence fn :: 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

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 as :: [a]
as     "."  = [a]
as
        go (_:as :: [a]
as) ".." = [a]
as
        go as :: [a]
as     x :: a
x    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as

withPaths :: PandocMonad m => [FilePath] -> (FilePath -> m a) -> FilePath -> m a
withPaths :: [String] -> (String -> m a) -> String -> m a
withPaths [] _ fp :: String
fp = PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m a) -> PandocError -> m 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 (p :: String
p:ps :: [String]
ps) action :: String -> m a
action fp :: String
fp =
  m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (String -> m a
action (String
p String -> String -> String
</> String
fp))
             (\_ -> [String] -> (String -> m a) -> String -> m a
forall (m :: * -> *) a.
PandocMonad m =>
[String] -> (String -> m a) -> String -> m a
withPaths [String]
ps String -> m a
action String
fp)

-- | Fetch local or remote resource (like an image) and provide data suitable
-- for adding it to the MediaBag.
fetchMediaResource :: PandocMonad m
              => T.Text -> m (FilePath, Maybe MimeType, BL.ByteString)
fetchMediaResource :: Text -> m (String, Maybe Text, ByteString)
fetchMediaResource src :: Text
src = do
  (bs :: ByteString
bs, mt :: Maybe Text
mt) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
downloadOrRead Text
src
  let ext :: Text
ext = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src)
                      (Maybe Text
mt Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Text
extensionFromMimeType)
  let bs' :: ByteString
bs' = [ByteString] -> ByteString
BL.fromChunks [ByteString
bs]
  let basename :: String
basename = Digest SHA1State -> String
forall t. Digest t -> String
showDigest (Digest SHA1State -> String) -> Digest SHA1State -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA1State
sha1 ByteString
bs'
  let fname :: String
fname = String
basename String -> String -> String
<.> Text -> String
T.unpack Text
ext
  (String, Maybe Text, ByteString)
-> m (String, Maybe Text, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
fname, Maybe Text
mt, ByteString
bs')

-- | 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 d :: 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
attr lab :: [Inline]
lab (src :: Text
src, tit :: 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
              case String -> MediaBag -> Maybe (Text, ByteString)
lookupMedia (Text -> String
T.unpack Text
src) MediaBag
mediabag of
                Just (_, _) -> 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)
                Nothing -> do
                  (fname :: String
fname, mt :: Maybe Text
mt, bs :: ByteString
bs) <- Text -> m (String, Maybe Text, ByteString)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (String, Maybe Text, ByteString)
fetchMediaResource Text
src
                  String -> Maybe Text -> ByteString -> m ()
forall (m :: * -> *).
PandocMonad m =>
String -> Maybe Text -> ByteString -> m ()
insertMedia String
fname Maybe Text
mt 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 (String -> Text
T.pack String
fname, Text
tit))
          (\e :: PandocError
e ->
              case PandocError
e of
                PandocResourceNotFound _ -> 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
                            "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 ("",["image"],[]) [Inline]
lab
                PandocHttpError u :: Text
u er :: 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]
++ "\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 ("",["image"],[]) [Inline]
lab
                _ -> PandocError -> m Inline
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e)
        handleImage x :: Inline
x = Inline -> m Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x

-- | Extract media from the mediabag into a directory.
extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc
extractMedia :: String -> Pandoc -> PandocIO Pandoc
extractMedia dir :: String
dir d :: Pandoc
d = do
  MediaBag
media <- PandocIO MediaBag
forall (m :: * -> *). PandocMonad m => m MediaBag
getMediaBag
  case [String
fp | (fp :: String
fp, _, _) <- MediaBag -> [(String, Text, Int)]
mediaDirectory MediaBag
media] of
        []  -> Pandoc -> PandocIO Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
d
        fps :: [String]
fps -> do
          (String -> PandocIO ()) -> [String] -> PandocIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> MediaBag -> String -> PandocIO ()
writeMedia String
dir MediaBag
media) [String]
fps
          Pandoc -> PandocIO Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> PandocIO Pandoc) -> Pandoc -> PandocIO Pandoc
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk (String -> [String] -> Inline -> Inline
adjustImagePath String
dir [String]
fps) Pandoc
d

-- Write the contents of a media bag to a path.
writeMedia :: FilePath -> MediaBag -> FilePath -> PandocIO ()
writeMedia :: String -> MediaBag -> String -> PandocIO ()
writeMedia dir :: String
dir mediabag :: MediaBag
mediabag subpath :: String
subpath = do
  -- we join and split to convert a/b/c to a\b\c on Windows;
  -- in zip containers all paths use /
  let fullpath :: String
fullpath = String
dir String -> String -> String
</> String -> String
unEscapeString (String -> String
normalise String
subpath)
  let mbcontents :: Maybe (Text, ByteString)
mbcontents = String -> MediaBag -> Maybe (Text, ByteString)
lookupMedia String
subpath MediaBag
mediabag
  case Maybe (Text, ByteString)
mbcontents of
       Nothing -> PandocError -> PandocIO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocIO ()) -> PandocError -> PandocIO ()
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
subpath
       Just (_, bs :: ByteString
bs) -> do
         LogMessage -> PandocIO ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> PandocIO ()) -> LogMessage -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
Extracting (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
fullpath
         (String -> IO ()) -> String -> PandocIO ()
forall a. (String -> IO a) -> String -> PandocIO a
liftIOError (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True) (String -> String
takeDirectory String
fullpath)
         IO () -> PandocIO ()
logIOError (IO () -> PandocIO ()) -> IO () -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BL.writeFile String
fullpath ByteString
bs

adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline
adjustImagePath :: String -> [String] -> Inline -> Inline
adjustImagePath dir :: String
dir paths :: [String]
paths (Image attr :: Attr
attr lab :: [Inline]
lab (src :: Text
src, tit :: Text
tit))
   | Text -> String
T.unpack Text
src String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
paths = Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
lab (String -> Text
T.pack String
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src, Text
tit)
adjustImagePath _ _ x :: Inline
x = Inline
x

-- | The 'PureState' contains ersatz representations
-- of things that would normally be obtained through IO.
data PureState = PureState { PureState -> StdGen
stStdGen     :: StdGen
                           , PureState -> [Word8]
stWord8Store :: [Word8] -- should be
                                                     -- infinite,
                                                     -- i.e. [1..]
                           , PureState -> [Int]
stUniqStore  :: [Int] -- should be
                                                   -- infinite and
                                                   -- contain every
                                                   -- element at most
                                                   -- once, e.g. [1..]
                           , PureState -> [(Text, Text)]
stEnv :: [(T.Text, T.Text)]
                           , PureState -> UTCTime
stTime :: UTCTime
                           , PureState -> TimeZone
stTimeZone :: TimeZone
                           , PureState -> Archive
stReferenceDocx :: Archive
                           , PureState -> Archive
stReferencePptx :: Archive
                           , PureState -> Archive
stReferenceODT :: Archive
                           , PureState -> FileTree
stFiles :: FileTree
                           , PureState -> FileTree
stUserDataFiles :: FileTree
                           , PureState -> FileTree
stCabalDataFiles :: FileTree
                           }

instance Default PureState where
  def :: PureState
def = PureState :: StdGen
-> [Word8]
-> [Int]
-> [(Text, Text)]
-> UTCTime
-> TimeZone
-> Archive
-> Archive
-> Archive
-> FileTree
-> FileTree
-> FileTree
-> PureState
PureState { stStdGen :: StdGen
stStdGen = Int -> StdGen
mkStdGen 1848
                  , stWord8Store :: [Word8]
stWord8Store = [1..]
                  , stUniqStore :: [Int]
stUniqStore = [1..]
                  , stEnv :: [(Text, Text)]
stEnv = [("USER", "pandoc-user")]
                  , stTime :: UTCTime
stTime = POSIXTime -> UTCTime
posixSecondsToUTCTime 0
                  , stTimeZone :: TimeZone
stTimeZone = TimeZone
utc
                  , stReferenceDocx :: Archive
stReferenceDocx = Archive
emptyArchive
                  , stReferencePptx :: Archive
stReferencePptx = Archive
emptyArchive
                  , stReferenceODT :: Archive
stReferenceODT = Archive
emptyArchive
                  , stFiles :: FileTree
stFiles = FileTree
forall a. Monoid a => a
mempty
                  , stUserDataFiles :: FileTree
stUserDataFiles = FileTree
forall a. Monoid a => a
mempty
                  , stCabalDataFiles :: FileTree
stCabalDataFiles = FileTree
forall a. Monoid a => a
mempty
                  }


getPureState :: PandocPure PureState
getPureState :: PandocPure PureState
getPureState = ExceptT
  PandocError (StateT CommonState (State PureState)) PureState
-> PandocPure PureState
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT
   PandocError (StateT CommonState (State PureState)) PureState
 -> PandocPure PureState)
-> ExceptT
     PandocError (StateT CommonState (State PureState)) PureState
-> PandocPure PureState
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) PureState
-> ExceptT
     PandocError (StateT CommonState (State PureState)) PureState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) PureState
 -> ExceptT
      PandocError (StateT CommonState (State PureState)) PureState)
-> StateT CommonState (State PureState) PureState
-> ExceptT
     PandocError (StateT CommonState (State PureState)) PureState
forall a b. (a -> b) -> a -> b
$ State PureState PureState
-> StateT CommonState (State PureState) PureState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift State PureState PureState
forall s (m :: * -> *). MonadState s m => m s
get

getsPureState :: (PureState -> a) -> PandocPure a
getsPureState :: (PureState -> a) -> PandocPure a
getsPureState f :: PureState -> a
f = PureState -> a
f (PureState -> a) -> PandocPure PureState -> PandocPure a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PandocPure PureState
getPureState

putPureState :: PureState -> PandocPure ()
putPureState :: PureState -> PandocPure ()
putPureState ps :: PureState
ps= ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT PandocError (StateT CommonState (State PureState)) ()
 -> PandocPure ())
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) ()
 -> ExceptT PandocError (StateT CommonState (State PureState)) ())
-> StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall a b. (a -> b) -> a -> b
$ State PureState () -> StateT CommonState (State PureState) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State PureState () -> StateT CommonState (State PureState) ())
-> State PureState () -> StateT CommonState (State PureState) ()
forall a b. (a -> b) -> a -> b
$ PureState -> State PureState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PureState
ps

modifyPureState :: (PureState -> PureState) -> PandocPure ()
modifyPureState :: (PureState -> PureState) -> PandocPure ()
modifyPureState f :: PureState -> PureState
f = ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT PandocError (StateT CommonState (State PureState)) ()
 -> PandocPure ())
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) ()
 -> ExceptT PandocError (StateT CommonState (State PureState)) ())
-> StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall a b. (a -> b) -> a -> b
$ State PureState () -> StateT CommonState (State PureState) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State PureState () -> StateT CommonState (State PureState) ())
-> State PureState () -> StateT CommonState (State PureState) ()
forall a b. (a -> b) -> a -> b
$ (PureState -> PureState) -> State PureState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify PureState -> PureState
f


data FileInfo = FileInfo { FileInfo -> UTCTime
infoFileMTime :: UTCTime
                         , FileInfo -> ByteString
infoFileContents :: B.ByteString
                         }

newtype FileTree = FileTree {FileTree -> Map String FileInfo
unFileTree :: M.Map FilePath FileInfo}
  deriving (b -> FileTree -> FileTree
NonEmpty FileTree -> FileTree
FileTree -> FileTree -> FileTree
(FileTree -> FileTree -> FileTree)
-> (NonEmpty FileTree -> FileTree)
-> (forall b. Integral b => b -> FileTree -> FileTree)
-> Semigroup FileTree
forall b. Integral b => b -> FileTree -> FileTree
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FileTree -> FileTree
$cstimes :: forall b. Integral b => b -> FileTree -> FileTree
sconcat :: NonEmpty FileTree -> FileTree
$csconcat :: NonEmpty FileTree -> FileTree
<> :: FileTree -> FileTree -> FileTree
$c<> :: FileTree -> FileTree -> FileTree
Semigroup, Semigroup FileTree
FileTree
Semigroup FileTree =>
FileTree
-> (FileTree -> FileTree -> FileTree)
-> ([FileTree] -> FileTree)
-> Monoid FileTree
[FileTree] -> FileTree
FileTree -> FileTree -> FileTree
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [FileTree] -> FileTree
$cmconcat :: [FileTree] -> FileTree
mappend :: FileTree -> FileTree -> FileTree
$cmappend :: FileTree -> FileTree -> FileTree
mempty :: FileTree
$cmempty :: FileTree
$cp1Monoid :: Semigroup FileTree
Monoid)

getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
getFileInfo :: String -> FileTree -> Maybe FileInfo
getFileInfo fp :: String
fp tree :: FileTree
tree =
  String -> Map String FileInfo -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> String
makeCanonical String
fp) (FileTree -> Map String FileInfo
unFileTree FileTree
tree)

-- | Add the specified file to the FileTree. If file
-- is a directory, add its contents recursively.
addToFileTree :: FileTree -> FilePath -> IO FileTree
addToFileTree :: FileTree -> String -> IO FileTree
addToFileTree tree :: FileTree
tree fp :: String
fp = do
  Bool
isdir <- String -> IO Bool
doesDirectoryExist String
fp
  if Bool
isdir
     then do -- recursively add contents of directories
       let isSpecial :: a -> Bool
isSpecial ".." = Bool
True
           isSpecial "."  = Bool
True
           isSpecial _    = Bool
False
       [String]
fs <- ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
fp String -> String -> String
</>) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. (Eq a, IsString a) => a -> Bool
isSpecial)) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getDirectoryContents String
fp
       (FileTree -> String -> IO FileTree)
-> FileTree -> [String] -> IO FileTree
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM FileTree -> String -> IO FileTree
addToFileTree FileTree
tree [String]
fs
     else do
       ByteString
contents <- String -> IO ByteString
B.readFile String
fp
       UTCTime
mtime <- String -> IO UTCTime
IO.getModificationTime String
fp
       FileTree -> IO FileTree
forall (m :: * -> *) a. Monad m => a -> m a
return (FileTree -> IO FileTree) -> FileTree -> IO FileTree
forall a b. (a -> b) -> a -> b
$ String -> FileInfo -> FileTree -> FileTree
insertInFileTree String
fp FileInfo :: UTCTime -> ByteString -> FileInfo
FileInfo{ infoFileMTime :: UTCTime
infoFileMTime = UTCTime
mtime
                                            , infoFileContents :: ByteString
infoFileContents = ByteString
contents } FileTree
tree

-- | Insert an ersatz file into the 'FileTree'.
insertInFileTree :: FilePath -> FileInfo -> FileTree -> FileTree
insertInFileTree :: String -> FileInfo -> FileTree -> FileTree
insertInFileTree fp :: String
fp info :: FileInfo
info (FileTree treemap :: Map String FileInfo
treemap) =
  Map String FileInfo -> FileTree
FileTree (Map String FileInfo -> FileTree)
-> Map String FileInfo -> FileTree
forall a b. (a -> b) -> a -> b
$ String -> FileInfo -> Map String FileInfo -> Map String FileInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> String
makeCanonical String
fp) FileInfo
info Map String FileInfo
treemap

newtype PandocPure a = PandocPure {
  PandocPure a
-> ExceptT PandocError (StateT CommonState (State PureState)) a
unPandocPure :: ExceptT PandocError
                  (StateT CommonState (State PureState)) a
  } deriving ( a -> PandocPure b -> PandocPure a
(a -> b) -> PandocPure a -> PandocPure b
(forall a b. (a -> b) -> PandocPure a -> PandocPure b)
-> (forall a b. a -> PandocPure b -> PandocPure a)
-> Functor PandocPure
forall a b. a -> PandocPure b -> PandocPure a
forall a b. (a -> b) -> PandocPure a -> PandocPure b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PandocPure b -> PandocPure a
$c<$ :: forall a b. a -> PandocPure b -> PandocPure a
fmap :: (a -> b) -> PandocPure a -> PandocPure b
$cfmap :: forall a b. (a -> b) -> PandocPure a -> PandocPure b
Functor
             , Functor PandocPure
a -> PandocPure a
Functor PandocPure =>
(forall a. a -> PandocPure a)
-> (forall a b.
    PandocPure (a -> b) -> PandocPure a -> PandocPure b)
-> (forall a b c.
    (a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c)
-> (forall a b. PandocPure a -> PandocPure b -> PandocPure b)
-> (forall a b. PandocPure a -> PandocPure b -> PandocPure a)
-> Applicative PandocPure
PandocPure a -> PandocPure b -> PandocPure b
PandocPure a -> PandocPure b -> PandocPure a
PandocPure (a -> b) -> PandocPure a -> PandocPure b
(a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c
forall a. a -> PandocPure a
forall a b. PandocPure a -> PandocPure b -> PandocPure a
forall a b. PandocPure a -> PandocPure b -> PandocPure b
forall a b. PandocPure (a -> b) -> PandocPure a -> PandocPure b
forall a b c.
(a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PandocPure a -> PandocPure b -> PandocPure a
$c<* :: forall a b. PandocPure a -> PandocPure b -> PandocPure a
*> :: PandocPure a -> PandocPure b -> PandocPure b
$c*> :: forall a b. PandocPure a -> PandocPure b -> PandocPure b
liftA2 :: (a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c
$cliftA2 :: forall a b c.
(a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c
<*> :: PandocPure (a -> b) -> PandocPure a -> PandocPure b
$c<*> :: forall a b. PandocPure (a -> b) -> PandocPure a -> PandocPure b
pure :: a -> PandocPure a
$cpure :: forall a. a -> PandocPure a
$cp1Applicative :: Functor PandocPure
Applicative
             , Applicative PandocPure
a -> PandocPure a
Applicative PandocPure =>
(forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b)
-> (forall a b. PandocPure a -> PandocPure b -> PandocPure b)
-> (forall a. a -> PandocPure a)
-> Monad PandocPure
PandocPure a -> (a -> PandocPure b) -> PandocPure b
PandocPure a -> PandocPure b -> PandocPure b
forall a. a -> PandocPure a
forall a b. PandocPure a -> PandocPure b -> PandocPure b
forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> PandocPure a
$creturn :: forall a. a -> PandocPure a
>> :: PandocPure a -> PandocPure b -> PandocPure b
$c>> :: forall a b. PandocPure a -> PandocPure b -> PandocPure b
>>= :: PandocPure a -> (a -> PandocPure b) -> PandocPure b
$c>>= :: forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
$cp1Monad :: Applicative PandocPure
Monad
             , MonadError PandocError
             )

-- Run a 'PandocPure' operation.
runPure :: PandocPure a -> Either PandocError a
runPure :: PandocPure a -> Either PandocError a
runPure x :: PandocPure a
x = (State PureState (Either PandocError a)
 -> PureState -> Either PandocError a)
-> PureState
-> State PureState (Either PandocError a)
-> Either PandocError a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State PureState (Either PandocError a)
-> PureState -> Either PandocError a
forall s a. State s a -> s -> a
evalState PureState
forall a. Default a => a
def (State PureState (Either PandocError a) -> Either PandocError a)
-> State PureState (Either PandocError a) -> Either PandocError a
forall a b. (a -> b) -> a -> b
$
            (StateT CommonState (State PureState) (Either PandocError a)
 -> CommonState -> State PureState (Either PandocError a))
-> CommonState
-> StateT CommonState (State PureState) (Either PandocError a)
-> State PureState (Either PandocError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CommonState (State PureState) (Either PandocError a)
-> CommonState -> State PureState (Either PandocError a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CommonState
forall a. Default a => a
def (StateT CommonState (State PureState) (Either PandocError a)
 -> State PureState (Either PandocError a))
-> StateT CommonState (State PureState) (Either PandocError a)
-> State PureState (Either PandocError a)
forall a b. (a -> b) -> a -> b
$
            ExceptT PandocError (StateT CommonState (State PureState)) a
-> StateT CommonState (State PureState) (Either PandocError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PandocError (StateT CommonState (State PureState)) a
 -> StateT CommonState (State PureState) (Either PandocError a))
-> ExceptT PandocError (StateT CommonState (State PureState)) a
-> StateT CommonState (State PureState) (Either PandocError a)
forall a b. (a -> b) -> a -> b
$
            PandocPure a
-> ExceptT PandocError (StateT CommonState (State PureState)) a
forall a.
PandocPure a
-> ExceptT PandocError (StateT CommonState (State PureState)) a
unPandocPure PandocPure a
x

instance PandocMonad PandocPure where
  lookupEnv :: Text -> PandocPure (Maybe Text)
lookupEnv s :: Text
s = do
    [(Text, Text)]
env <- (PureState -> [(Text, Text)]) -> PandocPure [(Text, Text)]
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> [(Text, Text)]
stEnv
    Maybe Text -> PandocPure (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s [(Text, Text)]
env)

  getCurrentTime :: PandocPure UTCTime
getCurrentTime = (PureState -> UTCTime) -> PandocPure UTCTime
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> UTCTime
stTime

  getCurrentTimeZone :: PandocPure TimeZone
getCurrentTimeZone = (PureState -> TimeZone) -> PandocPure TimeZone
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> TimeZone
stTimeZone

  newStdGen :: PandocPure StdGen
newStdGen = do
    StdGen
g <- (PureState -> StdGen) -> PandocPure StdGen
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> StdGen
stStdGen
    let (_, nxtGen :: StdGen
nxtGen) = StdGen -> (Int, StdGen)
forall g. RandomGen g => g -> (Int, g)
next StdGen
g
    (PureState -> PureState) -> PandocPure ()
modifyPureState ((PureState -> PureState) -> PandocPure ())
-> (PureState -> PureState) -> PandocPure ()
forall a b. (a -> b) -> a -> b
$ \st :: PureState
st -> PureState
st { stStdGen :: StdGen
stStdGen = StdGen
nxtGen }
    StdGen -> PandocPure StdGen
forall (m :: * -> *) a. Monad m => a -> m a
return StdGen
g

  newUniqueHash :: PandocPure Int
newUniqueHash = do
    [Int]
uniqs <- (PureState -> [Int]) -> PandocPure [Int]
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> [Int]
stUniqStore
    case [Int]
uniqs of
      u :: Int
u : us :: [Int]
us -> do
        (PureState -> PureState) -> PandocPure ()
modifyPureState ((PureState -> PureState) -> PandocPure ())
-> (PureState -> PureState) -> PandocPure ()
forall a b. (a -> b) -> a -> b
$ \st :: PureState
st -> PureState
st { stUniqStore :: [Int]
stUniqStore = [Int]
us }
        Int -> PandocPure Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
u
      _ -> PandocError -> PandocPure Int
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure Int) -> PandocError -> PandocPure Int
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError
                        "uniq store ran out of elements"
  openURL :: Text -> PandocPure (ByteString, Maybe Text)
openURL u :: Text
u = PandocError -> PandocPure (ByteString, Maybe Text)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure (ByteString, Maybe Text))
-> PandocError -> PandocPure (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound Text
u
  readFileLazy :: String -> PandocPure ByteString
readFileLazy fp :: String
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case FileInfo -> ByteString
infoFileContents (FileInfo -> ByteString) -> Maybe FileInfo -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> FileTree -> Maybe FileInfo
getFileInfo String
fp FileTree
fps of
      Just bs :: ByteString
bs -> ByteString -> PandocPure ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
BL.fromStrict ByteString
bs)
      Nothing -> PandocError -> PandocPure ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure ByteString)
-> PandocError -> PandocPure ByteString
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
  readFileStrict :: String -> PandocPure ByteString
readFileStrict fp :: String
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case FileInfo -> ByteString
infoFileContents (FileInfo -> ByteString) -> Maybe FileInfo -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> FileTree -> Maybe FileInfo
getFileInfo String
fp FileTree
fps of
      Just bs :: ByteString
bs -> ByteString -> PandocPure ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
      Nothing -> PandocError -> PandocPure ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure ByteString)
-> PandocError -> PandocPure ByteString
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

  glob :: String -> PandocPure [String]
glob s :: String
s = do
    FileTree ftmap :: Map String FileInfo
ftmap <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    [String] -> PandocPure [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> PandocPure [String])
-> [String] -> PandocPure [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pattern -> String -> Bool
match (String -> Pattern
compile String
s)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Map String FileInfo -> [String]
forall k a. Map k a -> [k]
M.keys Map String FileInfo
ftmap

  fileExists :: String -> PandocPure Bool
fileExists fp :: String
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case String -> FileTree -> Maybe FileInfo
getFileInfo String
fp FileTree
fps of
         Nothing -> Bool -> PandocPure Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         Just _  -> Bool -> PandocPure Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

  getDataFileName :: String -> PandocPure String
getDataFileName fp :: String
fp = String -> PandocPure String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PandocPure String) -> String -> PandocPure String
forall a b. (a -> b) -> a -> b
$ "data/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp

  getModificationTime :: String -> PandocPure UTCTime
getModificationTime fp :: String
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case FileInfo -> UTCTime
infoFileMTime (FileInfo -> UTCTime) -> Maybe FileInfo -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> FileTree -> Maybe FileInfo
getFileInfo String
fp FileTree
fps of
      Just tm :: UTCTime
tm -> UTCTime -> PandocPure UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
tm
      Nothing -> PandocError -> PandocPure UTCTime
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure UTCTime)
-> PandocError -> PandocPure UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> IOError -> PandocError
PandocIOError (String -> Text
T.pack String
fp)
                    (String -> IOError
userError "Can't get modification time")

  getCommonState :: PandocPure CommonState
getCommonState = ExceptT
  PandocError (StateT CommonState (State PureState)) CommonState
-> PandocPure CommonState
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT
   PandocError (StateT CommonState (State PureState)) CommonState
 -> PandocPure CommonState)
-> ExceptT
     PandocError (StateT CommonState (State PureState)) CommonState
-> PandocPure CommonState
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) CommonState
-> ExceptT
     PandocError (StateT CommonState (State PureState)) CommonState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT CommonState (State PureState) CommonState
forall s (m :: * -> *). MonadState s m => m s
get
  putCommonState :: CommonState -> PandocPure ()
putCommonState x :: CommonState
x = ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT PandocError (StateT CommonState (State PureState)) ()
 -> PandocPure ())
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) ()
 -> ExceptT PandocError (StateT CommonState (State PureState)) ())
-> StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall a b. (a -> b) -> a -> b
$ CommonState -> StateT CommonState (State PureState) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CommonState
x

  logOutput :: LogMessage -> PandocPure ()
logOutput _msg :: LogMessage
_msg = () -> PandocPure ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- 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 msg :: 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
        ("[trace] Parsed " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ " 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
== "chunk"
               then " of chunk"
               else "")
        (() -> 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