aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Lua.hs16
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs9
-rw-r--r--src/Text/Pandoc/Lua/StackInstances.hs56
-rw-r--r--src/Text/Pandoc/Lua/Util.hs84
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs14
5 files changed, 75 insertions, 104 deletions
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index cd7117074..be448cf48 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -34,14 +34,14 @@ module Text.Pandoc.Lua
import Prelude
import Control.Monad ((>=>))
-import Foreign.Lua (FromLuaStack (peek), Lua, LuaException (..),
- Status (OK), ToLuaStack (push))
+import Foreign.Lua (Lua, LuaException (..))
import Text.Pandoc.Class (PandocIO)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter)
import Text.Pandoc.Lua.Init (runPandocLua, registerScriptPath)
import Text.Pandoc.Lua.Util (popValue)
import Text.Pandoc.Options (ReaderOptions)
+
import qualified Foreign.Lua as Lua
-- | Run the Lua filter in @filterPath@ for a transformation to target
@@ -60,25 +60,23 @@ runLuaFilter' ropts filterPath format pd = do
registerScriptPath filterPath
top <- Lua.gettop
stat <- Lua.dofile filterPath
- if stat /= OK
- then do
- luaErrMsg <- popValue
- Lua.throwLuaError luaErrMsg
+ if stat /= Lua.OK
+ then Lua.throwTopMessageAsError
else do
newtop <- Lua.gettop
-- Use the returned filters, or the implicitly defined global filter if
-- nothing was returned.
luaFilters <- if newtop - top >= 1
- then peek (-1)
+ then Lua.peek Lua.stackTop
else Lua.getglobal "_G" *> fmap (:[]) popValue
runAll luaFilters pd
where
registerFormat = do
- push format
+ Lua.push format
Lua.setglobal "FORMAT"
registerReaderOptions = do
- push ropts
+ Lua.push ropts
Lua.setglobal "PANDOC_READER_OPTIONS"
runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index 8cb630d7b..ca337941f 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -42,7 +42,7 @@ import Text.Pandoc.Class (runIO)
import Text.Pandoc.Definition (Block, Inline)
import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter)
import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Lua.Util (addFunction, addValue, loadScriptFromDataDir)
+import Text.Pandoc.Lua.Util (addFunction, loadScriptFromDataDir)
import Text.Pandoc.Walk (Walkable)
import Text.Pandoc.Options (ReaderOptions (readerExtensions))
import Text.Pandoc.Process (pipeProcess)
@@ -51,6 +51,7 @@ import Text.Pandoc.Readers (Reader (..), getReader)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Foreign.Lua as Lua
+import qualified Text.Pandoc.Lua.Util as LuaUtil
-- | Push the "pandoc" on the lua stack. Requires the `list` module to be
-- loaded.
@@ -114,9 +115,9 @@ instance FromLuaStack PipeError where
instance ToLuaStack PipeError where
push pipeErr = do
Lua.newtable
- addValue "command" (pipeErrorCommand pipeErr)
- addValue "error_code" (pipeErrorCode pipeErr)
- addValue "output" (pipeErrorOutput pipeErr)
+ LuaUtil.addField "command" (pipeErrorCommand pipeErr)
+ LuaUtil.addField "error_code" (pipeErrorCode pipeErr)
+ LuaUtil.addField "output" (pipeErrorOutput pipeErr)
pushPipeErrorMetaTable
Lua.setmetatable (-2)
where
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index 3298079c5..9c3b40f12 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -44,7 +44,7 @@ import Foreign.Lua (FromLuaStack (peek), Lua, LuaInteger, LuaNumber, StackIndex,
ToLuaStack (push), Type (..), throwLuaError, tryLua)
import Text.Pandoc.Definition
import Text.Pandoc.Extensions (Extensions)
-import Text.Pandoc.Lua.Util (getTable, getTag, pushViaConstructor, typeCheck)
+import Text.Pandoc.Lua.Util (pushViaConstructor, typeCheck)
import Text.Pandoc.Options (ReaderOptions (..), TrackChanges)
import Text.Pandoc.Shared (Element (Blk, Sec), safeRead)
@@ -62,7 +62,7 @@ instance ToLuaStack Pandoc where
instance FromLuaStack Pandoc where
peek idx = defineHowTo "get Pandoc value" $ do
typeCheck idx Lua.TypeTable
- blocks <- getTable idx "blocks"
+ blocks <- LuaUtil.rawField idx "blocks"
meta <- Lua.getfield idx "meta" *> (Lua.peek Lua.stackTop `finally` Lua.pop 1)
return $ Pandoc meta blocks
@@ -99,12 +99,12 @@ instance ToLuaStack Citation where
instance FromLuaStack Citation where
peek idx = do
- id' <- getTable idx "id"
- prefix <- getTable idx "prefix"
- suffix <- getTable idx "suffix"
- mode <- getTable idx "mode"
- num <- getTable idx "note_num"
- hash <- getTable idx "hash"
+ id' <- LuaUtil.rawField idx "id"
+ prefix <- LuaUtil.rawField idx "prefix"
+ suffix <- LuaUtil.rawField idx "suffix"
+ mode <- LuaUtil.rawField idx "mode"
+ num <- LuaUtil.rawField idx "note_num"
+ hash <- LuaUtil.rawField idx "hash"
return $ Citation id' prefix suffix mode num hash
instance ToLuaStack Alignment where
@@ -178,7 +178,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
TypeBoolean -> MetaBool <$> peek idx
TypeString -> MetaString <$> peek idx
TypeTable -> do
- tag <- tryLua $ getTag idx
+ tag <- tryLua $ LuaUtil.getTag idx
case tag of
Right "MetaBlocks" -> MetaBlocks <$> elementContent
Right "MetaBool" -> MetaBool <$> elementContent
@@ -220,7 +220,7 @@ pushBlock = \case
peekBlock :: StackIndex -> Lua Block
peekBlock idx = defineHowTo "get Block value" $ do
typeCheck idx Lua.TypeTable
- tag <- getTag idx
+ tag <- LuaUtil.getTag idx
case tag of
"BlockQuote" -> BlockQuote <$> elementContent
"BulletList" -> BulletList <$> elementContent
@@ -243,7 +243,7 @@ peekBlock idx = defineHowTo "get Block value" $ do
where
-- Get the contents of an AST element.
elementContent :: FromLuaStack a => Lua a
- elementContent = getTable idx "c"
+ elementContent = LuaUtil.rawField idx "c"
-- | Push an inline element to the top of the lua stack.
pushInline :: Inline -> Lua ()
@@ -272,7 +272,7 @@ pushInline = \case
peekInline :: StackIndex -> Lua Inline
peekInline idx = defineHowTo "get Inline value" $ do
typeCheck idx Lua.TypeTable
- tag <- getTag idx
+ tag <- LuaUtil.getTag idx
case tag of
"Cite" -> uncurry Cite <$> elementContent
"Code" -> withAttr Code <$> elementContent
@@ -299,7 +299,7 @@ peekInline idx = defineHowTo "get Inline value" $ do
where
-- Get the contents of an AST element.
elementContent :: FromLuaStack a => Lua a
- elementContent = getTable idx "c"
+ elementContent = LuaUtil.rawField idx "c"
withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr f (attributes, x) = f (fromLuaAttr attributes) x
@@ -321,11 +321,11 @@ instance ToLuaStack Element where
push (Blk blk) = push blk
push (Sec lvl num attr label contents) = do
Lua.newtable
- LuaUtil.addValue "level" lvl
- LuaUtil.addValue "numbering" num
- LuaUtil.addValue "attr" (LuaAttr attr)
- LuaUtil.addValue "label" label
- LuaUtil.addValue "contents" contents
+ LuaUtil.addField "level" lvl
+ LuaUtil.addField "numbering" num
+ LuaUtil.addField "attr" (LuaAttr attr)
+ LuaUtil.addField "label" label
+ LuaUtil.addField "contents" contents
pushSecMetaTable
Lua.setmetatable (-2)
where
@@ -333,7 +333,7 @@ instance ToLuaStack Element where
pushSecMetaTable = do
inexistant <- Lua.newmetatable "PandocElementSec"
when inexistant $ do
- LuaUtil.addValue "t" "Sec"
+ LuaUtil.addField "t" "Sec"
Lua.push "__index"
Lua.pushvalue (-2)
Lua.rawset (-3)
@@ -367,12 +367,12 @@ instance ToLuaStack ReaderOptions where
(stripComments :: Bool)
= ro
Lua.newtable
- LuaUtil.addValue "extensions" extensions
- LuaUtil.addValue "standalone" standalone
- LuaUtil.addValue "columns" columns
- LuaUtil.addValue "tabStop" tabStop
- LuaUtil.addValue "indentedCodeClasses" indentedCodeClasses
- LuaUtil.addValue "abbreviations" abbreviations
- LuaUtil.addValue "defaultImageExtension" defaultImageExtension
- LuaUtil.addValue "trackChanges" trackChanges
- LuaUtil.addValue "stripComments" stripComments
+ LuaUtil.addField "extensions" extensions
+ LuaUtil.addField "standalone" standalone
+ LuaUtil.addField "columns" columns
+ LuaUtil.addField "tabStop" tabStop
+ LuaUtil.addField "indentedCodeClasses" indentedCodeClasses
+ LuaUtil.addField "abbreviations" abbreviations
+ LuaUtil.addField "defaultImageExtension" defaultImageExtension
+ LuaUtil.addField "trackChanges" trackChanges
+ LuaUtil.addField "stripComments" stripComments
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index ea9ec2554..c12884a10 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -31,14 +31,11 @@ Lua utility functions.
-}
module Text.Pandoc.Lua.Util
( getTag
- , getTable
- , addValue
+ , rawField
+ , addField
, addFunction
- , getRawInt
- , setRawInt
- , addRawInt
+ , addValue
, typeCheck
- , raiseError
, popValue
, PushViaCall
, pushViaCall
@@ -51,34 +48,30 @@ import Prelude
import Control.Monad (when)
import Control.Monad.Catch (finally)
import Data.ByteString.Char8 (unpack)
-import Foreign.Lua (FromLuaStack (..), NumResults, Lua, NumArgs, StackIndex,
- ToLuaStack (..), ToHaskellFunction)
-import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti)
+import Foreign.Lua (FromLuaStack, Lua, NumArgs, StackIndex, Status,
+ ToLuaStack, ToHaskellFunction)
import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
import qualified Foreign.Lua as Lua
--- | Adjust the stack index, assuming that @n@ new elements have been pushed on
--- the stack.
-adjustIndexBy :: StackIndex -> StackIndex -> StackIndex
-adjustIndexBy idx n =
- if idx < 0
- then idx - n
- else idx
-
-- | Get value behind key from table at given index.
-getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b
-getTable idx key = do
- push key
- rawget (idx `adjustIndexBy` 1)
+rawField :: FromLuaStack a => StackIndex -> String -> Lua a
+rawField idx key = do
+ absidx <- Lua.absindex idx
+ Lua.push key
+ Lua.rawget absidx
popValue
+-- | Add a value to the table at the top of the stack at a string-index.
+addField :: ToLuaStack a => String -> a -> Lua ()
+addField = addValue
+
-- | Add a key-value pair to the table at the top of the stack.
addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
addValue key value = do
- push key
- push value
- rawset (-3)
+ Lua.push key
+ Lua.push value
+ Lua.rawset (Lua.nthFromTop 3)
-- | Add a function to the table at the top of the stack, using the given name.
addFunction :: ToHaskellFunction a => String -> a -> Lua ()
@@ -88,22 +81,6 @@ addFunction name fn = do
Lua.wrapHaskellFunction
Lua.rawset (-3)
--- | Get value behind key from table at given index.
-getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a
-getRawInt idx key = do
- rawgeti idx key
- popValue
-
--- | Set numeric key/value in table at the given index
-setRawInt :: ToLuaStack a => StackIndex -> Int -> a -> Lua ()
-setRawInt idx key value = do
- push value
- rawseti (idx `adjustIndexBy` 1) key
-
--- | Set numeric key/value in table at the top of the stack.
-addRawInt :: ToLuaStack a => Int -> a -> Lua ()
-addRawInt = setRawInt (-1)
-
typeCheck :: StackIndex -> Lua.Type -> Lua ()
typeCheck idx expected = do
actual <- Lua.ltype idx
@@ -112,16 +89,11 @@ typeCheck idx expected = do
actName <- Lua.typename actual
Lua.throwLuaError $ "expected " ++ expName ++ " but got " ++ actName ++ "."
-raiseError :: ToLuaStack a => a -> Lua NumResults
-raiseError e = do
- Lua.push e
- fromIntegral <$> Lua.lerror
-
-- | Get, then pop the value at the top of the stack.
popValue :: FromLuaStack a => Lua a
popValue = do
resOrError <- Lua.peekEither (-1)
- pop 1
+ Lua.pop 1
case resOrError of
Left err -> Lua.throwLuaError err
Right x -> return x
@@ -136,11 +108,11 @@ instance PushViaCall (Lua ()) where
Lua.push fn
Lua.rawget Lua.registryindex
pushArgs
- call num 1
+ Lua.call num 1
instance (ToLuaStack a, PushViaCall b) => PushViaCall (a -> b) where
pushViaCall' fn pushArgs num x =
- pushViaCall' fn (pushArgs *> push x) (num + 1)
+ pushViaCall' fn (pushArgs *> Lua.push x) (num + 1)
-- | Push an value to the stack via a lua function. The lua function is called
-- with all arguments that are passed to this function and is expected to return
@@ -163,9 +135,9 @@ loadScriptFromDataDir datadir scriptFile = do
"Couldn't load '" ++ scriptFile ++ "'.\n" ++ msg
-- | Load a string and immediately perform a full garbage collection. This is
--- important to keep the program from hanging: If the program contained a call
--- to @require@, the a new loader function was created which then become
--- garbage. If that function is collected at an inopportune times, i.e. when the
+-- important to keep the program from hanging: If the program containes a call
+-- to @require@, then a new loader function is created which then becomes
+-- garbage. If that function is collected at an inopportune time, i.e. when the
-- Lua API is called via a function that doesn't allow calling back into Haskell
-- (getraw, setraw, …), then the function's finalizer, and the full program,
-- will hang.
@@ -182,8 +154,8 @@ dostring' script = do
-- metatable.
getTag :: StackIndex -> Lua String
getTag idx = do
- top <- Lua.gettop
- hasMT <- Lua.getmetatable idx
- push "tag"
- if hasMT then Lua.rawget (-2) else Lua.rawget (idx `adjustIndexBy` 1)
- peek Lua.stackTop `finally` Lua.settop top
+ -- push metatable or just the table
+ Lua.getmetatable idx >>= \hasMT -> when (not hasMT) (Lua.pushvalue idx)
+ Lua.push "tag"
+ Lua.rawget (Lua.nthFromTop 2)
+ Lua.peek Lua.stackTop `finally` Lua.pop 2
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index c0940ad78..866df85be 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -48,7 +48,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Error
import Text.Pandoc.Lua.Init (runPandocLua, registerScriptPath)
import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Lua.Util (addValue, dostring')
+import Text.Pandoc.Lua.Util (addField, addValue, dostring')
import Text.Pandoc.Options
import Text.Pandoc.Templates
import qualified Text.Pandoc.UTF8 as UTF8
@@ -82,12 +82,12 @@ instance ToLuaStack (Stringify MetaValue) where
instance ToLuaStack (Stringify Citation) where
push (Stringify cit) = do
createtable 6 0
- addValue "citationId" $ citationId cit
- addValue "citationPrefix" . Stringify $ citationPrefix cit
- addValue "citationSuffix" . Stringify $ citationSuffix cit
- addValue "citationMode" $ show (citationMode cit)
- addValue "citationNoteNum" $ citationNoteNum cit
- addValue "citationHash" $ citationHash cit
+ addField "citationId" $ citationId cit
+ addField "citationPrefix" . Stringify $ citationPrefix cit
+ addField "citationSuffix" . Stringify $ citationSuffix cit
+ addField "citationMode" $ show (citationMode cit)
+ addField "citationNoteNum" $ citationNoteNum cit
+ addField "citationHash" $ citationHash cit
-- | Key-value pair, pushed as a table with @a@ as the only key and @v@ as the
-- associated value.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 12:29:21 +0000