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.

9 files changed, 175 insertions, 35 deletions

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.