aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2020-04-17 18:02:25 -0700
committerGitHub <noreply@github.com>2020-04-17 18:02:25 -0700
commit0d2b8e3fe1d6a27aac082be7711b7156783b3051 (patch)
tree459122371d6b88a7756eee954b81f2bba4bdfdca
parent8f40b4ba14fce10199a059a281c9bd10c884241d (diff)
parent62cf21cbaa9ac3fbc2ba7218a3037208364c80a4 (diff)
downloadpandoc-0d2b8e3fe1d6a27aac082be7711b7156783b3051.tar.gz
Merge pull request #6211 from tarleb/lua-pandocerror
API change: create PandocLua type, use PandocError for exceptions
-rw-r--r--pandoc.cabal12
-rw-r--r--src/Text/Pandoc/Class/IO.hs231
-rw-r--r--src/Text/Pandoc/Class/PandocIO.hs188
-rw-r--r--src/Text/Pandoc/Error.hs2
-rw-r--r--src/Text/Pandoc/Filter/JSON.hs6
-rw-r--r--src/Text/Pandoc/Filter/Lua.hs9
-rw-r--r--src/Text/Pandoc/Lua.hs3
-rw-r--r--src/Text/Pandoc/Lua/ErrorConversion.hs61
-rw-r--r--src/Text/Pandoc/Lua/Filter.hs20
-rw-r--r--src/Text/Pandoc/Lua/Init.hs91
-rw-r--r--src/Text/Pandoc/Lua/Marshaling.hs3
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs15
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/PandocError.hs65
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/Version.hs4
-rw-r--r--src/Text/Pandoc/Lua/Module/MediaBag.hs77
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs32
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs57
-rw-r--r--src/Text/Pandoc/Lua/Packages.hs64
-rw-r--r--src/Text/Pandoc/Lua/PandocLua.hs134
-rw-r--r--src/Text/Pandoc/Lua/Util.hs24
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs27
-rw-r--r--stack.yaml1
-rw-r--r--test/Tests/Lua.hs15
-rw-r--r--test/lua/module/pandoc-types.lua7
24 files changed, 704 insertions, 444 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index 7c74a26f0..43a3eac56 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -412,9 +412,9 @@ library
blaze-markup >= 0.8 && < 0.9,
vector >= 0.10 && < 0.13,
jira-wiki-markup >= 1.3 && < 1.4,
- hslua >= 1.0.1 && < 1.2,
+ hslua >= 1.1 && < 1.2,
hslua-module-system >= 0.2 && < 0.3,
- hslua-module-text >= 0.2 && < 0.3,
+ hslua-module-text >= 0.2.1 && < 0.3,
binary >= 0.5 && < 0.11,
SHA >= 1.6 && < 1.7,
haddock-library >= 1.8 && < 1.10,
@@ -571,6 +571,7 @@ library
Text.Pandoc.App.Opt,
Text.Pandoc.App.OutputSettings,
Text.Pandoc.Class.CommonState,
+ Text.Pandoc.Class.IO,
Text.Pandoc.Class.PandocMonad,
Text.Pandoc.Class.PandocIO,
Text.Pandoc.Class.PandocPure,
@@ -611,6 +612,7 @@ library
Text.Pandoc.Writers.Roff,
Text.Pandoc.Writers.Powerpoint.Presentation,
Text.Pandoc.Writers.Powerpoint.Output,
+ Text.Pandoc.Lua.ErrorConversion,
Text.Pandoc.Lua.Filter,
Text.Pandoc.Lua.Global,
Text.Pandoc.Lua.Init,
@@ -621,6 +623,7 @@ library
Text.Pandoc.Lua.Marshaling.Context,
Text.Pandoc.Lua.Marshaling.List,
Text.Pandoc.Lua.Marshaling.MediaBag,
+ Text.Pandoc.Lua.Marshaling.PandocError,
Text.Pandoc.Lua.Marshaling.ReaderOptions,
Text.Pandoc.Lua.Marshaling.Version,
Text.Pandoc.Lua.Module.MediaBag,
@@ -629,6 +632,7 @@ library
Text.Pandoc.Lua.Module.Types,
Text.Pandoc.Lua.Module.Utils,
Text.Pandoc.Lua.Packages,
+ Text.Pandoc.Lua.PandocLua,
Text.Pandoc.Lua.Util,
Text.Pandoc.Lua.Walk,
Text.Pandoc.CSS,
@@ -733,11 +737,13 @@ test-suite test-pandoc
mtl >= 2.2 && < 2.3,
bytestring >= 0.9 && < 0.11,
base64-bytestring >= 0.1 && < 1.1,
+ exceptions >= 0.8 && < 0.11,
text >= 1.1.1.0 && < 1.3,
time >= 1.5 && < 1.10,
directory >= 1.2.3 && < 1.4,
+ exceptions >= 0.8 && < 0.11,
filepath >= 1.1 && < 1.5,
- hslua >= 1.0 && < 1.2,
+ hslua >= 1.1 && < 1.2,
process >= 1.2.3 && < 1.7,
temporary >= 1.1 && < 1.4,
Diff >= 0.2 && < 0.5,
diff --git a/src/Text/Pandoc/Class/IO.hs b/src/Text/Pandoc/Class/IO.hs
new file mode 100644
index 000000000..c38a37844
--- /dev/null
+++ b/src/Text/Pandoc/Class/IO.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+Module : Text.Pandoc.Class.IO
+Copyright : Copyright (C) 2016-2020 Jesse Rosenthal, John MacFarlane
+License : GNU GPL, version 2 or above
+
+Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
+Stability : alpha
+Portability : portable
+
+Default ways to perform @'PandocMonad'@ actions in a @'MonadIO'@ type.
+
+These functions are used to make the @'PandocIO'@ type an instance of
+@'PandocMonad'@, but can be reused for any other MonadIO-conforming
+types.
+-}
+module Text.Pandoc.Class.IO
+ ( fileExists
+ , getCurrentTime
+ , getCurrentTimeZone
+ , getDataFileName
+ , getModificationTime
+ , glob
+ , logOutput
+ , logIOError
+ , lookupEnv
+ , newStdGen
+ , newUniqueHash
+ , openURL
+ , readFileLazy
+ , readFileStrict
+ , extractMedia
+ ) where
+
+import Control.Monad.Except (throwError)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.ByteString.Base64 (decodeLenient)
+import Data.ByteString.Lazy (toChunks)
+import Data.Text (Text, pack, unpack)
+import Data.Time (TimeZone, UTCTime)
+import Data.Unique (hashUnique)
+import Network.Connection (TLSSettings (TLSSettingsSimple))
+import Network.HTTP.Client
+ (httpLbs, responseBody, responseHeaders,
+ Request(port, host, requestHeaders), parseRequest, newManager)
+import Network.HTTP.Client.Internal (addProxy)
+import Network.HTTP.Client.TLS (mkManagerSettings)
+import Network.HTTP.Types.Header ( hContentType )
+import Network.Socket (withSocketsDo)
+import Network.URI (unEscapeString)
+import System.Directory (createDirectoryIfMissing)
+import System.Environment (getEnv)
+import System.FilePath ((</>), takeDirectory, normalise)
+import System.IO (stderr)
+import System.IO.Error
+import System.Random (StdGen)
+import Text.Pandoc.Class.CommonState (CommonState (..))
+import Text.Pandoc.Class.PandocMonad
+ (PandocMonad, getsCommonState, getMediaBag, report)
+import Text.Pandoc.Definition (Pandoc, Inline (Image))
+import Text.Pandoc.Error (PandocError (..))
+import Text.Pandoc.Logging (LogMessage (..), messageVerbosity, showLogMessage)
+import Text.Pandoc.MIME (MimeType)
+import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)
+import Text.Pandoc.Walk (walk)
+import qualified Control.Exception as E
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Text as T
+import qualified Data.Time
+import qualified Data.Time.LocalTime
+import qualified Data.Unique
+import qualified System.Directory
+import qualified System.Environment as Env
+import qualified System.FilePath.Glob
+import qualified System.Random
+import qualified Text.Pandoc.UTF8 as UTF8
+#ifndef EMBED_DATA_FILES
+import qualified Paths_pandoc as Paths
+#endif
+
+-- | Utility function to lift IO errors into 'PandocError's.
+liftIOError :: (PandocMonad m, MonadIO m) => (String -> IO a) -> String -> m a
+liftIOError f u = do
+ res <- liftIO $ tryIOError $ f u
+ case res of
+ Left e -> throwError $ PandocIOError (pack u) e
+ Right r -> return r
+
+-- | Show potential IO errors to the user continuing execution anyway
+logIOError :: (PandocMonad m, MonadIO m) => IO () -> m ()
+logIOError f = do
+ res <- liftIO $ tryIOError f
+ case res of
+ Left e -> report $ IgnoredIOError $ pack $ E.displayException e
+ Right _ -> pure ()
+
+-- | Lookup an environment variable in the programs environment.
+lookupEnv :: MonadIO m => Text -> m (Maybe Text)
+lookupEnv = fmap (fmap pack) . liftIO . Env.lookupEnv . unpack
+
+-- | Get the current (UTC) time.
+getCurrentTime :: MonadIO m => m UTCTime
+getCurrentTime = liftIO Data.Time.getCurrentTime
+
+-- | Get the locale's time zone.
+getCurrentTimeZone :: MonadIO m => m TimeZone
+getCurrentTimeZone = liftIO Data.Time.LocalTime.getCurrentTimeZone
+
+-- | Return a new generator for random numbers.
+newStdGen :: MonadIO m => m StdGen
+newStdGen = liftIO System.Random.newStdGen
+
+-- | Return a new unique integer.
+newUniqueHash :: MonadIO m => m Int
+newUniqueHash = hashUnique <$> liftIO Data.Unique.newUnique
+
+openURL :: (PandocMonad m, MonadIO m) => Text -> m (B.ByteString, Maybe MimeType)
+openURL u
+ | Just u'' <- T.stripPrefix "data:" u = do
+ let mime = T.takeWhile (/=',') u''
+ let contents = UTF8.fromString $
+ unEscapeString $ T.unpack $ T.drop 1 $ T.dropWhile (/=',') u''
+ return (decodeLenient contents, Just mime)
+ | otherwise = do
+ let toReqHeader (n, v) = (CI.mk (UTF8.fromText n), UTF8.fromText v)
+ customHeaders <- map toReqHeader <$> getsCommonState stRequestHeaders
+ disableCertificateValidation <- getsCommonState stNoCheckCertificate
+ report $ Fetching u
+ res <- liftIO $ E.try $ withSocketsDo $ do
+ let parseReq = parseRequest
+ proxy <- tryIOError (getEnv "http_proxy")
+ let addProxy' x = case proxy of
+ Left _ -> return x
+ Right pr -> parseReq pr >>= \r ->
+ return (addProxy (host r) (port r) x)
+ req <- parseReq (unpack u) >>= addProxy'
+ let req' = req{requestHeaders = customHeaders ++ requestHeaders req}
+ let tlsSimple = TLSSettingsSimple disableCertificateValidation False False
+ let tlsManagerSettings = mkManagerSettings tlsSimple Nothing
+ resp <- newManager tlsManagerSettings >>= httpLbs req'
+ return (B.concat $ toChunks $ responseBody resp,
+ UTF8.toText `fmap` lookup hContentType (responseHeaders resp))
+
+ case res of
+ Right r -> return r
+ Left e -> throwError $ PandocHttpError u e
+
+-- | Read the lazy ByteString contents from a file path, raising an error on
+-- failure.
+readFileLazy :: (PandocMonad m, MonadIO m) => FilePath -> m BL.ByteString
+readFileLazy s = liftIOError BL.readFile s
+
+-- | Read the strict ByteString contents from a file path,
+-- raising an error on failure.
+readFileStrict :: (PandocMonad m, MonadIO m) => FilePath -> m B.ByteString
+readFileStrict s = liftIOError B.readFile s
+
+-- | Return a list of paths that match a glob, relative to the working
+-- directory. See 'System.FilePath.Glob' for the glob syntax.
+glob :: (PandocMonad m, MonadIO m) => String -> m [FilePath]
+glob = liftIOError System.FilePath.Glob.glob
+
+-- | Returns True if file exists.
+fileExists :: (PandocMonad m, MonadIO m) => FilePath -> m Bool
+fileExists = liftIOError System.Directory.doesFileExist
+
+-- | Returns the path of data file.
+getDataFileName :: (PandocMonad m, MonadIO m) => FilePath -> m FilePath
+#ifdef EMBED_DATA_FILES
+getDataFileName = return
+#else
+getDataFileName = liftIOError Paths.getDataFileName
+#endif
+
+-- | Return the modification time of a file.
+getModificationTime :: (PandocMonad m, MonadIO m) => FilePath -> m UTCTime
+getModificationTime = liftIOError System.Directory.getModificationTime
+
+-- | Output a log message.
+logOutput :: (PandocMonad m, MonadIO m) => LogMessage -> m ()
+logOutput msg = liftIO $ do
+ UTF8.hPutStr stderr $
+ "[" ++ show (messageVerbosity msg) ++ "] "
+ alertIndent $ T.lines $ showLogMessage msg
+
+-- | Prints the list of lines to @stderr@, indenting every but the first
+-- line by two spaces.
+alertIndent :: [Text] -> IO ()
+alertIndent [] = return ()
+alertIndent (l:ls) = do
+ UTF8.hPutStrLn stderr $ unpack l
+ mapM_ go ls
+ where go l' = do UTF8.hPutStr stderr " "
+ UTF8.hPutStrLn stderr $ unpack l'
+
+-- | Extract media from the mediabag into a directory.
+extractMedia :: (PandocMonad m, MonadIO m) => FilePath -> Pandoc -> m Pandoc
+extractMedia dir d = do
+ media <- getMediaBag
+ case [fp | (fp, _, _) <- mediaDirectory media] of
+ [] -> return d
+ fps -> do
+ mapM_ (writeMedia dir media) fps
+ return $ walk (adjustImagePath dir fps) d
+
+-- | Write the contents of a media bag to a path.
+writeMedia :: (PandocMonad m, MonadIO m)
+ => FilePath -> MediaBag -> FilePath
+ -> m ()
+writeMedia dir mediabag subpath = do
+ -- we join and split to convert a/b/c to a\b\c on Windows;
+ -- in zip containers all paths use /
+ let fullpath = dir </> unEscapeString (normalise subpath)
+ let mbcontents = lookupMedia subpath mediabag
+ case mbcontents of
+ Nothing -> throwError $ PandocResourceNotFound $ pack subpath
+ Just (_, bs) -> do
+ report $ Extracting $ pack fullpath
+ liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)
+ logIOError $ BL.writeFile fullpath bs
+
+-- | If the given Inline element is an image with a @src@ path equal to
+-- one in the list of @paths@, then prepends @dir@ to the image source;
+-- returns the element unchanged otherwise.
+adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline
+adjustImagePath dir paths (Image attr lab (src, tit))
+ | unpack src `elem` paths = Image attr lab (pack dir <> "/" <> src, tit)
+adjustImagePath _ _ x = x
diff --git a/src/Text/Pandoc/Class/PandocIO.hs b/src/Text/Pandoc/Class/PandocIO.hs
index ee6a041ba..63cb94155 100644
--- a/src/Text/Pandoc/Class/PandocIO.hs
+++ b/src/Text/Pandoc/Class/PandocIO.hs
@@ -1,7 +1,5 @@
-{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Class.PandocIO
Copyright : Copyright (C) 2016-2020 Jesse Rosenthal, John MacFarlane
@@ -16,79 +14,21 @@ This module defines @'PandocIO'@, an IO-based instance of the
using IO operators.
-}
module Text.Pandoc.Class.PandocIO
- ( getPOSIXTime
- , getZonedTime
- , readFileFromDirs
- , report
- , setTrace
- , setRequestHeader
- , getLog
- , setVerbosity
- , getVerbosity
- , getMediaBag
- , setMediaBag
- , insertMedia
- , setUserDataDir
- , getUserDataDir
- , fetchItem
- , getInputFiles
- , setInputFiles
- , getOutputFile
- , setOutputFile
- , setResourcePath
- , getResourcePath
- , PandocIO(..)
+ ( PandocIO(..)
, runIO
, runIOorExplode
, extractMedia
) where
-import Control.Monad.Except
-import Control.Monad.State.Strict
-import Data.ByteString.Base64 (decodeLenient)
-import Data.ByteString.Lazy (toChunks)
-import Data.Default
-import Data.Text (Text)
-import Data.Unique (hashUnique)
-import Network.HTTP.Client
- (httpLbs, responseBody, responseHeaders,
- Request(port, host, requestHeaders), parseRequest, newManager)
-import Network.HTTP.Client.Internal (addProxy)
-import Network.HTTP.Client.TLS (mkManagerSettings)
-import Network.Connection (TLSSettings (..))
-import Network.HTTP.Types.Header ( hContentType )
-import Network.Socket (withSocketsDo)
-import Network.URI ( unEscapeString )
-import Prelude
-import System.Directory (createDirectoryIfMissing)
-import System.Environment (getEnv)
-import System.FilePath ((</>), takeDirectory, normalise)
-import System.IO (stderr)
-import System.IO.Error
+import Control.Monad.Except (ExceptT, MonadError, runExceptT)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.State (StateT, evalStateT, lift, get, put)
+import Data.Default (Default (def))
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad
import Text.Pandoc.Definition
import Text.Pandoc.Error
-import Text.Pandoc.Logging
-import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)
-import Text.Pandoc.Walk (walk)
-import qualified Control.Exception as E
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Text as T
-import qualified Data.Time as IO (getCurrentTime)
-import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)
-import qualified Data.Unique as IO (newUnique)
-import qualified System.Directory as Directory
-import qualified System.Directory as IO (getModificationTime)
-import qualified System.Environment as IO (lookupEnv)
-import qualified System.FilePath.Glob as IO (glob)
-import qualified System.Random as IO (newStdGen)
-import qualified Text.Pandoc.UTF8 as UTF8
-#ifndef EMBED_DATA_FILES
-import qualified Paths_pandoc as Paths
-#endif
+import qualified Text.Pandoc.Class.IO as IO
-- | Evaluate a 'PandocIO' operation.
runIO :: PandocIO a -> IO (Either PandocError a)
@@ -108,113 +48,27 @@ newtype PandocIO a = PandocIO {
, MonadError PandocError
)
--- | Utility function to lift IO errors into 'PandocError's.
-liftIOError :: (String -> IO a) -> String -> PandocIO a
-liftIOError f u = do
- res <- liftIO $ tryIOError $ f u
- case res of
- Left e -> throwError $ PandocIOError (T.pack u) e
- Right r -> return r
-
--- | Show potential IO errors to the user continuing execution anyway
-logIOError :: IO () -> PandocIO ()
-logIOError f = do
- res <- liftIO $ tryIOError f
- case res of
- Left e -> report $ IgnoredIOError $ T.pack $ E.displayException e
- Right _ -> pure ()
-
instance PandocMonad PandocIO where
- lookupEnv = fmap (fmap T.pack) . liftIO . IO.lookupEnv . T.unpack
- getCurrentTime = liftIO IO.getCurrentTime
- getCurrentTimeZone = liftIO IO.getCurrentTimeZone
- newStdGen = liftIO IO.newStdGen
- newUniqueHash = hashUnique <$> liftIO IO.newUnique
-
- openURL u
- | Just u'' <- T.stripPrefix "data:" u = do
- let mime = T.takeWhile (/=',') u''
- let contents = UTF8.fromString $
- unEscapeString $ T.unpack $ T.drop 1 $ T.dropWhile (/=',') u''
- return (decodeLenient contents, Just mime)
- | otherwise = do
- let toReqHeader (n, v) = (CI.mk (UTF8.fromText n), UTF8.fromText v)
- customHeaders <- map toReqHeader <$> getsCommonState stRequestHeaders
- disableCertificateValidation <- getsCommonState stNoCheckCertificate
- report $ Fetching u
- res <- liftIO $ E.try $ withSocketsDo $ do
- let parseReq = parseRequest
- proxy <- tryIOError (getEnv "http_proxy")
- let addProxy' x = case proxy of
- Left _ -> return x
- Right pr -> parseReq pr >>= \r ->
- return (addProxy (host r) (port r) x)
- req <- parseReq (T.unpack u) >>= addProxy'
- let req' = req{requestHeaders = customHeaders ++ requestHeaders req}
- resp <- newManager (mkManagerSettings (TLSSettingsSimple disableCertificateValidation False False) Nothing) >>= httpLbs req'
- return (B.concat $ toChunks $ responseBody resp,
- UTF8.toText `fmap` lookup hContentType (responseHeaders resp))
+ lookupEnv = IO.lookupEnv
+ getCurrentTime = IO.getCurrentTime
+ getCurrentTimeZone = IO.getCurrentTimeZone
+ newStdGen = IO.newStdGen
+ newUniqueHash = IO.newUniqueHash
- case res of
- Right r -> return r
- Left e -> throwError $ PandocHttpError u e
+ openURL = IO.openURL
+ readFileLazy = IO.readFileLazy
+ readFileStrict = IO.readFileStrict
- readFileLazy s = liftIOError BL.readFile s
- readFileStrict s = liftIOError B.readFile s
+ glob = IO.glob
+ fileExists = IO.fileExists
+ getDataFileName = IO.getDataFileName
+ getModificationTime = IO.getModificationTime
- glob = liftIOError IO.glob
- fileExists = liftIOError Directory.doesFileExist
-#ifdef EMBED_DATA_FILES
- getDataFileName = return
-#else
- getDataFileName = liftIOError Paths.getDataFileName
-#endif
- getModificationTime = liftIOError IO.getModificationTime
getCommonState = PandocIO $ lift get
- putCommonState x = PandocIO $ lift $ put x
- logOutput msg = liftIO $ do
- UTF8.hPutStr stderr $
- "[" ++ show (messageVerbosity msg) ++ "] "
- alertIndent $ T.lines $ showLogMessage msg
+ putCommonState = PandocIO . lift . put
--- | Prints the list of lines to @stderr@, indenting every but the first
--- line by two spaces.
-alertIndent :: [Text] -> IO ()
-alertIndent [] = return ()
-alertIndent (l:ls) = do
- UTF8.hPutStrLn stderr $ T.unpack l
- mapM_ go ls
- where go l' = do UTF8.hPutStr stderr " "
- UTF8.hPutStrLn stderr $ T.unpack l'
+ logOutput = IO.logOutput
-- | Extract media from the mediabag into a directory.
extractMedia :: FilePath -> Pandoc -> PandocIO Pandoc
-extractMedia dir d = do
- media <- getMediaBag
- case [fp | (fp, _, _) <- mediaDirectory media] of
- [] -> return d
- fps -> do
- mapM_ (writeMedia dir media) fps
- return $ walk (adjustImagePath dir fps) d
-
--- | Write the contents of a media bag to a path.
-writeMedia :: FilePath -> MediaBag -> FilePath -> PandocIO ()
-writeMedia dir mediabag subpath = do
- -- we join and split to convert a/b/c to a\b\c on Windows;
- -- in zip containers all paths use /
- let fullpath = dir </> unEscapeString (normalise subpath)
- let mbcontents = lookupMedia subpath mediabag
- case mbcontents of
- Nothing -> throwError $ PandocResourceNotFound $ T.pack subpath
- Just (_, bs) -> do
- report $ Extracting $ T.pack fullpath
- liftIOError (createDirectoryIfMissing True) (takeDirectory fullpath)
- logIOError $ BL.writeFile fullpath bs
-
--- | If the given Inline element is an image with a @src@ path equal to
--- one in the list of @paths@, then prepends @dir@ to the image source;
--- returns the element unchanged otherwise.
-adjustImagePath :: FilePath -> [FilePath] -> Inline -> Inline
-adjustImagePath dir paths (Image attr lab (src, tit))
- | T.unpack src `elem` paths = Image attr lab (T.pack dir <> "/" <> src, tit)
-adjustImagePath _ _ x = x
+extractMedia = IO.extractMedia
diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs
index 977875907..4c3c1af79 100644
--- a/src/Text/Pandoc/Error.hs
+++ b/src/Text/Pandoc/Error.hs
@@ -47,6 +47,7 @@ data PandocError = PandocIOError Text IOError
| PandocPDFProgramNotFoundError Text
| PandocPDFError Text
| PandocFilterError Text Text
+ | PandocLuaError Text
| PandocCouldNotFindDataFileError Text
| PandocResourceNotFound Text
| PandocTemplateError Text
@@ -100,6 +101,7 @@ handleError (Left e) =
PandocPDFError logmsg -> err 43 $ "Error producing PDF.\n" <> logmsg
PandocFilterError filtername msg -> err 83 $ "Error running filter " <>
filtername <> ":\n" <> msg
+ PandocLuaError msg -> err 84 $ "Error running Lua:\n" <> msg
PandocCouldNotFindDataFileError fn -> err 97 $
"Could not find data file " <> fn
PandocResourceNotFound fn -> err 99 $
diff --git a/src/Text/Pandoc/Filter/JSON.hs b/src/Text/Pandoc/Filter/JSON.hs
index 7e27f7d94..83ec9a97c 100644
--- a/src/Text/Pandoc/Filter/JSON.hs
+++ b/src/Text/Pandoc/Filter/JSON.hs
@@ -23,7 +23,6 @@ import System.Directory (executable, doesFileExist, findExecutable,
import System.Environment (getEnvironment)
import System.Exit (ExitCode (..))
import System.FilePath ((</>), takeExtension)
-import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Error (PandocError (PandocFilterError))
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Options (ReaderOptions)
@@ -32,11 +31,12 @@ import Text.Pandoc.Shared (pandocVersion, tshow)
import qualified Control.Exception as E
import qualified Text.Pandoc.UTF8 as UTF8
-apply :: ReaderOptions
+apply :: MonadIO m
+ => ReaderOptions
-> [String]
-> FilePath
-> Pandoc
- -> PandocIO Pandoc
+ -> m Pandoc
apply ropts args f = liftIO . externalFilter ropts f args
externalFilter :: MonadIO m
diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs
index a50e5217d..8df057bfa 100644
--- a/src/Text/Pandoc/Filter/Lua.hs
+++ b/src/Text/Pandoc/Filter/Lua.hs
@@ -17,8 +17,7 @@ import qualified Data.Text as T
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Error (PandocError (PandocFilterError))
-import Text.Pandoc.Lua (Global (..), LuaException (..),
- runLua, runFilterFile, setGlobals)
+import Text.Pandoc.Lua (Global (..), runLua, runFilterFile, setGlobals)
import Text.Pandoc.Options (ReaderOptions)
-- | Run the Lua filter in @filterPath@ for a transformation to the
@@ -40,7 +39,7 @@ apply ropts args fp doc = do
]
runFilterFile fp doc
-forceResult :: FilePath -> Either LuaException Pandoc -> PandocIO Pandoc
+forceResult :: FilePath -> Either PandocError Pandoc -> PandocIO Pandoc
forceResult fp eitherResult = case eitherResult of
- Right x -> return x
- Left (LuaException s) -> throw (PandocFilterError (T.pack fp) s)
+ Right x -> return x
+ Left err -> throw (PandocFilterError (T.pack fp) (T.pack $ show err))
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index 63a49596d..39db0074a 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -10,7 +10,6 @@ Running pandoc Lua filters.
-}
module Text.Pandoc.Lua
( runLua
- , LuaException (..)
-- * Lua globals
, Global (..)
, setGlobals
@@ -20,5 +19,5 @@ module Text.Pandoc.Lua
import Text.Pandoc.Lua.Filter (runFilterFile)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Init (LuaException (..), runLua)
+import Text.Pandoc.Lua.Init (runLua)
import Text.Pandoc.Lua.Marshaling ()
diff --git a/src/Text/Pandoc/Lua/ErrorConversion.hs b/src/Text/Pandoc/Lua/ErrorConversion.hs
new file mode 100644
index 000000000..59c962723
--- /dev/null
+++ b/src/Text/Pandoc/Lua/ErrorConversion.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{- |
+ Module : Text.Pandoc.Lua.ErrorConversion
+ Copyright : © 2020 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Define how Lua errors are converted into @'PandocError'@ Haskell
+exceptions, and /vice versa/.
+-}
+module Text.Pandoc.Lua.ErrorConversion
+ ( errorConversion
+ ) where
+
+import Foreign.Lua (Lua (..), NumResults)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
+import Text.Pandoc.Lua.Marshaling.PandocError (pushPandocError, peekPandocError)
+
+import qualified Control.Monad.Catch as Catch
+import qualified Data.Text as T
+import qualified Foreign.Lua as Lua
+
+-- | Conversions between Lua errors and Haskell exceptions, assuming
+-- that all exceptions are of type @'PandocError'@.
+errorConversion :: Lua.ErrorConversion
+errorConversion = Lua.ErrorConversion
+ { Lua.addContextToException = addContextToException
+ , Lua.alternative = alternative
+ , Lua.errorToException = errorToException
+ , Lua.exceptionToError = exceptionToError
+ }
+
+-- | Convert a Lua error, which must be at the top of the stack, into a
+-- @'PandocError'@, popping the value from the stack.
+errorToException :: forall a . Lua.State -> IO a
+errorToException l = Lua.unsafeRunWith l $ do
+ err <- peekPandocError Lua.stackTop
+ Lua.pop 1
+ Catch.throwM err
+
+-- | Try the first op -- if it doesn't succeed, run the second.
+alternative :: forall a . Lua a -> Lua a -> Lua a
+alternative x y = Catch.try x >>= \case
+ Left (_ :: PandocError) -> y
+ Right x' -> return x'
+
+-- | Add more context to an error
+addContextToException :: forall a . String -> Lua a -> Lua a
+addContextToException ctx op = op `Catch.catch` \case
+ PandocLuaError msg -> Catch.throwM $ PandocLuaError (T.pack ctx <> msg)
+ e -> Catch.throwM e
+
+-- | Catch a @'PandocError'@ exception and raise it as a Lua error.
+exceptionToError :: Lua NumResults -> Lua NumResults
+exceptionToError op = op `Catch.catch` \e -> do
+ pushPandocError e
+ Lua.error
diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs
index f6a0aea5b..e626356d5 100644
--- a/src/Text/Pandoc/Lua/Filter.hs
+++ b/src/Text/Pandoc/Lua/Filter.hs
@@ -18,14 +18,15 @@ module Text.Pandoc.Lua.Filter ( LuaFilterFunction
) where
import Control.Applicative ((<|>))
import Control.Monad (mplus, (>=>))
-import Control.Monad.Catch (finally)
+import Control.Monad.Catch (finally, try)
import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
showConstr, toConstr, tyconUQname)
import Data.Foldable (foldrM)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
-import Foreign.Lua (Lua, Peekable, Pushable)
+import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Text.Pandoc.Definition
+import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.List (List (..))
import Text.Pandoc.Lua.Walk (SingletonsList (..))
@@ -102,7 +103,7 @@ elementOrList x = do
if elementUnchanged
then [x] <$ Lua.pop 1
else do
- mbres <- Lua.peekEither topOfStack
+ mbres <- peekEither topOfStack
case mbres of
Right res -> [res] <$ Lua.pop 1
Left _ -> Lua.peekList topOfStack `finally` Lua.pop 1
@@ -234,11 +235,16 @@ singleElement x = do
if elementUnchanged
then x <$ Lua.pop 1
else do
- mbres <- Lua.peekEither (-1)
+ mbres <- peekEither (-1)
case mbres of
Right res -> res <$ Lua.pop 1
Left err -> do
Lua.pop 1
- Lua.throwException $
- "Error while trying to get a filter's return " ++
- "value from lua stack.\n" ++ err
+ Lua.throwMessage
+ ("Error while trying to get a filter's return " <>
+ "value from Lua stack.\n" <> show err)
+
+-- | Try to convert the value at the given stack index to a Haskell value.
+-- Returns @Left@ with an error message on failure.
+peekEither :: Peekable a => StackIndex -> Lua (Either PandocError a)
+peekEither = try . Lua.peek
diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs
index 757d32898..a5e513a1f 100644
--- a/src/Text/Pandoc/Lua/Init.hs
+++ b/src/Text/Pandoc/Lua/Init.hs
@@ -9,96 +9,57 @@
Functions to initialize the Lua interpreter.
-}
module Text.Pandoc.Lua.Init
- ( LuaException (..)
- , LuaPackageParams (..)
- , runLua
- , luaPackageParams
+ ( runLua
) where
+import Control.Monad.Catch (try)
import Control.Monad.Trans (MonadIO (..))
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
import Foreign.Lua (Lua)
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class.PandocIO (PandocIO)
-import Text.Pandoc.Class.PandocMonad (getCommonState, getUserDataDir,
- putCommonState)
-import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Packages (LuaPackageParams (..),
- installPandocPackageSearcher)
-import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,
+ loadScriptFromDataDir, runPandocLua)
-import qualified Data.Text as Text
import qualified Foreign.Lua as Lua
-import qualified Foreign.Lua.Module.Text as Lua
import qualified Text.Pandoc.Definition as Pandoc
import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc
--- | Lua error message
-newtype LuaException = LuaException Text.Text deriving (Show)
-
-- | Run the lua interpreter, using pandoc's default way of environment
-- initialization.
-runLua :: Lua a -> PandocIO (Either LuaException a)
+runLua :: Lua a -> PandocIO (Either PandocError a)
runLua luaOp = do
- luaPkgParams <- luaPackageParams
- globals <- defaultGlobals
enc <- liftIO $ getForeignEncoding <* setForeignEncoding utf8
- res <- liftIO . Lua.runEither $ do
- setGlobals globals
- initLuaState luaPkgParams
- -- run the given Lua operation
- opResult <- luaOp
- -- get the (possibly modified) state back
- Lua.getglobal "PANDOC_STATE"
- st <- Lua.peek Lua.stackTop
- Lua.pop 1
- -- done
- return (opResult, st)
+ res <- runPandocLua . try $ do
+ initLuaState
+ liftPandocLua luaOp
liftIO $ setForeignEncoding enc
- case res of
- Left (Lua.Exception msg) -> return $ Left (LuaException $ Text.pack msg)
- Right (x, newState) -> do
- putCommonState newState
- return $ Right x
-
--- | Global variables which should always be set.
-defaultGlobals :: PandocIO [Global]
-defaultGlobals = do
- commonState <- getCommonState
- return
- [ PANDOC_API_VERSION
- , PANDOC_STATE commonState
- , PANDOC_VERSION
- ]
-
--- | Generate parameters required to setup pandoc's lua environment.
-luaPackageParams :: PandocIO LuaPackageParams
-luaPackageParams = do
- datadir <- getUserDataDir
- return LuaPackageParams { luaPkgDataDir = datadir }
+ return res
-- | Initialize the lua state with all required values
-initLuaState :: LuaPackageParams -> Lua ()
-initLuaState pkgParams = do
- Lua.openlibs
- Lua.preloadTextModule "text"
- installPandocPackageSearcher pkgParams
+initLuaState :: PandocLua ()
+initLuaState = do
+ liftPandocLua Lua.openlibs
+ installPandocPackageSearcher
initPandocModule
- loadScriptFromDataDir (luaPkgDataDir pkgParams) "init.lua"
+ loadScriptFromDataDir "init.lua"
where
- initPandocModule :: Lua ()
+ initPandocModule :: PandocLua ()
initPandocModule = do
-- Push module table
- ModulePandoc.pushModule (luaPkgDataDir pkgParams)
+ ModulePandoc.pushModule
-- register as loaded module
- Lua.pushvalue Lua.stackTop
- Lua.getfield Lua.registryindex Lua.loadedTableRegistryField
- Lua.setfield (Lua.nthFromTop 2) "pandoc"
- Lua.pop 1
+ liftPandocLua $ do
+ Lua.pushvalue Lua.stackTop
+ Lua.getfield Lua.registryindex Lua.loadedTableRegistryField
+ Lua.setfield (Lua.nthFromTop 2) "pandoc"
+ Lua.pop 1
-- copy constructors into registry
putConstructorsInRegistry
-- assign module to global variable
- Lua.setglobal "pandoc"
+ liftPandocLua $ Lua.setglobal "pandoc"
-- | AST elements are marshaled via normal constructor functions in the
-- @pandoc@ module. However, accessing Lua globals from Haskell is
@@ -108,8 +69,8 @@ initLuaState pkgParams = do
--
-- This function expects the @pandoc@ module to be at the top of the
-- stack.
-putConstructorsInRegistry :: Lua ()
-putConstructorsInRegistry = do
+putConstructorsInRegistry :: PandocLua ()
+putConstructorsInRegistry = liftPandocLua $ do
constrsToReg $ Pandoc.Pandoc mempty mempty
constrsToReg $ Pandoc.Str mempty
constrsToReg $ Pandoc.Para mempty
diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs
index 624f8b917..1254402b6 100644
--- a/src/Text/Pandoc/Lua/Marshaling.hs
+++ b/src/Text/Pandoc/Lua/Marshaling.hs
@@ -13,6 +13,7 @@ module Text.Pandoc.Lua.Marshaling () where
import Text.Pandoc.Lua.Marshaling.AST ()
import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Lua.Marshaling.ReaderOptions ()
import Text.Pandoc.Lua.Marshaling.Context ()
+import Text.Pandoc.Lua.Marshaling.PandocError()
+import Text.Pandoc.Lua.Marshaling.ReaderOptions ()
import Text.Pandoc.Lua.Marshaling.Version ()
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index 81b206f67..8d7e83dc1 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -19,9 +19,11 @@ module Text.Pandoc.Lua.Marshaling.AST
import Control.Applicative ((<|>))
import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Text.Pandoc.Definition
+import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.CommonState ()
+import qualified Control.Monad.Catch as Catch
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
@@ -131,7 +133,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
Lua.TypeBoolean -> MetaBool <$> Lua.peek idx
Lua.TypeString -> MetaString <$> Lua.peek idx
Lua.TypeTable -> do
- tag <- Lua.try $ LuaUtil.getTag idx
+ tag <- try $ LuaUtil.getTag idx
case tag of
Right "MetaBlocks" -> MetaBlocks <$> elementContent
Right "MetaBool" -> MetaBool <$> elementContent
@@ -139,7 +141,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
Right "MetaInlines" -> MetaInlines <$> elementContent
Right "MetaList" -> MetaList <$> elementContent
Right "MetaString" -> MetaString <$> elementContent
- Right t -> Lua.throwException ("Unknown meta tag: " <> t)
+ Right t -> Lua.throwMessage ("Unknown meta tag: " <> t)
Left _ -> do
-- no meta value tag given, try to guess.
len <- Lua.rawlen idx
@@ -148,7 +150,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
else (MetaInlines <$> Lua.peek idx)
<|> (MetaBlocks <$> Lua.peek idx)
<|> (MetaList <$> Lua.peek idx)
- _ -> Lua.throwException "could not get meta value"
+ _ -> Lua.throwMessage "could not get meta value"
-- | Push a block element to the top of the Lua stack.
pushBlock :: Block -> Lua ()
@@ -199,7 +201,7 @@ peekBlock idx = defineHowTo "get Block value" $ do
tbodies
tfoot)
<$> elementContent
- _ -> Lua.throwException ("Unknown block type: " <> tag)
+ _ -> Lua.throwMessage ("Unknown block type: " <> tag)
where
-- Get the contents of an AST element.
elementContent :: Peekable a => Lua a
@@ -344,12 +346,15 @@ peekInline idx = defineHowTo "get Inline value" $ do
"Strong" -> Strong <$> elementContent
"Subscript" -> Subscript <$> elementContent
"Superscript"-> Superscript <$> elementContent
- _ -> Lua.throwException ("Unknown inline type: " <> tag)
+ _ -> Lua.throwMessage ("Unknown inline type: " <> tag)
where
-- Get the contents of an AST element.
elementContent :: Peekable a => Lua a
elementContent = LuaUtil.rawField idx "c"
+try :: Lua a -> Lua (Either PandocError a)
+try = Catch.try
+
withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr f (attributes, x) = f (fromLuaAttr attributes) x
diff --git a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs
new file mode 100644
index 000000000..74537a1dd
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs
@@ -0,0 +1,65 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{- |
+ Module : Text.Pandoc.Lua.Marshaling.PandocError
+ Copyright : © 2020 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Marshaling of @'PandocError'@ values.
+-}
+module Text.Pandoc.Lua.Marshaling.PandocError
+ ( peekPandocError
+ , pushPandocError
+ )
+ where
+
+import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
+
+import qualified Foreign.Lua as Lua
+import qualified Foreign.Lua.Userdata as Lua
+import qualified Text.Pandoc.Lua.Util as LuaUtil
+import qualified Text.Pandoc.UTF8 as UTF8
+
+-- | Userdata name used by Lua for the @PandocError@ type.
+pandocErrorName :: String
+pandocErrorName = "pandoc error"
+
+-- | Peek a @'PandocError'@ element to the Lua stack.
+pushPandocError :: PandocError -> Lua ()
+pushPandocError = Lua.pushAnyWithMetatable pushPandocErrorMT
+ where
+ pushPandocErrorMT = Lua.ensureUserdataMetatable pandocErrorName $
+ LuaUtil.addFunction "__tostring" __tostring
+
+-- | Retrieve a @'PandocError'@ from the Lua stack.
+peekPandocError :: StackIndex -> Lua PandocError
+peekPandocError idx = Lua.ltype idx >>= \case
+ Lua.TypeUserdata -> do
+ errMb <- Lua.toAnyWithName idx pandocErrorName
+ return $ case errMb of
+ Just err -> err
+ Nothing -> PandocLuaError "could not retrieve original error"
+ _ -> do
+ Lua.pushvalue idx
+ msg <- Lua.state >>= \l -> Lua.liftIO (Lua.errorMessage l)
+ return $ PandocLuaError (UTF8.toText msg)
+
+-- | Convert to string.
+__tostring :: PandocError -> Lua String
+__tostring = return . show
+
+--
+-- Instances
+--
+
+instance Pushable PandocError where
+ push = pushPandocError
+
+instance Peekable PandocError where
+ peek = peekPandocError
diff --git a/src/Text/Pandoc/Lua/Marshaling/Version.hs b/src/Text/Pandoc/Lua/Marshaling/Version.hs
index 090725afc..9adb1b763 100644
--- a/src/Text/Pandoc/Lua/Marshaling/Version.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/Version.hs
@@ -57,7 +57,7 @@ peekVersion idx = Lua.ltype idx >>= \case
let parses = readP_to_S parseVersion versionStr
case lastMay parses of
Just (v, "") -> return v
- _ -> Lua.throwException $ "could not parse as Version: " ++ versionStr
+ _ -> Lua.throwMessage $ "could not parse as Version: " ++ versionStr
Lua.TypeUserdata ->
reportValueOnFailure versionTypeName
@@ -71,7 +71,7 @@ peekVersion idx = Lua.ltype idx >>= \case
makeVersion <$> Lua.peek idx
_ ->
- Lua.throwException "could not peek Version"
+ Lua.throwMessage "could not peek Version"
instance Peekable Version where
peek = peekVersion
diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 3a296ef46..e5a10217a 100644
--- a/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -14,13 +14,13 @@ module Text.Pandoc.Lua.Module.MediaBag
) where
import Control.Monad (zipWithM_)
-import Foreign.Lua (Lua, NumResults, Optional, liftIO)
+import Foreign.Lua (Lua, NumResults, Optional)
import Text.Pandoc.Class.CommonState (CommonState (..))
-import Text.Pandoc.Class.PandocIO (runIOorExplode)
-import Text.Pandoc.Class.PandocMonad (fetchItem, putCommonState, setMediaBag)
+import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState,
+ setMediaBag)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator)
-import Text.Pandoc.Lua.Util (addFunction)
+import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction)
import Text.Pandoc.MIME (MimeType)
import qualified Data.ByteString.Lazy as BL
@@ -31,9 +31,9 @@ import qualified Text.Pandoc.MediaBag as MB
--
-- MediaBag submodule
--
-pushModule :: Lua NumResults
+pushModule :: PandocLua NumResults
pushModule = do
- Lua.newtable
+ liftPandocLua Lua.newtable
addFunction "delete" delete
addFunction "empty" empty
addFunction "insert" insertMediaFn
@@ -43,66 +43,46 @@ pushModule = do
addFunction "fetch" fetch
return 1
---
--- Port functions from Text.Pandoc.Class to the Lua monad.
--- TODO: reuse existing functions.
-
--- Get the current CommonState.
-getCommonState :: Lua CommonState
-getCommonState = do
- Lua.getglobal "PANDOC_STATE"
- Lua.peek Lua.stackTop
-
--- Replace MediaBag in CommonState.
-setCommonState :: CommonState -> Lua ()
-setCommonState st = do
- Lua.push st
- Lua.setglobal "PANDOC_STATE"
-
-modifyCommonState :: (CommonState -> CommonState) -> Lua ()
-modifyCommonState f = getCommonState >>= setCommonState . f
-
-- | Delete a single item from the media bag.
-delete :: FilePath -> Lua NumResults
+delete :: FilePath -> PandocLua NumResults
delete fp = 0 <$ modifyCommonState
(\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) })
-- | Delete all items from the media bag.
-empty :: Lua NumResults
+empty :: PandocLua NumResults
empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty })
-- | Insert a new item into the media bag.
insertMediaFn :: FilePath
-> Optional MimeType
-> BL.ByteString
- -> Lua NumResults
+ -> PandocLua NumResults
insertMediaFn fp optionalMime contents = do
- modifyCommonState $ \st ->
- let mb = MB.insertMedia fp (Lua.fromOptional optionalMime) contents
- (stMediaBag st)
- in st { stMediaBag = mb }
- return 0
+ mb <- getMediaBag
+ setMediaBag $ MB.insertMedia fp (Lua.fromOptional optionalMime) contents mb
+ return (Lua.NumResults 0)
-- | Returns iterator values to be used with a Lua @for@ loop.
-items :: Lua NumResults
-items = getCommonState >>= pushIterator . stMediaBag
+items :: PandocLua NumResults
+items = getMediaBag >>= liftPandocLua . pushIterator
lookupMediaFn :: FilePath
- -> Lua NumResults
+ -> PandocLua NumResults
lookupMediaFn fp = do
- res <- MB.lookupMedia fp . stMediaBag <$> getCommonState
- case res of
+ res <- MB.lookupMedia fp <$> getMediaBag
+ liftPandocLua $ case res of
Nothing -> 1 <$ Lua.pushnil
Just (mimeType, contents) -> do
Lua.push mimeType
Lua.push contents
return 2
-mediaDirectoryFn :: Lua NumResults
+mediaDirectoryFn :: PandocLua NumResults
mediaDirectoryFn = do
- dirContents <- MB.mediaDirectory . stMediaBag <$> getCommonState
- Lua.newtable
- zipWithM_ addEntry [1..] dirContents
+ dirContents <- MB.mediaDirectory <$> getMediaBag
+ liftPandocLua $ do
+ Lua.newtable
+ zipWithM_ addEntry [1..] dirContents
return 1
where
addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> Lua ()
@@ -114,14 +94,9 @@ mediaDirectoryFn = do
Lua.rawseti (-2) idx
fetch :: T.Text
- -> Lua NumResults
+ -> PandocLua NumResults
fetch src = do
- commonState <- getCommonState
- let mediaBag = stMediaBag commonState
- (bs, mimeType) <- liftIO . runIOorExplode $ do
- putCommonState commonState
- setMediaBag mediaBag
- fetchItem src
- Lua.push $ maybe "" T.unpack mimeType
- Lua.push bs
+ (bs, mimeType) <- fetchItem src
+ liftPandocLua . Lua.push $ maybe "" T.unpack mimeType
+ liftPandocLua $ Lua.push bs
return 2 -- returns 2 values: contents, mimetype
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index f376d0044..3886568b7 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -24,6 +24,8 @@ import Text.Pandoc.Class.PandocIO (runIO)
import Text.Pandoc.Definition (Block, Inline)
import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter, SingletonsList (..))
import Text.Pandoc.Lua.Marshaling ()
+import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
+ loadScriptFromDataDir)
import Text.Pandoc.Walk (Walkable)
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
import Text.Pandoc.Process (pipeProcess)
@@ -38,28 +40,28 @@ import Text.Pandoc.Error
-- | Push the "pandoc" on the lua stack. Requires the `list` module to be
-- loaded.
-pushModule :: Maybe FilePath -> Lua NumResults
-pushModule datadir = do
- LuaUtil.loadScriptFromDataDir datadir "pandoc.lua"
- LuaUtil.addFunction "read" readDoc
- LuaUtil.addFunction "pipe" pipeFn
- LuaUtil.addFunction "walk_block" walkBlock
- LuaUtil.addFunction "walk_inline" walkInline
+pushModule :: PandocLua NumResults
+pushModule = do
+ loadScriptFromDataDir "pandoc.lua"
+ addFunction "read" readDoc
+ addFunction "pipe" pipeFn
+ addFunction "walk_block" walkBlock
+ addFunction "walk_inline" walkInline
return 1
walkElement :: (Walkable (SingletonsList Inline) a,
Walkable (SingletonsList Block) a)
- => a -> LuaFilter -> Lua a
-walkElement x f = walkInlines f x >>= walkBlocks f
+ => a -> LuaFilter -> PandocLua a
+walkElement x f = liftPandocLua $ walkInlines f x >>= walkBlocks f
-walkInline :: Inline -> LuaFilter -> Lua Inline
+walkInline :: Inline -> LuaFilter -> PandocLua Inline
walkInline = walkElement
-walkBlock :: Block -> LuaFilter -> Lua Block
+walkBlock :: Block -> LuaFilter -> PandocLua Block
walkBlock = walkElement
-readDoc :: T.Text -> Optional T.Text -> Lua NumResults
-readDoc content formatSpecOrNil = do
+readDoc :: T.Text -> Optional T.Text -> PandocLua NumResults
+readDoc content formatSpecOrNil = liftPandocLua $ do
let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil)
res <- Lua.liftIO . runIO $
getReader formatSpec >>= \(rdr,es) ->
@@ -80,8 +82,8 @@ readDoc content formatSpecOrNil = do
pipeFn :: String
-> [String]
-> BL.ByteString
- -> Lua NumResults
-pipeFn command args input = do
+ -> PandocLua NumResults
+pipeFn command args input = liftPandocLua $ do
(ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input
case ec of
ExitSuccess -> 1 <$ Lua.push output
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 11a0bda84..4fe5e255d 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Lua.Module.Utils
Copyright : Copyright © 2017-2020 Albert Krewinkel
@@ -13,15 +14,15 @@ module Text.Pandoc.Lua.Module.Utils
) where
import Control.Applicative ((<|>))
+import Control.Monad.Catch (try)
import Data.Default (def)
import Data.Version (Version)
import Foreign.Lua (Peekable, Lua, NumResults)
-import Text.Pandoc.Class.PandocIO (runIO)
-import Text.Pandoc.Class.PandocMonad (setUserDataDir)
import Text.Pandoc.Definition ( Pandoc, Meta, MetaValue (..), Block, Inline
, Citation, Attr, ListAttributes)
+import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
-import Text.Pandoc.Lua.Util (addFunction)
+import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua)
import qualified Data.Digest.Pure.SHA as SHA
import qualified Data.ByteString.Lazy as BSL
@@ -32,14 +33,14 @@ import qualified Text.Pandoc.Filter.JSON as JSONFilter
import qualified Text.Pandoc.Shared as Shared
-- | Push the "pandoc.utils" module to the lua stack.
-pushModule :: Maybe FilePath -> Lua NumResults
-pushModule mbDatadir = do
- Lua.newtable
+pushModule :: PandocLua NumResults
+pushModule = do
+ liftPandocLua Lua.newtable
addFunction "blocks_to_inlines" blocksToInlines
addFunction "equals" equals
addFunction "make_sections" makeSections
addFunction "normalize_date" normalizeDate
- addFunction "run_json_filter" (runJSONFilter mbDatadir)
+ addFunction "run_json_filter" runJSONFilter
addFunction "sha1" sha1
addFunction "stringify" stringify
addFunction "to_roman_numeral" toRomanNumeral
@@ -47,8 +48,8 @@ pushModule mbDatadir = do
return 1
-- | Squashes a list of blocks into inlines.
-blocksToInlines :: [Block] -> Lua.Optional [Inline] -> Lua [Inline]
-blocksToInlines blks optSep = do
+blocksToInlines :: [Block] -> Lua.Optional [Inline] -> PandocLua [Inline]
+blocksToInlines blks optSep = liftPandocLua $ do
let sep = case Lua.fromOptional optSep of
Just x -> B.fromList x
Nothing -> Shared.defaultBlocksSeparator
@@ -67,23 +68,17 @@ normalizeDate :: T.Text -> Lua (Lua.Optional T.Text)
normalizeDate = return . Lua.Optional . Shared.normalizeDate
-- | Run a JSON filter on the given document.
-runJSONFilter :: Maybe FilePath
- -> Pandoc
+runJSONFilter :: Pandoc
-> FilePath
-> Lua.Optional [String]
- -> Lua NumResults
-runJSONFilter mbDatadir doc filterFile optArgs = do
+ -> PandocLua Pandoc
+runJSONFilter doc filterFile optArgs = do
args <- case Lua.fromOptional optArgs of
Just x -> return x
- Nothing -> do
+ Nothing -> liftPandocLua $ do
Lua.getglobal "FORMAT"
(:[]) <$> Lua.popValue
- filterRes <- Lua.liftIO . runIO $ do
- setUserDataDir mbDatadir
- JSONFilter.apply def args filterFile doc
- case filterRes of
- Left err -> Lua.raiseError (show err)
- Right d -> (1 :: NumResults) <$ Lua.push d
+ JSONFilter.apply def args filterFile doc
-- | Calculate the hash of the given contents.
sha1 :: BSL.ByteString
@@ -93,7 +88,7 @@ sha1 = return . T.pack . SHA.showDigest . SHA.sha1
-- | Convert pandoc structure to a string with formatting removed.
-- Footnotes are skipped (since we don't want their contents in link
-- labels).
-stringify :: AstElement -> Lua T.Text
+stringify :: AstElement -> PandocLua T.Text
stringify el = return $ case el of
PandocElement pd -> Shared.stringify pd
InlineElement i -> Shared.stringify i
@@ -109,7 +104,7 @@ stringifyMetaValue mv = case mv of
MetaString s -> s
_ -> Shared.stringify mv
-equals :: AstElement -> AstElement -> Lua Bool
+equals :: AstElement -> AstElement -> PandocLua Bool
equals e1 e2 = return (e1 == e2)
data AstElement
@@ -125,18 +120,18 @@ data AstElement
instance Peekable AstElement where
peek idx = do
- res <- Lua.try $ (PandocElement <$> Lua.peek idx)
- <|> (InlineElement <$> Lua.peek idx)
- <|> (BlockElement <$> Lua.peek idx)
- <|> (AttrElement <$> Lua.peek idx)
- <|> (ListAttributesElement <$> Lua.peek idx)
- <|> (MetaElement <$> Lua.peek idx)
- <|> (MetaValueElement <$> Lua.peek idx)
+ res <- try $ (PandocElement <$> Lua.peek idx)
+ <|> (InlineElement <$> Lua.peek idx)
+ <|> (BlockElement <$> Lua.peek idx)
+ <|> (AttrElement <$> Lua.peek idx)
+ <|> (ListAttributesElement <$> Lua.peek idx)
+ <|> (MetaElement <$> Lua.peek idx)
+ <|> (MetaValueElement <$> Lua.peek idx)
case res of
Right x -> return x
- Left _ -> Lua.throwException
+ Left (_ :: PandocError) -> Lua.throwMessage
"Expected an AST element, but could not parse value as such."
-- | Convert a number < 4000 to uppercase roman numeral.
-toRomanNumeral :: Lua.Integer -> Lua T.Text
+toRomanNumeral :: Lua.Integer -> PandocLua T.Text
toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral
diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs
index ad338f4bd..79d42a6d7 100644
--- a/src/Text/Pandoc/Lua/Packages.hs
+++ b/src/Text/Pandoc/Lua/Packages.hs
@@ -8,37 +8,32 @@
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
-Pandoc module for lua.
+Pandoc module for Lua.
-}
module Text.Pandoc.Lua.Packages
- ( LuaPackageParams (..)
- , installPandocPackageSearcher
+ ( installPandocPackageSearcher
) where
import Control.Monad (forM_)
import Data.ByteString (ByteString)
-import Foreign.Lua (Lua, NumResults, liftIO)
-import Text.Pandoc.Class.PandocIO (runIO)
-import Text.Pandoc.Class.PandocMonad (readDataFile, setUserDataDir)
+import Foreign.Lua (Lua, NumResults)
+import Text.Pandoc.Class.PandocMonad (readDataFile)
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)
import qualified Foreign.Lua as Lua
-import Text.Pandoc.Lua.Module.Pandoc as Pandoc
-import Text.Pandoc.Lua.Module.MediaBag as MediaBag
-import Text.Pandoc.Lua.Module.System as System
-import Text.Pandoc.Lua.Module.Types as Types
-import Text.Pandoc.Lua.Module.Utils as Utils
-
--- | Parameters used to create lua packages/modules.
-data LuaPackageParams = LuaPackageParams
- { luaPkgDataDir :: Maybe FilePath
- }
+import qualified Foreign.Lua.Module.Text as Text
+import qualified Text.Pandoc.Lua.Module.Pandoc as Pandoc
+import qualified Text.Pandoc.Lua.Module.MediaBag as MediaBag
+import qualified Text.Pandoc.Lua.Module.System as System
+import qualified Text.Pandoc.Lua.Module.Types as Types
+import qualified Text.Pandoc.Lua.Module.Utils as Utils
-- | Insert pandoc's package loader as the first loader, making it the default.
-installPandocPackageSearcher :: LuaPackageParams -> Lua ()
-installPandocPackageSearcher luaPkgParams = do
+installPandocPackageSearcher :: PandocLua ()
+installPandocPackageSearcher = liftPandocLua $ do
Lua.getglobal' "package.searchers"
shiftArray
- Lua.pushHaskellFunction (pandocPackageSearcher luaPkgParams)
+ Lua.pushHaskellFunction pandocPackageSearcher
Lua.rawseti (Lua.nthFromTop 2) 1
Lua.pop 1 -- remove 'package.searchers' from stack
where
@@ -47,29 +42,24 @@ installPandocPackageSearcher luaPkgParams = do
Lua.rawseti (-2) (i + 1)
-- | Load a pandoc module.
-pandocPackageSearcher :: LuaPackageParams -> String -> Lua NumResults
-pandocPackageSearcher pkgParams pkgName =
+pandocPackageSearcher :: String -> PandocLua NumResults
+pandocPackageSearcher pkgName =
case pkgName of
- "pandoc" -> let datadir = luaPkgDataDir pkgParams
- in pushWrappedHsFun (Pandoc.pushModule datadir)
+ "pandoc" -> pushWrappedHsFun Pandoc.pushModule
"pandoc.mediabag" -> pushWrappedHsFun MediaBag.pushModule
"pandoc.system" -> pushWrappedHsFun System.pushModule
"pandoc.types" -> pushWrappedHsFun Types.pushModule
- "pandoc.utils" -> let datadir = luaPkgDataDir pkgParams
- in pushWrappedHsFun (Utils.pushModule datadir)
- _ -> searchPureLuaLoader
+ "pandoc.utils" -> pushWrappedHsFun Utils.pushModule
+ "text" -> pushWrappedHsFun Text.pushModule
+ _ -> searchPureLuaLoader
where
- pushWrappedHsFun f = do
+ pushWrappedHsFun f = liftPandocLua $ do
Lua.pushHaskellFunction f
return 1
searchPureLuaLoader = do
let filename = pkgName ++ ".lua"
- modScript <- liftIO (dataDirScript (luaPkgDataDir pkgParams) filename)
- case modScript of
- Just script -> pushWrappedHsFun (loadStringAsPackage pkgName script)
- Nothing -> do
- Lua.push ("\n\tno file '" ++ filename ++ "' in pandoc's datadir")
- return 1
+ script <- readDataFile filename
+ pushWrappedHsFun (loadStringAsPackage pkgName script)
loadStringAsPackage :: String -> ByteString -> Lua NumResults
loadStringAsPackage pkgName script = do
@@ -79,11 +69,3 @@ loadStringAsPackage pkgName script = do
else do
msg <- Lua.popValue
Lua.raiseError ("Error while loading `" <> pkgName <> "`.\n" <> msg)
-
--- | Get the ByteString representation of the pandoc module.
-dataDirScript :: Maybe FilePath -> FilePath -> IO (Maybe ByteString)
-dataDirScript datadir moduleFile = do
- res <- runIO $ setUserDataDir datadir >> readDataFile moduleFile
- return $ case res of
- Left _ -> Nothing
- Right s -> Just s
diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs
new file mode 100644
index 000000000..6c3b410dd
--- /dev/null
+++ b/src/Text/Pandoc/Lua/PandocLua.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{- |
+ Module : Text.Pandoc.Lua.PandocLua
+ Copyright : Copyright © 2020 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+PandocMonad instance which allows execution of Lua operations and which
+uses Lua to handle state.
+-}
+module Text.Pandoc.Lua.PandocLua
+ ( PandocLua (..)
+ , runPandocLua
+ , liftPandocLua
+ , addFunction
+ , loadScriptFromDataDir
+ ) where
+
+import Control.Monad (when)
+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
+import Control.Monad.Except (MonadError (catchError, throwError))
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Foreign.Lua (Lua (..), NumResults, Pushable, ToHaskellFunction)
+import Text.Pandoc.Class.PandocIO (PandocIO)
+import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDataFile)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.Global (Global (..), setGlobals)
+import Text.Pandoc.Lua.ErrorConversion (errorConversion)
+
+import qualified Control.Monad.Catch as Catch
+import qualified Foreign.Lua as Lua
+import qualified Text.Pandoc.Class.IO as IO
+import qualified Text.Pandoc.Lua.Util as LuaUtil
+
+-- | Type providing access to both, pandoc and Lua operations.
+newtype PandocLua a = PandocLua { unPandocLua :: Lua a }
+ deriving
+ ( Applicative
+ , Functor
+ , Monad
+ , MonadCatch
+ , MonadIO
+ , MonadMask
+ , MonadThrow
+ )
+
+-- | Lift a @'Lua'@ operation into the @'PandocLua'@ type.
+liftPandocLua :: Lua a -> PandocLua a
+liftPandocLua = PandocLua
+
+-- | Evaluate a @'PandocLua'@ computation, running all contained Lua
+-- operations..
+runPandocLua :: PandocLua a -> PandocIO a
+runPandocLua pLua = do
+ origState <- getCommonState
+ globals <- defaultGlobals
+ (result, newState) <- liftIO . Lua.run' errorConversion . unPandocLua $ do
+ putCommonState origState
+ liftPandocLua $ setGlobals globals
+ r <- pLua
+ c <- getCommonState
+ return (r, c)
+ putCommonState newState
+ return result
+
+instance {-# OVERLAPPING #-} ToHaskellFunction (PandocLua NumResults) where
+ toHsFun _narg = unPandocLua
+
+instance Pushable a => ToHaskellFunction (PandocLua a) where
+ toHsFun _narg x = 1 <$ (unPandocLua x >>= Lua.push)
+
+-- | Add a function to the table at the top of the stack, using the given name.
+addFunction :: ToHaskellFunction a => String -> a -> PandocLua ()
+addFunction name fn = liftPandocLua $ do
+ Lua.push name
+ Lua.pushHaskellFunction fn
+ Lua.rawset (-3)
+
+-- | Load a file from pandoc's data directory.
+loadScriptFromDataDir :: FilePath -> PandocLua ()
+loadScriptFromDataDir scriptFile = do
+ script <- readDataFile scriptFile
+ status <- liftPandocLua $ Lua.dostring script
+ when (status /= Lua.OK) . liftPandocLua $
+ LuaUtil.throwTopMessageAsError'
+ (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
+
+-- | Global variables which should always be set.
+defaultGlobals :: PandocIO [Global]
+defaultGlobals = do
+ commonState <- getCommonState
+ return
+ [ PANDOC_API_VERSION
+ , PANDOC_STATE commonState
+ , PANDOC_VERSION
+ ]
+
+instance MonadError PandocError PandocLua where
+ catchError = Catch.catch
+ throwError = Catch.throwM
+
+instance PandocMonad PandocLua where
+ lookupEnv = IO.lookupEnv
+ getCurrentTime = IO.getCurrentTime
+ getCurrentTimeZone = IO.getCurrentTimeZone
+ newStdGen = IO.newStdGen
+ newUniqueHash = IO.newUniqueHash
+
+ openURL = IO.openURL
+
+ readFileLazy = IO.readFileLazy
+ readFileStrict = IO.readFileStrict
+
+ glob = IO.glob
+ fileExists = IO.fileExists
+ getDataFileName = IO.getDataFileName
+ getModificationTime = IO.getModificationTime
+
+ getCommonState = PandocLua $ do
+ Lua.getglobal "PANDOC_STATE"
+ Lua.peek Lua.stackTop
+ putCommonState = PandocLua . setGlobals . (:[]) . PANDOC_STATE
+
+ logOutput = IO.logOutput
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index d79fbb085..c6639e94c 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -19,7 +19,6 @@ module Text.Pandoc.Lua.Util
, addFunction
, addValue
, pushViaConstructor
- , loadScriptFromDataDir
, defineHowTo
, throwTopMessageAsError'
, callWithTraceback
@@ -27,13 +26,11 @@ module Text.Pandoc.Lua.Util
) where
import Control.Monad (unless, when)
+import Data.Text (Text)
import Foreign.Lua ( Lua, NumArgs, NumResults, Peekable, Pushable, StackIndex
, Status, ToHaskellFunction )
-import Text.Pandoc.Class.PandocIO (runIOorExplode)
-import Text.Pandoc.Class.PandocMonad (readDataFile, setUserDataDir)
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.UTF8 as UTF8
-import Data.Text (Text)
-- | Get value behind key from table at given index.
rawField :: Peekable a => StackIndex -> String -> Lua a
@@ -87,15 +84,6 @@ pushViaCall fn = pushViaCall' fn (return ()) 0
pushViaConstructor :: PushViaCall a => String -> a
pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)
--- | Load a file from pandoc's data directory.
-loadScriptFromDataDir :: Maybe FilePath -> FilePath -> Lua ()
-loadScriptFromDataDir datadir scriptFile = do
- script <- Lua.liftIO . runIOorExplode $
- setUserDataDir datadir >> readDataFile scriptFile
- status <- Lua.dostring script
- when (status /= Lua.OK) $
- throwTopMessageAsError' (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
-
-- | Get the tag of a value. This is an optimized and specialized version of
-- @Lua.getfield idx "tag"@. It only checks for the field on the table at index
-- @idx@ and on its metatable, also ignoring any @__index@ value on the
@@ -107,7 +95,7 @@ getTag idx = do
Lua.push ("tag" :: Text)
Lua.rawget (Lua.nthFromTop 2)
Lua.tostring Lua.stackTop <* Lua.pop 2 >>= \case
- Nothing -> Lua.throwException "untagged value"
+ Nothing -> Lua.throwMessage "untagged value"
Just x -> return (UTF8.toString x)
-- | Modify the message at the top of the stack before throwing it as an
@@ -116,11 +104,12 @@ throwTopMessageAsError' :: (String -> String) -> Lua a
throwTopMessageAsError' modifier = do
msg <- Lua.tostring' Lua.stackTop
Lua.pop 2 -- remove error and error string pushed by tostring'
- Lua.throwException (modifier (UTF8.toString msg))
+ Lua.throwMessage (modifier (UTF8.toString msg))
-- | Mark the context of a Lua computation for better error reporting.
defineHowTo :: String -> Lua a -> Lua a
-defineHowTo ctx = Lua.withExceptionMessage (("Could not " <> ctx <> ": ") <>)
+defineHowTo ctx op = Lua.errorConversion >>= \ec ->
+ Lua.addContextToException ec ("Could not " <> ctx <> ": ") op
-- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a
-- traceback on error.
@@ -143,7 +132,8 @@ pcallWithTraceback nargs nresults = do
callWithTraceback :: NumArgs -> NumResults -> Lua ()
callWithTraceback nargs nresults = do
result <- pcallWithTraceback nargs nresults
- when (result /= Lua.OK) Lua.throwTopMessage
+ when (result /= Lua.OK)
+ Lua.throwTopMessage
-- | Run the given string as a Lua program, while also adding a traceback to the
-- error message if an error occurs.
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 2be64d56f..50a013dfd 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -20,17 +20,14 @@ import Data.List (intersperse)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text, pack)
-import Data.Typeable
import Foreign.Lua (Lua, Pushable)
import Text.DocLayout (render, literal)
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Definition
-import Text.Pandoc.Lua (Global (..), LuaException (LuaException),
- runLua, setGlobals)
+import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate)
-import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Writers.Shared
import qualified Foreign.Lua as Lua
@@ -81,11 +78,6 @@ instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
Lua.push v
Lua.rawset (Lua.nthFromTop 3)
-data PandocLuaException = PandocLuaException Text
- deriving (Show, Typeable)
-
-instance Exception PandocLuaException
-
-- | Convert Pandoc to custom markup.
writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text
writeCustom luaFile opts doc@(Pandoc meta _) = do
@@ -97,21 +89,20 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
stat <- dofileWithTraceback luaFile
-- check for error in lua script (later we'll change the return type
-- to handle this more gracefully):
- when (stat /= Lua.OK) $
- Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toText
+ when (stat /= Lua.OK)
+ Lua.throwTopMessage
rendered <- docToCustom opts doc
context <- metaToContext opts
(fmap (literal . pack) . blockListToCustom)
(fmap (literal . pack) . inlineListToCustom)
meta
return (pack rendered, context)
- let (body, context) = case res of
- Left (LuaException msg) -> throw (PandocLuaException msg)
- Right x -> x
- return $
- case writerTemplate opts of
- Nothing -> body
- Just tpl -> render Nothing $
+ case res of
+ Left msg -> throw msg
+ Right (body, context) -> return $
+ case writerTemplate opts of
+ Nothing -> body
+ Just tpl -> render Nothing $
renderTemplate tpl $ setField "body" body context
docToCustom :: WriterOptions -> Pandoc -> Lua String
diff --git a/stack.yaml b/stack.yaml
index d6ae4eee7..9a94de053 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -23,6 +23,7 @@ extra-deps:
- regex-pcre-builtin-0.95.0.8.8.35
- doclayout-0.3
- emojis-0.1
+- hslua-1.1.0
- jira-wiki-markup-1.3.0
- HsYAML-0.2.0.0
- HsYAML-aeson-0.2.0.0
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
index 0943b17aa..14800f7bb 100644
--- a/test/Tests/Lua.hs
+++ b/test/Tests/Lua.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Tests.Lua
Copyright : © 2017-2020 Albert Krewinkel
@@ -28,11 +29,13 @@ import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
Attr, Meta, Pandoc, pandocTypesVersion)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters)
import Text.Pandoc.Lua (runLua)
import Text.Pandoc.Options (def)
import Text.Pandoc.Shared (pandocVersion)
+import qualified Control.Monad.Catch as Catch
import qualified Foreign.Lua as Lua
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -197,12 +200,13 @@ tests = map (localOption (QuickCheckTests 20))
, testCase "informative error messages" . runLuaTest $ do
Lua.pushboolean True
- err <- Lua.peekEither Lua.stackTop
- case (err :: Either String Pandoc) of
- Left msg -> do
+ eitherPandoc <- Catch.try (Lua.peek Lua.stackTop :: Lua.Lua Pandoc)
+ case eitherPandoc of
+ Left (PandocLuaError msg) -> do
let expectedMsg = "Could not get Pandoc value: "
<> "table expected, got boolean"
Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
+ Left e -> error ("Expected a Lua error, but got " <> show e)
Right _ -> error "Getting a Pandoc element from a bool should fail."
]
@@ -223,10 +227,7 @@ roundtripEqual x = (x ==) <$> roundtripped
size <- Lua.gettop
when (size - oldSize /= 1) $
error ("not exactly one additional element on the stack: " ++ show size)
- res <- Lua.peekEither (-1)
- case res of
- Left e -> error (show e)
- Right y -> return y
+ Lua.peek (-1)
runLuaTest :: Lua.Lua a -> IO a
runLuaTest op = runIOorExplode $ do
diff --git a/test/lua/module/pandoc-types.lua b/test/lua/module/pandoc-types.lua
index 880dd567e..d4e063a5c 100644
--- a/test/lua/module/pandoc-types.lua
+++ b/test/lua/module/pandoc-types.lua
@@ -26,10 +26,9 @@ return {
)
end),
test('non-version string is rejected', function ()
- assert.error_matches(
- function () Version '11friends' end,
- '11friends'
- )
+ local success, msg = pcall(function () Version '11friends' end)
+ assert.is_falsy(success)
+ assert.is_truthy(tostring(msg):match('11friends'))
end)
},