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: [PATCH] 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.
---
 pandoc.cabal                      |  2 +-
 src/Text/Pandoc/Lua.hs            |  3 ++-
 src/Text/Pandoc/Lua/Filter.hs     |  9 ++++----
 src/Text/Pandoc/Lua/Util.hs       | 38 +++++++++++++++++++++++++++++--
 src/Text/Pandoc/Writers/Custom.hs |  4 ++--
 stack.lts10.yaml                  |  3 +--
 stack.lts11.yaml                  |  2 +-
 stack.lts9.yaml                   |  2 +-
 stack.yaml                        |  2 +-
 9 files changed, 49 insertions(+), 16 deletions(-)

diff --git a/pandoc.cabal b/pandoc.cabal
index cf3590681..888a0570b 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -372,7 +372,7 @@ library
                  blaze-html >= 0.9 && < 0.10,
                  blaze-markup >= 0.8 && < 0.9,
                  vector >= 0.10 && < 0.13,
-                 hslua >= 1.0 && < 1.1,
+                 hslua >= 1.0.1 && < 1.1,
                  hslua-module-text >= 0.2 && < 0.3,
                  binary >= 0.5 && < 0.10,
                  SHA >= 1.6 && < 1.7,
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) $
diff --git a/stack.lts10.yaml b/stack.lts10.yaml
index 8ae75405b..76fc3b921 100644
--- a/stack.lts10.yaml
+++ b/stack.lts10.yaml
@@ -19,13 +19,12 @@ extra-deps:
 - test-framework-0.8.2.0
 - pandoc-types-1.17.5.1
 - cmark-gfm-0.1.3
-- hslua-module-text-0.1.2.1
 - texmath-0.11.1
 - haddock-library-1.6.0
 - HsYAML-0.1.1.1
 - text-1.2.3.0
 - hs-bibutils-6.6.0.0
-- hslua-1.0.0
+- hslua-1.0.1
 - hslua-module-text-0.2.0
 ghc-options:
    "$locals": -fhide-source-paths -XNoImplicitPrelude
diff --git a/stack.lts11.yaml b/stack.lts11.yaml
index 57a183552..afacb655f 100644
--- a/stack.lts11.yaml
+++ b/stack.lts11.yaml
@@ -20,7 +20,7 @@ extra-deps:
 - HsYAML-0.1.1.1
 - hs-bibutils-6.6.0.0
 - yaml-0.9.0
-- hslua-1.0.0
+- hslua-1.0.1
 - hslua-module-text-0.2.0
 ghc-options:
    "$locals": -fhide-source-paths -XNoImplicitPrelude
diff --git a/stack.lts9.yaml b/stack.lts9.yaml
index c09b318a0..b12cd57dc 100644
--- a/stack.lts9.yaml
+++ b/stack.lts9.yaml
@@ -12,7 +12,7 @@ packages:
 - '.'
 extra-deps:
 - pandoc-citeproc-0.14.4
-- hslua-1.0.0
+- hslua-1.0.1
 - hslua-module-text-0.2.0
 - ansi-terminal-0.8.0.2
 - cmark-gfm-0.1.3
diff --git a/stack.yaml b/stack.yaml
index 36c5ee105..986cae642 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -24,7 +24,7 @@ extra-deps:
 - HsYAML-0.1.1.1
 - texmath-0.11.1
 - yaml-0.9.0
-- hslua-1.0.0
+- hslua-1.0.1
 - hslua-module-text-0.2.0
 ghc-options:
    "$locals": -fhide-source-paths -XNoImplicitPrelude