Lua filters: improve error messages

Provide more context about the task which caused an error.

3 files changed, 34 insertions, 15 deletions

diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs
index 9e109bb52..cc2b9d47e 100644
--- a/src/Text/Pandoc/Lua/Filter.hs
+++ b/src/Text/Pandoc/Lua/Filter.hs
@@ -11,6 +11,7 @@ module Text.Pandoc.Lua.Filter ( LuaFilterFunction
                               , inlineElementNames
                               ) where
 import Control.Monad (mplus, unless, when, (>=>))
+import Control.Monad.Catch (finally)
 import Text.Pandoc.Definition
 import Data.Foldable (foldrM)
 import Data.Map (Map)
@@ -22,6 +23,7 @@ import Text.Pandoc.Walk (walkM, Walkable)
 import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
                   showConstr, toConstr, tyconUQname)
 import Text.Pandoc.Lua.StackInstances()
+import Text.Pandoc.Lua.Util (typeCheck)
 
 type FunctionMap = Map String LuaFilterFunction
 
@@ -65,7 +67,7 @@ registerFilterFunction idx = do
 
 elementOrList :: FromLuaStack a => a -> Lua [a]
 elementOrList x = do
-  let topOfStack = Lua.StackIndex (-1)
+  let topOfStack = Lua.stackTop
   elementUnchanged <- Lua.isnil topOfStack
   if elementUnchanged
     then [x] <$ Lua.pop 1
@@ -73,7 +75,9 @@ elementOrList x = do
        mbres <- Lua.peekEither topOfStack
        case mbres of
          Right res -> [res] <$ Lua.pop 1
-         Left _    -> Lua.toList topOfStack <* Lua.pop 1
+         Left _    -> do
+           typeCheck Lua.stackTop Lua.TypeTable
+           Lua.toList topOfStack `finally` Lua.pop 1
 
 -- | Try running a filter for the given element
 tryFilter :: (Data a, FromLuaStack a, ToLuaStack a)
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index d0289d1ef..38404157c 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -35,13 +35,15 @@ module Text.Pandoc.Lua.StackInstances () where
 
 import Control.Applicative ((<|>))
 import Control.Monad (when)
+import Control.Monad.Catch (finally)
 import Data.Data (showConstr, toConstr)
 import Data.Foldable (forM_)
 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)
+import Text.Pandoc.Lua.Util (adjustIndexBy, getTable, pushViaConstructor,
+                             typeCheck)
 import Text.Pandoc.Options (ReaderOptions (..), TrackChanges)
 import Text.Pandoc.Shared (Element (Blk, Sec), safeRead)
 
@@ -49,21 +51,27 @@ import qualified Foreign.Lua as Lua
 import qualified Data.Set as Set
 import qualified Text.Pandoc.Lua.Util as LuaUtil
 
+defineHowTo :: String -> Lua a -> Lua a
+defineHowTo ctx op = op `Lua.modifyLuaError` (("Could not " ++ ctx ++ ": ") ++)
+
 instance ToLuaStack Pandoc where
   push (Pandoc meta blocks) =
     pushViaConstructor "Pandoc" blocks meta
 
 instance FromLuaStack Pandoc where
-  peek idx = do
+  peek idx = defineHowTo "get Pandoc value" $ do
+    typeCheck idx Lua.TypeTable
     blocks <- getTable idx "blocks"
-    meta   <- getTable idx "meta"
+    meta   <- Lua.getfield idx "meta" *> (Lua.peek Lua.stackTop `finally` Lua.pop 1)
     return $ Pandoc meta blocks
 
 instance ToLuaStack Meta where
   push (Meta mmap) =
     pushViaConstructor "Meta" mmap
 instance FromLuaStack Meta where
-  peek idx = Meta <$> peek idx
+  peek idx = defineHowTo "get Meta value" $ do
+    typeCheck idx Lua.TypeTable
+    Meta <$> peek idx
 
 instance ToLuaStack MetaValue where
   push = pushMetaValue
@@ -160,7 +168,7 @@ pushMetaValue = \case
 
 -- | Interpret the value at the given stack index as meta value.
 peekMetaValue :: StackIndex -> Lua MetaValue
-peekMetaValue idx = do
+peekMetaValue idx = defineHowTo "get MetaValue" $ do
   -- Get the contents of an AST element.
   let elementContent :: FromLuaStack a => Lua a
       elementContent = peek idx
@@ -209,7 +217,8 @@ pushBlock = \case
 
 -- | Return the value at the given index as block if possible.
 peekBlock :: StackIndex -> Lua Block
-peekBlock idx = do
+peekBlock idx = defineHowTo "get Block value" $ do
+  typeCheck idx Lua.TypeTable
   tag <- getTag idx
   case tag of
       "BlockQuote"     -> BlockQuote <$> elementContent
@@ -260,7 +269,8 @@ pushInline = \case
 
 -- | Return the value at the given index as inline if possible.
 peekInline :: StackIndex -> Lua Inline
-peekInline idx = do
+peekInline idx = defineHowTo "get Inline value" $ do
+  typeCheck idx Lua.TypeTable
   tag <- getTag idx
   case tag of
     "Cite"       -> uncurry Cite <$> elementContent
@@ -296,11 +306,7 @@ getTag idx = do
   hasMT <- Lua.getmetatable idx
   push "tag"
   if hasMT then Lua.rawget (-2) else Lua.rawget (idx `adjustIndexBy` 1)
-  r <- tryLua (peek (-1))
-  Lua.settop top
-  case r of
-    Left (Lua.LuaException err) -> throwLuaError err
-    Right res                   -> return res
+  peek Lua.stackTop `finally` Lua.settop top
 
 withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
 withAttr f (attributes, x) = f (fromLuaAttr attributes) x
@@ -313,7 +319,7 @@ instance ToLuaStack LuaAttr where
     pushViaConstructor "Attr" id' classes kv
 
 instance FromLuaStack LuaAttr where
-  peek idx = LuaAttr <$> peek idx
+  peek idx = defineHowTo "get Attr value" (LuaAttr <$> peek idx)
 
 --
 -- Hierarchical elements
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 799b45b72..a3af155c9 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -36,6 +36,7 @@ module Text.Pandoc.Lua.Util
   , getRawInt
   , setRawInt
   , addRawInt
+  , typeCheck
   , raiseError
   , popValue
   , PushViaCall
@@ -100,6 +101,14 @@ setRawInt idx key value = do
 addRawInt :: ToLuaStack a => Int -> a -> Lua ()
 addRawInt = setRawInt (-1)
 
+typeCheck :: StackIndex -> Lua.Type -> Lua ()
+typeCheck idx expected = do
+  actual <- Lua.ltype idx
+  when (actual /= expected) $ do
+    expName <- Lua.typename expected
+    actName <- Lua.typename actual
+    Lua.throwLuaError $ "expected " ++ expName ++ " but got " ++ actName ++ "."
+
 raiseError :: ToLuaStack a => a -> Lua NumResults
 raiseError e = do
   Lua.push e