From 6528082401100cd8ef26c8dc3e953b960a997827 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Fri, 12 Jan 2018 21:26:34 +0100
Subject: Lua filters: improve error messages
Provide more context about the task which caused an error.
---
pandoc.cabal | 1 +
src/Text/Pandoc/Lua/Filter.hs | 8 ++++++--
src/Text/Pandoc/Lua/StackInstances.hs | 32 +++++++++++++++++++-------------
src/Text/Pandoc/Lua/Util.hs | 9 +++++++++
test/Tests/Lua.hs | 10 ++++++++++
5 files changed, 45 insertions(+), 15 deletions(-)
diff --git a/pandoc.cabal b/pandoc.cabal
index dedeaaeca..87f85cf00 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -347,6 +347,7 @@ library
unordered-containers >= 0.2 && < 0.3,
parsec >= 3.1 && < 3.2,
mtl >= 2.2 && < 2.3,
+ exceptions >= 0.8 && < 0.9,
filepath >= 1.1 && < 1.5,
process >= 1.2.3 && < 1.7,
directory >= 1 && < 1.4,
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
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
index bbce2ac42..9df5e79cd 100644
--- a/test/Tests/Lua.hs
+++ b/test/Tests/Lua.hs
@@ -123,6 +123,16 @@ tests = map (localOption (QuickCheckTests 20))
Lua.getglobal "PANDOC_API_VERSION"
Lua.liftIO . assertEqual "pandoc-types version is wrong" versionNums
=<< Lua.peek Lua.stackTop
+
+ , testCase "informative error messages" . runPandocLua' $ do
+ Lua.pushboolean True
+ err <- Lua.peekEither Lua.stackTop :: Lua.Lua (Either String Pandoc)
+ case err of
+ Left msg -> do
+ let expectedMsg = "Could not get Pandoc value: "
+ ++ "expected table but got boolean."
+ Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
+ Right _ -> error "Getting a Pandoc element from a bool should fail."
]
assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion
--
cgit v1.2.3