{-# 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 ( 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
class (Functor m, Applicative m, Monad m, MonadError PandocError m)
=> PandocMonad m where
lookupEnv :: T.Text -> m (Maybe T.Text)
getCurrentTime :: m UTCTime
getCurrentTimeZone :: m TimeZone
newStdGen :: m StdGen
newUniqueHash :: m Int
openURL :: T.Text -> m (B.ByteString, Maybe MimeType)
readFileLazy :: FilePath -> m BL.ByteString
readFileStrict :: FilePath -> m B.ByteString
glob :: String -> m [FilePath]
fileExists :: FilePath -> m Bool
getDataFileName :: FilePath -> m FilePath
getModificationTime :: FilePath -> m UTCTime
getCommonState :: m CommonState
putCommonState :: CommonState -> m ()
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
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
logOutput :: LogMessage -> m ()
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 ())
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 }
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
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
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 }
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}
setRequestHeader :: PandocMonad m
=> T.Text
-> T.Text
-> m ()
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) }
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}
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
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'
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
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 }
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
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 }
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
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}
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
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
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))
data CommonState = CommonState { CommonState -> [LogMessage]
stLog :: [LogMessage]
, CommonState -> Maybe String
stUserDataDir :: Maybe FilePath
, CommonState -> Maybe Text
stSourceURL :: Maybe T.Text
, :: [(T.Text, T.Text)]
, CommonState -> MediaBag
stMediaBag :: MediaBag
, CommonState -> Maybe (Lang, Maybe Translations)
stTranslations :: Maybe
(Lang, Maybe Translations)
, CommonState -> [String]
stInputFiles :: [FilePath]
, CommonState -> Maybe String
stOutputFile :: Maybe FilePath
, CommonState -> [String]
stResourcePath :: [FilePath]
, CommonState -> Verbosity
stVerbosity :: Verbosity
, CommonState -> Bool
stTrace :: Bool
}
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
}
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)
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) }
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
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
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)
(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"
_ -> ""
(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))
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 ""
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
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
)
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
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'
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
_ -> Maybe URI
forall a. Maybe a
Nothing
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 }
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
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') ->
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'
(Nothing, s' :: Text
s'@(Text -> String
T.unpack -> ('/':'/':c :: Char
c:_))) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '?' ->
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'
(Nothing, s' :: Text
s') ->
case String -> Maybe URI
parseURI (Text -> String
T.unpack Text
s') of
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')
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
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
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
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
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"
, "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
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
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)
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')
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"
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.")
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
extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc
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
writeMedia :: FilePath -> MediaBag -> FilePath -> PandocIO ()
writeMedia :: String -> MediaBag -> String -> PandocIO ()
writeMedia dir :: String
dir mediabag :: MediaBag
mediabag subpath :: String
subpath = do
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
data PureState = PureState { PureState -> StdGen
stStdGen :: StdGen
, PureState -> [Word8]
stWord8Store :: [Word8]
, PureState -> [Int]
stUniqStore :: [Int]
, 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)
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
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
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
)
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 ()
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