From 9abdbb2783d246c736f05119390e81084f9ab07c Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Mon, 1 Oct 2018 16:10:46 +0200
Subject: 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.
---
 src/Text/Pandoc/Lua/Util.hs | 38 ++++++++++++++++++++++++++++++++++++--
 1 file changed, 36 insertions(+), 2 deletions(-)

(limited to 'src/Text/Pandoc/Lua/Util.hs')

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
-- 
cgit v1.2.3