From fb54f3d6792d2f8e7b05e458b59142f8ae6bb3e2 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Wed, 25 Mar 2020 22:16:27 +0100
Subject: 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.
---
src/Text/Pandoc/Lua/ErrorConversion.hs | 61 +++++++++++++++++++++++++
src/Text/Pandoc/Lua/Filter.hs | 20 ++++++---
src/Text/Pandoc/Lua/Init.hs | 16 +++----
src/Text/Pandoc/Lua/Marshaling.hs | 3 +-
src/Text/Pandoc/Lua/Marshaling/AST.hs | 15 ++++---
src/Text/Pandoc/Lua/Marshaling/PandocError.hs | 65 +++++++++++++++++++++++++++
src/Text/Pandoc/Lua/Marshaling/Version.hs | 4 +-
src/Text/Pandoc/Lua/Module/Utils.hs | 19 ++++----
src/Text/Pandoc/Lua/Util.hs | 7 +--
9 files changed, 175 insertions(+), 35 deletions(-)
create mode 100644 src/Text/Pandoc/Lua/ErrorConversion.hs
create mode 100644 src/Text/Pandoc/Lua/Marshaling/PandocError.hs
(limited to 'src/Text/Pandoc/Lua')
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.
--
cgit v1.2.3