Lua: move getTag from StackInstances to Util

Change: minor

src/Text/Pandoc/Lua/StackInstances.hs

@@ -42,8 +42,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 (adjustIndexBy, getTable, pushViaConstructor,
-                             typeCheck)
+import Text.Pandoc.Lua.Util (getTable, getTag, pushViaConstructor, typeCheck)
 import Text.Pandoc.Options (ReaderOptions (..), TrackChanges)
 import Text.Pandoc.Shared (Element (Blk, Sec), safeRead)
 
@@ -300,14 +299,6 @@ peekInline idx = defineHowTo "get Inline value" $ do
    elementContent :: FromLuaStack a => Lua a
    elementContent = getTable idx "c"
 
-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
-
 withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
 withAttr f (attributes, x) = f (fromLuaAttr attributes) x
 

src/Text/Pandoc/Lua/Util.hs

@@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Lua utility functions.
 -}
 module Text.Pandoc.Lua.Util
-  ( adjustIndexBy
+  ( getTag
   , getTable
   , addValue
   , addFunction
@@ -47,6 +47,7 @@ module Text.Pandoc.Lua.Util
   ) where
 
 import Control.Monad (when)
+import Control.Monad.Catch (finally)
 import Data.ByteString.Char8 (unpack)
 import Foreign.Lua (FromLuaStack (..), NumResults, Lua, NumArgs, StackIndex,
                     ToLuaStack (..), ToHaskellFunction, getglobal')
@@ -163,11 +164,23 @@ loadScriptFromDataDir datadir scriptFile = do
 -- 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
 -- Lua API is called via a function that doesn't allow calling back into Haskell
--- (getraw, setraw, …). The function's finalizer, and the full program, hangs
--- when that happens.
+-- (getraw, setraw, …), then the function's finalizer, and the full program,
+-- will hang.
 dostring' :: String -> Lua Status
 dostring' script = do
   loadRes <- Lua.loadstring script
   if loadRes == Lua.OK
     then Lua.pcall 0 1 Nothing <* Lua.gc Lua.GCCOLLECT 0
     else return loadRes
+
+-- | 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
+-- 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