aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--pandoc.cabal9
-rw-r--r--src/Text/Pandoc/Error.hs2
-rw-r--r--src/Text/Pandoc/Filter/Lua.hs9
-rw-r--r--src/Text/Pandoc/Lua.hs3
-rw-r--r--src/Text/Pandoc/Lua/ErrorConversion.hs61
-rw-r--r--src/Text/Pandoc/Lua/Filter.hs20
-rw-r--r--src/Text/Pandoc/Lua/Init.hs16
-rw-r--r--src/Text/Pandoc/Lua/Marshaling.hs3
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs15
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/PandocError.hs65
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/Version.hs4
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs19
-rw-r--r--src/Text/Pandoc/Lua/Util.hs7
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs27
-rw-r--r--stack.yaml1
-rw-r--r--test/Tests/Lua.hs15
-rw-r--r--test/lua/module/pandoc-types.lua7
17 files changed, 209 insertions, 74 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index 7c74a26f0..fd1511e0c 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -412,9 +412,9 @@ library
blaze-markup >= 0.8 && < 0.9,
vector >= 0.10 && < 0.13,
jira-wiki-markup >= 1.3 && < 1.4,
- hslua >= 1.0.1 && < 1.2,
+ hslua >= 1.1 && < 1.2,
hslua-module-system >= 0.2 && < 0.3,
- hslua-module-text >= 0.2 && < 0.3,
+ hslua-module-text >= 0.2.1 && < 0.3,
binary >= 0.5 && < 0.11,
SHA >= 1.6 && < 1.7,
haddock-library >= 1.8 && < 1.10,
@@ -611,6 +611,7 @@ library
Text.Pandoc.Writers.Roff,
Text.Pandoc.Writers.Powerpoint.Presentation,
Text.Pandoc.Writers.Powerpoint.Output,
+ Text.Pandoc.Lua.ErrorConversion,
Text.Pandoc.Lua.Filter,
Text.Pandoc.Lua.Global,
Text.Pandoc.Lua.Init,
@@ -621,6 +622,7 @@ library
Text.Pandoc.Lua.Marshaling.Context,
Text.Pandoc.Lua.Marshaling.List,
Text.Pandoc.Lua.Marshaling.MediaBag,
+ Text.Pandoc.Lua.Marshaling.PandocError,
Text.Pandoc.Lua.Marshaling.ReaderOptions,
Text.Pandoc.Lua.Marshaling.Version,
Text.Pandoc.Lua.Module.MediaBag,
@@ -736,8 +738,9 @@ test-suite test-pandoc
text >= 1.1.1.0 && < 1.3,
time >= 1.5 && < 1.10,
directory >= 1.2.3 && < 1.4,
+ exceptions >= 0.8 && < 0.11,
filepath >= 1.1 && < 1.5,
- hslua >= 1.0 && < 1.2,
+ hslua >= 1.1 && < 1.2,
process >= 1.2.3 && < 1.7,
temporary >= 1.1 && < 1.4,
Diff >= 0.2 && < 0.5,
diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs
index 977875907..4c3c1af79 100644
--- a/src/Text/Pandoc/Error.hs
+++ b/src/Text/Pandoc/Error.hs
@@ -47,6 +47,7 @@ data PandocError = PandocIOError Text IOError
| PandocPDFProgramNotFoundError Text
| PandocPDFError Text
| PandocFilterError Text Text
+ | PandocLuaError Text
| PandocCouldNotFindDataFileError Text
| PandocResourceNotFound Text
| PandocTemplateError Text
@@ -100,6 +101,7 @@ handleError (Left e) =
PandocPDFError logmsg -> err 43 $ "Error producing PDF.\n" <> logmsg
PandocFilterError filtername msg -> err 83 $ "Error running filter " <>
filtername <> ":\n" <> msg
+ PandocLuaError msg -> err 84 $ "Error running Lua:\n" <> msg
PandocCouldNotFindDataFileError fn -> err 97 $
"Could not find data file " <> fn
PandocResourceNotFound fn -> err 99 $
diff --git a/src/Text/Pandoc/Filter/Lua.hs b/src/Text/Pandoc/Filter/Lua.hs
index a50e5217d..8df057bfa 100644
--- a/src/Text/Pandoc/Filter/Lua.hs
+++ b/src/Text/Pandoc/Filter/Lua.hs
@@ -17,8 +17,7 @@ import qualified Data.Text as T
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Error (PandocError (PandocFilterError))
-import Text.Pandoc.Lua (Global (..), LuaException (..),
- runLua, runFilterFile, setGlobals)
+import Text.Pandoc.Lua (Global (..), runLua, runFilterFile, setGlobals)
import Text.Pandoc.Options (ReaderOptions)
-- | Run the Lua filter in @filterPath@ for a transformation to the
@@ -40,7 +39,7 @@ apply ropts args fp doc = do
]
runFilterFile fp doc
-forceResult :: FilePath -> Either LuaException Pandoc -> PandocIO Pandoc
+forceResult :: FilePath -> Either PandocError Pandoc -> PandocIO Pandoc
forceResult fp eitherResult = case eitherResult of
- Right x -> return x
- Left (LuaException s) -> throw (PandocFilterError (T.pack fp) s)
+ Right x -> return x
+ Left err -> throw (PandocFilterError (T.pack fp) (T.pack $ show err))
diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index 63a49596d..39db0074a 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -10,7 +10,6 @@ Running pandoc Lua filters.
-}
module Text.Pandoc.Lua
( runLua
- , LuaException (..)
-- * Lua globals
, Global (..)
, setGlobals
@@ -20,5 +19,5 @@ module Text.Pandoc.Lua
import Text.Pandoc.Lua.Filter (runFilterFile)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Init (LuaException (..), runLua)
+import Text.Pandoc.Lua.Init (runLua)
import Text.Pandoc.Lua.Marshaling ()
diff --git a/src/Text/Pandoc/Lua/ErrorConversion.hs b/src/Text/Pandoc/Lua/ErrorConversion.hs
new file mode 100644
index 000000000..59c962723
--- /dev/null
+++ b/src/Text/Pandoc/Lua/ErrorConversion.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{- |
+ Module : Text.Pandoc.Lua.ErrorConversion
+ Copyright : © 2020 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Define how Lua errors are converted into @'PandocError'@ Haskell
+exceptions, and /vice versa/.
+-}
+module Text.Pandoc.Lua.ErrorConversion
+ ( errorConversion
+ ) where
+
+import Foreign.Lua (Lua (..), NumResults)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
+import Text.Pandoc.Lua.Marshaling.PandocError (pushPandocError, peekPandocError)
+
+import qualified Control.Monad.Catch as Catch
+import qualified Data.Text as T
+import qualified Foreign.Lua as Lua
+
+-- | Conversions between Lua errors and Haskell exceptions, assuming
+-- that all exceptions are of type @'PandocError'@.
+errorConversion :: Lua.ErrorConversion
+errorConversion = Lua.ErrorConversion
+ { Lua.addContextToException = addContextToException
+ , Lua.alternative = alternative
+ , Lua.errorToException = errorToException
+ , Lua.exceptionToError = exceptionToError
+ }
+
+-- | Convert a Lua error, which must be at the top of the stack, into a
+-- @'PandocError'@, popping the value from the stack.
+errorToException :: forall a . Lua.State -> IO a
+errorToException l = Lua.unsafeRunWith l $ do
+ err <- peekPandocError Lua.stackTop
+ Lua.pop 1
+ Catch.throwM err
+
+-- | Try the first op -- if it doesn't succeed, run the second.
+alternative :: forall a . Lua a -> Lua a -> Lua a
+alternative x y = Catch.try x >>= \case
+ Left (_ :: PandocError) -> y
+ Right x' -> return x'
+
+-- | Add more context to an error
+addContextToException :: forall a . String -> Lua a -> Lua a
+addContextToException ctx op = op `Catch.catch` \case
+ PandocLuaError msg -> Catch.throwM $ PandocLuaError (T.pack ctx <> msg)
+ e -> Catch.throwM e
+
+-- | Catch a @'PandocError'@ exception and raise it as a Lua error.
+exceptionToError :: Lua NumResults -> Lua NumResults
+exceptionToError op = op `Catch.catch` \e -> do
+ pushPandocError e
+ Lua.error
diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs
index f6a0aea5b..e626356d5 100644
--- a/src/Text/Pandoc/Lua/Filter.hs
+++ b/src/Text/Pandoc/Lua/Filter.hs
@@ -18,14 +18,15 @@ module Text.Pandoc.Lua.Filter ( LuaFilterFunction
) where
import Control.Applicative ((<|>))
import Control.Monad (mplus, (>=>))
-import Control.Monad.Catch (finally)
+import Control.Monad.Catch (finally, try)
import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
showConstr, toConstr, tyconUQname)
import Data.Foldable (foldrM)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
-import Foreign.Lua (Lua, Peekable, Pushable)
+import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Text.Pandoc.Definition
+import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Marshaling.List (List (..))
import Text.Pandoc.Lua.Walk (SingletonsList (..))
@@ -102,7 +103,7 @@ elementOrList x = do
if elementUnchanged
then [x] <$ Lua.pop 1
else do
- mbres <- Lua.peekEither topOfStack
+ mbres <- peekEither topOfStack
case mbres of
Right res -> [res] <$ Lua.pop 1
Left _ -> Lua.peekList topOfStack `finally` Lua.pop 1
@@ -234,11 +235,16 @@ singleElement x = do
if elementUnchanged
then x <$ Lua.pop 1
else do
- mbres <- Lua.peekEither (-1)
+ mbres <- peekEither (-1)
case mbres of
Right res -> res <$ Lua.pop 1
Left err -> do
Lua.pop 1
- Lua.throwException $
- "Error while trying to get a filter's return " ++
- "value from lua stack.\n" ++ err
+ Lua.throwMessage
+ ("Error while trying to get a filter's return " <>
+ "value from Lua stack.\n" <> show err)
+
+-- | Try to convert the value at the given stack index to a Haskell value.
+-- Returns @Left@ with an error message on failure.
+peekEither :: Peekable a => StackIndex -> Lua (Either PandocError a)
+peekEither = try . Lua.peek
diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs
index 757d32898..76a7d0bdc 100644
--- a/src/Text/Pandoc/Lua/Init.hs
+++ b/src/Text/Pandoc/Lua/Init.hs
@@ -9,12 +9,12 @@
Functions to initialize the Lua interpreter.
-}
module Text.Pandoc.Lua.Init
- ( LuaException (..)
- , LuaPackageParams (..)
+ ( LuaPackageParams (..)
, runLua
, luaPackageParams
) where
+import Control.Monad.Catch (try)
import Control.Monad.Trans (MonadIO (..))
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
import Foreign.Lua (Lua)
@@ -22,28 +22,26 @@ import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Class.PandocMonad (getCommonState, getUserDataDir,
putCommonState)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.ErrorConversion (errorConversion)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Packages (LuaPackageParams (..),
installPandocPackageSearcher)
import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
-import qualified Data.Text as Text
import qualified Foreign.Lua as Lua
import qualified Foreign.Lua.Module.Text as Lua
import qualified Text.Pandoc.Definition as Pandoc
import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc
--- | Lua error message
-newtype LuaException = LuaException Text.Text deriving (Show)
-
-- | Run the lua interpreter, using pandoc's default way of environment
-- initialization.
-runLua :: Lua a -> PandocIO (Either LuaException a)
+runLua :: Lua a -> PandocIO (Either PandocError a)
runLua luaOp = do
luaPkgParams <- luaPackageParams
globals <- defaultGlobals
enc <- liftIO $ getForeignEncoding <* setForeignEncoding utf8
- res <- liftIO . Lua.runEither $ do
+ res <- liftIO . try . Lua.run' errorConversion $ do
setGlobals globals
initLuaState luaPkgParams
-- run the given Lua operation
@@ -56,7 +54,7 @@ runLua luaOp = do
return (opResult, st)
liftIO $ setForeignEncoding enc
case res of
- Left (Lua.Exception msg) -> return $ Left (LuaException $ Text.pack msg)
+ Left err -> return $ Left err
Right (x, newState) -> do
putCommonState newState
return $ Right x
diff --git a/src/Text/Pandoc/Lua/Marshaling.hs b/src/Text/Pandoc/Lua/Marshaling.hs
index 624f8b917..1254402b6 100644
--- a/src/Text/Pandoc/Lua/Marshaling.hs
+++ b/src/Text/Pandoc/Lua/Marshaling.hs
@@ -13,6 +13,7 @@ module Text.Pandoc.Lua.Marshaling () where
import Text.Pandoc.Lua.Marshaling.AST ()
import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Lua.Marshaling.ReaderOptions ()
import Text.Pandoc.Lua.Marshaling.Context ()
+import Text.Pandoc.Lua.Marshaling.PandocError()
+import Text.Pandoc.Lua.Marshaling.ReaderOptions ()
import Text.Pandoc.Lua.Marshaling.Version ()
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index 81b206f67..8d7e83dc1 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -19,9 +19,11 @@ module Text.Pandoc.Lua.Marshaling.AST
import Control.Applicative ((<|>))
import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Text.Pandoc.Definition
+import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.CommonState ()
+import qualified Control.Monad.Catch as Catch
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
@@ -131,7 +133,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
Lua.TypeBoolean -> MetaBool <$> Lua.peek idx
Lua.TypeString -> MetaString <$> Lua.peek idx
Lua.TypeTable -> do
- tag <- Lua.try $ LuaUtil.getTag idx
+ tag <- try $ LuaUtil.getTag idx
case tag of
Right "MetaBlocks" -> MetaBlocks <$> elementContent
Right "MetaBool" -> MetaBool <$> elementContent
@@ -139,7 +141,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
Right "MetaInlines" -> MetaInlines <$> elementContent
Right "MetaList" -> MetaList <$> elementContent
Right "MetaString" -> MetaString <$> elementContent
- Right t -> Lua.throwException ("Unknown meta tag: " <> t)
+ Right t -> Lua.throwMessage ("Unknown meta tag: " <> t)
Left _ -> do
-- no meta value tag given, try to guess.
len <- Lua.rawlen idx
@@ -148,7 +150,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
else (MetaInlines <$> Lua.peek idx)
<|> (MetaBlocks <$> Lua.peek idx)
<|> (MetaList <$> Lua.peek idx)
- _ -> Lua.throwException "could not get meta value"
+ _ -> Lua.throwMessage "could not get meta value"
-- | Push a block element to the top of the Lua stack.
pushBlock :: Block -> Lua ()
@@ -199,7 +201,7 @@ peekBlock idx = defineHowTo "get Block value" $ do
tbodies
tfoot)
<$> elementContent
- _ -> Lua.throwException ("Unknown block type: " <> tag)
+ _ -> Lua.throwMessage ("Unknown block type: " <> tag)
where
-- Get the contents of an AST element.
elementContent :: Peekable a => Lua a
@@ -344,12 +346,15 @@ peekInline idx = defineHowTo "get Inline value" $ do
"Strong" -> Strong <$> elementContent
"Subscript" -> Subscript <$> elementContent
"Superscript"-> Superscript <$> elementContent
- _ -> Lua.throwException ("Unknown inline type: " <> tag)
+ _ -> Lua.throwMessage ("Unknown inline type: " <> tag)
where
-- Get the contents of an AST element.
elementContent :: Peekable a => Lua a
elementContent = LuaUtil.rawField idx "c"
+try :: Lua a -> Lua (Either PandocError a)
+try = Catch.try
+
withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr f (attributes, x) = f (fromLuaAttr attributes) x
diff --git a/src/Text/Pandoc/Lua/Marshaling/PandocError.hs b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs
new file mode 100644
index 000000000..74537a1dd
--- /dev/null
+++ b/src/Text/Pandoc/Lua/Marshaling/PandocError.hs
@@ -0,0 +1,65 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{- |
+ Module : Text.Pandoc.Lua.Marshaling.PandocError
+ Copyright : © 2020 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+ Stability : alpha
+
+Marshaling of @'PandocError'@ values.
+-}
+module Text.Pandoc.Lua.Marshaling.PandocError
+ ( peekPandocError
+ , pushPandocError
+ )
+ where
+
+import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
+
+import qualified Foreign.Lua as Lua
+import qualified Foreign.Lua.Userdata as Lua
+import qualified Text.Pandoc.Lua.Util as LuaUtil
+import qualified Text.Pandoc.UTF8 as UTF8
+
+-- | Userdata name used by Lua for the @PandocError@ type.
+pandocErrorName :: String
+pandocErrorName = "pandoc error"
+
+-- | Peek a @'PandocError'@ element to the Lua stack.
+pushPandocError :: PandocError -> Lua ()
+pushPandocError = Lua.pushAnyWithMetatable pushPandocErrorMT
+ where
+ pushPandocErrorMT = Lua.ensureUserdataMetatable pandocErrorName $
+ LuaUtil.addFunction "__tostring" __tostring
+
+-- | Retrieve a @'PandocError'@ from the Lua stack.
+peekPandocError :: StackIndex -> Lua PandocError
+peekPandocError idx = Lua.ltype idx >>= \case
+ Lua.TypeUserdata -> do
+ errMb <- Lua.toAnyWithName idx pandocErrorName
+ return $ case errMb of
+ Just err -> err
+ Nothing -> PandocLuaError "could not retrieve original error"
+ _ -> do
+ Lua.pushvalue idx
+ msg <- Lua.state >>= \l -> Lua.liftIO (Lua.errorMessage l)
+ return $ PandocLuaError (UTF8.toText msg)
+
+-- | Convert to string.
+__tostring :: PandocError -> Lua String
+__tostring = return . show
+
+--
+-- Instances
+--
+
+instance Pushable PandocError where
+ push = pushPandocError
+
+instance Peekable PandocError where
+ peek = peekPandocError
diff --git a/src/Text/Pandoc/Lua/Marshaling/Version.hs b/src/Text/Pandoc/Lua/Marshaling/Version.hs
index 090725afc..9adb1b763 100644
--- a/src/Text/Pandoc/Lua/Marshaling/Version.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/Version.hs
@@ -57,7 +57,7 @@ peekVersion idx = Lua.ltype idx >>= \case
let parses = readP_to_S parseVersion versionStr
case lastMay parses of
Just (v, "") -> return v
- _ -> Lua.throwException $ "could not parse as Version: " ++ versionStr
+ _ -> Lua.throwMessage $ "could not parse as Version: " ++ versionStr
Lua.TypeUserdata ->
reportValueOnFailure versionTypeName
@@ -71,7 +71,7 @@ peekVersion idx = Lua.ltype idx >>= \case
makeVersion <$> Lua.peek idx
_ ->
- Lua.throwException "could not peek Version"
+ Lua.throwMessage "could not peek Version"
instance Peekable Version where
peek = peekVersion
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 11a0bda84..36bb2f59c 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/src/Text/Pandoc/Lua/Module/Utils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Lua.Module.Utils
Copyright : Copyright © 2017-2020 Albert Krewinkel
@@ -13,6 +14,7 @@ module Text.Pandoc.Lua.Module.Utils
) where
import Control.Applicative ((<|>))
+import Control.Monad.Catch (try)
import Data.Default (def)
import Data.Version (Version)
import Foreign.Lua (Peekable, Lua, NumResults)
@@ -20,6 +22,7 @@ import Text.Pandoc.Class.PandocIO (runIO)
import Text.Pandoc.Class.PandocMonad (setUserDataDir)
import Text.Pandoc.Definition ( Pandoc, Meta, MetaValue (..), Block, Inline
, Citation, Attr, ListAttributes)
+import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Lua.Marshaling ()
import Text.Pandoc.Lua.Util (addFunction)
@@ -125,16 +128,16 @@ data AstElement
instance Peekable AstElement where
peek idx = do
- res <- Lua.try $ (PandocElement <$> Lua.peek idx)
- <|> (InlineElement <$> Lua.peek idx)
- <|> (BlockElement <$> Lua.peek idx)
- <|> (AttrElement <$> Lua.peek idx)
- <|> (ListAttributesElement <$> Lua.peek idx)
- <|> (MetaElement <$> Lua.peek idx)
- <|> (MetaValueElement <$> Lua.peek idx)
+ res <- try $ (PandocElement <$> Lua.peek idx)
+ <|> (InlineElement <$> Lua.peek idx)
+ <|> (BlockElement <$> Lua.peek idx)
+ <|> (AttrElement <$> Lua.peek idx)
+ <|> (ListAttributesElement <$> Lua.peek idx)
+ <|> (MetaElement <$> Lua.peek idx)
+ <|> (MetaValueElement <$> Lua.peek idx)
case res of
Right x -> return x
- Left _ -> Lua.throwException
+ Left (_ :: PandocError) -> Lua.throwMessage
"Expected an AST element, but could not parse value as such."
-- | Convert a number < 4000 to uppercase roman numeral.
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index d79fbb085..66bba5a34 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -107,7 +107,7 @@ getTag idx = do
Lua.push ("tag" :: Text)
Lua.rawget (Lua.nthFromTop 2)
Lua.tostring Lua.stackTop <* Lua.pop 2 >>= \case
- Nothing -> Lua.throwException "untagged value"
+ Nothing -> Lua.throwMessage "untagged value"
Just x -> return (UTF8.toString x)
-- | Modify the message at the top of the stack before throwing it as an
@@ -116,11 +116,12 @@ throwTopMessageAsError' :: (String -> String) -> Lua a
throwTopMessageAsError' modifier = do
msg <- Lua.tostring' Lua.stackTop
Lua.pop 2 -- remove error and error string pushed by tostring'
- Lua.throwException (modifier (UTF8.toString msg))
+ Lua.throwMessage (modifier (UTF8.toString msg))
-- | Mark the context of a Lua computation for better error reporting.
defineHowTo :: String -> Lua a -> Lua a
-defineHowTo ctx = Lua.withExceptionMessage (("Could not " <> ctx <> ": ") <>)
+defineHowTo ctx op = Lua.errorConversion >>= \ec ->
+ Lua.addContextToException ec ("Could not " <> ctx <> ": ") op
-- | Like @'Lua.pcall'@, but uses a predefined error handler which adds a
-- traceback on error.
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index 2be64d56f..50a013dfd 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -20,17 +20,14 @@ import Data.List (intersperse)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text, pack)
-import Data.Typeable
import Foreign.Lua (Lua, Pushable)
import Text.DocLayout (render, literal)
import Text.Pandoc.Class.PandocIO (PandocIO)
import Text.Pandoc.Definition
-import Text.Pandoc.Lua (Global (..), LuaException (LuaException),
- runLua, setGlobals)
+import Text.Pandoc.Lua (Global (..), runLua, setGlobals)
import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate)
-import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Writers.Shared
import qualified Foreign.Lua as Lua
@@ -81,11 +78,6 @@ instance (Pushable a, Pushable b) => Pushable (KeyValue a b) where
Lua.push v
Lua.rawset (Lua.nthFromTop 3)
-data PandocLuaException = PandocLuaException Text
- deriving (Show, Typeable)
-
-instance Exception PandocLuaException
-
-- | Convert Pandoc to custom markup.
writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text
writeCustom luaFile opts doc@(Pandoc meta _) = do
@@ -97,21 +89,20 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do
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) $
- Lua.tostring' (-1) >>= throw . PandocLuaException . UTF8.toText
+ when (stat /= Lua.OK)
+ Lua.throwTopMessage
rendered <- docToCustom opts doc
context <- metaToContext opts
(fmap (literal . pack) . blockListToCustom)
(fmap (literal . pack) . inlineListToCustom)
meta
return (pack rendered, context)
- let (body, context) = case res of
- Left (LuaException msg) -> throw (PandocLuaException msg)
- Right x -> x
- return $
- case writerTemplate opts of
- Nothing -> body
- Just tpl -> render Nothing $
+ case res of
+ Left msg -> throw msg
+ Right (body, context) -> return $
+ case writerTemplate opts of
+ Nothing -> body
+ Just tpl -> render Nothing $
renderTemplate tpl $ setField "body" body context
docToCustom :: WriterOptions -> Pandoc -> Lua String
diff --git a/stack.yaml b/stack.yaml
index d6ae4eee7..9a94de053 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -23,6 +23,7 @@ extra-deps:
- regex-pcre-builtin-0.95.0.8.8.35
- doclayout-0.3
- emojis-0.1
+- hslua-1.1.0
- jira-wiki-markup-1.3.0
- HsYAML-0.2.0.0
- HsYAML-aeson-0.2.0.0
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
index 0943b17aa..14800f7bb 100644
--- a/test/Tests/Lua.hs
+++ b/test/Tests/Lua.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Tests.Lua
Copyright : © 2017-2020 Albert Krewinkel
@@ -28,11 +29,13 @@ import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
Attr, Meta, Pandoc, pandocTypesVersion)
+import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters)
import Text.Pandoc.Lua (runLua)
import Text.Pandoc.Options (def)
import Text.Pandoc.Shared (pandocVersion)
+import qualified Control.Monad.Catch as Catch
import qualified Foreign.Lua as Lua
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -197,12 +200,13 @@ tests = map (localOption (QuickCheckTests 20))
, testCase "informative error messages" . runLuaTest $ do
Lua.pushboolean True
- err <- Lua.peekEither Lua.stackTop
- case (err :: Either String Pandoc) of
- Left msg -> do
+ eitherPandoc <- Catch.try (Lua.peek Lua.stackTop :: Lua.Lua Pandoc)
+ case eitherPandoc of
+ Left (PandocLuaError msg) -> do
let expectedMsg = "Could not get Pandoc value: "
<> "table expected, got boolean"
Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
+ Left e -> error ("Expected a Lua error, but got " <> show e)
Right _ -> error "Getting a Pandoc element from a bool should fail."
]
@@ -223,10 +227,7 @@ roundtripEqual x = (x ==) <$> roundtripped
size <- Lua.gettop
when (size - oldSize /= 1) $
error ("not exactly one additional element on the stack: " ++ show size)
- res <- Lua.peekEither (-1)
- case res of
- Left e -> error (show e)
- Right y -> return y
+ Lua.peek (-1)
runLuaTest :: Lua.Lua a -> IO a
runLuaTest op = runIOorExplode $ do
diff --git a/test/lua/module/pandoc-types.lua b/test/lua/module/pandoc-types.lua
index 880dd567e..d4e063a5c 100644
--- a/test/lua/module/pandoc-types.lua
+++ b/test/lua/module/pandoc-types.lua
@@ -26,10 +26,9 @@ return {
)
end),
test('non-version string is rejected', function ()
- assert.error_matches(
- function () Version '11friends' end,
- '11friends'
- )
+ local success, msg = pcall(function () Version '11friends' end)
+ assert.is_falsy(success)
+ assert.is_truthy(tostring(msg):match('11friends'))
end)
},
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-03 06:53:26 +0000