aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Lua/Init.hs18
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs8
-rw-r--r--src/Text/Pandoc/Lua/Packages.hs33
-rw-r--r--src/Text/Pandoc/Lua/PandocLua.hs31
4 files changed, 44 insertions, 46 deletions
diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs
index 0a5ce85cb..baa6f0295 100644
--- a/src/Text/Pandoc/Lua/Init.hs
+++ b/src/Text/Pandoc/Lua/Init.hs
@@ -12,17 +12,18 @@ module Text.Pandoc.Lua.Init
( runLua
) where
+import Control.Monad (when)
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.PandocMonad (readDataFile)
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)
-import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,
- loadScriptFromDataDir, runPandocLua)
-
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, runPandocLua)
+import Text.Pandoc.Lua.Util (throwTopMessageAsError')
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Definition as Pandoc
import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc
@@ -44,7 +45,7 @@ initLuaState = do
liftPandocLua Lua.openlibs
installPandocPackageSearcher
initPandocModule
- loadScriptFromDataDir "init.lua"
+ loadInitScript "init.lua"
where
initPandocModule :: PandocLua ()
initPandocModule = do
@@ -61,6 +62,15 @@ initLuaState = do
-- assign module to global variable
liftPandocLua $ Lua.setglobal "pandoc"
+ loadInitScript :: FilePath -> PandocLua ()
+ loadInitScript scriptFile = do
+ script <- readDataFile scriptFile
+ status <- liftPandocLua $ Lua.dostring script
+ when (status /= Lua.OK) . liftPandocLua $
+ throwTopMessageAsError'
+ (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
+
+
-- | AST elements are marshaled via normal constructor functions in the
-- @pandoc@ module. However, accessing Lua globals from Haskell is
-- expensive (due to error handling). Accessing the Lua registry is much
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index a9ce3866d..a8afecd2e 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -25,7 +25,7 @@ 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)
+ loadDefaultModule)
import Text.Pandoc.Walk (Walkable)
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
import Text.Pandoc.Process (pipeProcess)
@@ -38,11 +38,11 @@ import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
import Text.Pandoc.Error
--- | Push the "pandoc" on the lua stack. Requires the `list` module to be
--- loaded.
+-- | Push the "pandoc" package to the Lua stack. Requires the `List`
+-- module to be loadable.
pushModule :: PandocLua NumResults
pushModule = do
- loadScriptFromDataDir "pandoc.lua"
+ loadDefaultModule "pandoc"
addFunction "read" readDoc
addFunction "pipe" pipeFn
addFunction "walk_block" walkBlock
diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs
index d62fb725d..5949a1a7d 100644
--- a/src/Text/Pandoc/Lua/Packages.hs
+++ b/src/Text/Pandoc/Lua/Packages.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Lua.Packages
Copyright : Copyright © 2017-2021 Albert Krewinkel
@@ -15,13 +12,9 @@ module Text.Pandoc.Lua.Packages
( installPandocPackageSearcher
) where
-import Control.Monad.Catch (try)
import Control.Monad (forM_)
-import Data.ByteString (ByteString)
-import Foreign.Lua (Lua, NumResults)
-import Text.Pandoc.Error (PandocError)
-import Text.Pandoc.Class.PandocMonad (readDataFile)
-import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)
+import Foreign.Lua (NumResults)
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua, loadDefaultModule)
import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Module.Text as Text
@@ -54,24 +47,12 @@ pandocPackageSearcher pkgName =
"pandoc.types" -> pushWrappedHsFun Types.pushModule
"pandoc.utils" -> pushWrappedHsFun Utils.pushModule
"text" -> pushWrappedHsFun Text.pushModule
- _ -> searchPureLuaLoader
+ "pandoc.List" -> pushWrappedHsFun (loadDefaultModule pkgName)
+ _ -> reportPandocSearcherFailure
where
pushWrappedHsFun f = liftPandocLua $ do
Lua.pushHaskellFunction f
return 1
- searchPureLuaLoader = do
- let filename = pkgName ++ ".lua"
- try (readDataFile filename) >>= \case
- Right script -> pushWrappedHsFun (loadStringAsPackage pkgName script)
- Left (_ :: PandocError) -> liftPandocLua $ do
- Lua.push ("\n\tno file '" ++ filename ++ "' in pandoc's datadir")
- return (1 :: NumResults)
-
-loadStringAsPackage :: String -> ByteString -> Lua NumResults
-loadStringAsPackage pkgName script = do
- status <- Lua.dostring script
- if status == Lua.OK
- then return (1 :: NumResults)
- else do
- msg <- Lua.popValue
- Lua.raiseError ("Error while loading `" <> pkgName <> "`.\n" <> msg)
+ reportPandocSearcherFailure = liftPandocLua $ do
+ Lua.push ("\n\t" <> pkgName <> "is not one of pandoc's default packages")
+ return (1 :: NumResults)
diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs
index 4beac22b7..750e019b6 100644
--- a/src/Text/Pandoc/Lua/PandocLua.hs
+++ b/src/Text/Pandoc/Lua/PandocLua.hs
@@ -23,24 +23,23 @@ module Text.Pandoc.Lua.PandocLua
, runPandocLua
, liftPandocLua
, addFunction
- , loadScriptFromDataDir
+ , loadDefaultModule
) 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.Class.PandocMonad (PandocMonad (..), readDefaultDataFile)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.ErrorConversion (errorConversion)
import qualified Control.Monad.Catch as Catch
+import qualified Data.Text as T
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 }
@@ -86,14 +85,22 @@ addFunction name fn = liftPandocLua $ do
Lua.pushHaskellFunction fn
Lua.rawset (-3)
--- | Load a file from pandoc's data directory.
-loadScriptFromDataDir :: FilePath -> PandocLua ()
-loadScriptFromDataDir scriptFile = do
- script <- readDataFile scriptFile
+-- | Load a pure Lua module included with pandoc. Leaves the result on
+-- the stack and returns @NumResults 1@.
+--
+-- The script is loaded from the default data directory. We do not load
+-- from data directories supplied via command line, as this could cause
+-- scripts to be executed even though they had not been passed explicitly.
+loadDefaultModule :: String -> PandocLua NumResults
+loadDefaultModule name = do
+ script <- readDefaultDataFile (name <> ".lua")
status <- liftPandocLua $ Lua.dostring script
- when (status /= Lua.OK) . liftPandocLua $
- LuaUtil.throwTopMessageAsError'
- (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
+ if status == Lua.OK
+ then return (1 :: NumResults)
+ else do
+ msg <- liftPandocLua Lua.popValue
+ let err = "Error while loading `" <> name <> "`.\n" <> msg
+ throwError $ PandocLuaError (T.pack err)
-- | Global variables which should always be set.
defaultGlobals :: PandocIO [Global]