Lua filters: report traceback when an error occurs

A proper Lua traceback is added if either loading of a file or execution
of a filter function fails. This should be of help to authors of Lua
filters who need to debug their code.

4 files changed, 44 insertions, 10 deletions

diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index c4e5791b6..e160f7123 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -39,6 +39,7 @@ import Text.Pandoc.Class (PandocIO)
 import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter)
 import Text.Pandoc.Lua.Init (LuaException (..), runPandocLua, registerScriptPath)
+import Text.Pandoc.Lua.Util (dofileWithTraceback)
 import Text.Pandoc.Options (ReaderOptions)
 
 import qualified Foreign.Lua as Lua
@@ -58,7 +59,7 @@ runLuaFilter' ropts filterPath format pd = do
   registerReaderOptions
   registerScriptPath filterPath
   top <- Lua.gettop
-  stat <- Lua.dofile filterPath
+  stat <- dofileWithTraceback filterPath
   if stat /= Lua.OK
     then Lua.throwTopMessage
     else do
diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs
index 9b5f5f40a..d17f9a969 100644
--- a/src/Text/Pandoc/Lua/Filter.hs
+++ b/src/Text/Pandoc/Lua/Filter.hs
@@ -52,6 +52,7 @@ import Text.Pandoc.Walk (walkM, Walkable)
 
 import qualified Data.Map.Strict as Map
 import qualified Foreign.Lua as Lua
+import qualified Text.Pandoc.Lua.Util as LuaUtil
 
 -- | Filter function stored in the registry
 newtype LuaFilterFunction = LuaFilterFunction Lua.Reference
@@ -118,11 +119,9 @@ tryFilter (LuaFilter fnMap) x =
 -- element is left unchanged.
 runFilterFunction :: Pushable a => LuaFilterFunction -> a -> Lua ()
 runFilterFunction lf x = do
-  let errorPrefix = "Error while running filter function:\n"
-  Lua.withExceptionMessage (errorPrefix <>) $ do
-    pushFilterFunction lf
-    Lua.push x
-    Lua.call 1 1
+  pushFilterFunction lf
+  Lua.push x
+  LuaUtil.callWithTraceback 1 1
 
 walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
 walkMWithLuaFilter f =
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 89db9520d..77b27b88e 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -40,12 +40,14 @@ module Text.Pandoc.Lua.Util
   , loadScriptFromDataDir
   , defineHowTo
   , throwTopMessageAsError'
+  , callWithTraceback
+  , dofileWithTraceback
   ) where
 
 import Prelude
 import Control.Monad (unless, when)
-import Foreign.Lua ( Lua, NumArgs, Peekable, Pushable, StackIndex
-                   , ToHaskellFunction )
+import Foreign.Lua ( Lua, NumArgs, NumResults, Peekable, Pushable, StackIndex
+                   , Status, ToHaskellFunction )
 import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
 
 import qualified Foreign.Lua as Lua
@@ -137,3 +139,35 @@ throwTopMessageAsError' modifier = do
 -- | Mark the context of a Lua computation for better error reporting.
 defineHowTo :: String -> Lua a -> Lua a
 defineHowTo ctx = Lua.withExceptionMessage (("Could not " <> ctx <> ": ") <>)
+
+-- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a
+-- traceback on error.
+pcallWithTraceback :: NumArgs -> NumResults -> Lua Status
+pcallWithTraceback nargs nresults = do
+  let traceback' :: Lua NumResults
+      traceback' = do
+        l <- Lua.state
+        msg <- Lua.tostring' (Lua.nthFromBottom 1)
+        Lua.traceback l (Just (UTF8.toString msg)) 2
+        return 1
+  tracebackIdx <- Lua.absindex (Lua.nthFromTop (Lua.fromNumArgs nargs + 1))
+  Lua.pushHaskellFunction traceback'
+  Lua.insert tracebackIdx
+  result <- Lua.pcall nargs nresults (Just tracebackIdx)
+  Lua.remove tracebackIdx
+  return result
+
+-- | Like @'Lua.call'@, but adds a traceback to the error message (if any).
+callWithTraceback :: NumArgs -> NumResults -> Lua ()
+callWithTraceback nargs nresults = do
+  result <- pcallWithTraceback nargs nresults
+  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.
+dofileWithTraceback :: FilePath -> Lua Status
+dofileWithTraceback fp = do
+  loadRes <- Lua.loadfile fp
+  case loadRes of
+    Lua.OK -> pcallWithTraceback 0 Lua.multret
+    _ -> return loadRes
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 1d1261baf..37fec9f0f 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -47,7 +47,7 @@ import Text.Pandoc.Error
 import Text.Pandoc.Lua.Init (LuaException (LuaException), runPandocLua,
                              registerScriptPath)
 import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Lua.Util (addField)
+import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
 import Text.Pandoc.Options
 import Text.Pandoc.Templates
 import qualified Text.Pandoc.UTF8 as UTF8
@@ -111,7 +111,7 @@ writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text
 writeCustom luaFile opts doc@(Pandoc meta _) = do
   res <- runPandocLua $ do
     registerScriptPath luaFile
-    stat <- Lua.dofile luaFile
+    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) $