API change: use PandocError for exceptions in Lua subsystem

The PandocError type is used throughout the Lua subsystem, all Lua
functions throw an exception of this type if an error occurs. The
`LuaException` type is removed and no longer exported from
`Text.Pandoc.Lua`. In its place, a new constructor `PandocLuaError` is
added to PandocError.

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,

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 $

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))

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 ()

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

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

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

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 ()

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
 

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

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

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.

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.

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

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

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

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)
     },