aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Lua/Filter.hs8
-rw-r--r--src/Text/Pandoc/Lua/StackInstances.hs32
-rw-r--r--src/Text/Pandoc/Lua/Util.hs9
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