Lua: cleanup Lua utils, remove unused functions.

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

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

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

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

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.