From 6528082401100cd8ef26c8dc3e953b960a997827 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel 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