hslua 1.0.3.2 → 1.1.0

raw patch · 34 files changed

+428/−110 lines, 34 filesdep +base-compatdep +semigroupsPVP ok

version bump matches the API change (PVP)

Dependencies added: base-compat, semigroups

API changes (from Hackage documentation)

Files

• CHANGELOG.md +50/−0
• benchmark/benchmark-hslua.hsc +1/−1
• cbits/error-conversion/error-conversion.c +11/−0
• cbits/error-conversion/error-conversion.h +2/−0
• hslua.cabal +27/−8
• prelude/Prelude.hs +9/−0
• src/Foreign/Lua.hs +4/−2
• src/Foreign/Lua/Core.hs +11/−2
• src/Foreign/Lua/Core/Auxiliary.hsc +13/−11
• src/Foreign/Lua/Core/Constants.hsc +1/−1
• src/Foreign/Lua/Core/Error.hs +45/−10
• src/Foreign/Lua/Core/Functions.hs +5/−8
• src/Foreign/Lua/Core/RawBindings.hsc +8/−2
• src/Foreign/Lua/Core/Types.hsc +59/−13
• src/Foreign/Lua/FunctionCalling.hsc +19/−12
• src/Foreign/Lua/Module.hs +1/−1
• src/Foreign/Lua/Types.hs +1/−1
• src/Foreign/Lua/Types/Peekable.hs +6/−4
• src/Foreign/Lua/Types/Pushable.hs +1/−1
• src/Foreign/Lua/Userdata.hs +1/−1
• src/Foreign/Lua/Utf8.hs +1/−3
• src/Foreign/Lua/Util.hs +35/−4
• test/Foreign/Lua/CoreTests.hs +2/−3
• test/Foreign/Lua/FunctionCallingTests.hs +1/−2
• test/Foreign/Lua/ModuleTests.hs +1/−1
• test/Foreign/Lua/Types/PeekableTests.hs +2/−2
• test/Foreign/Lua/Types/PushableTests.hs +2/−2
• test/Foreign/Lua/TypesTests.hs +1/−1
• test/Foreign/Lua/UserdataTests.hs +1/−1
• test/Foreign/Lua/UtilTests.hs +7/−3
• test/Foreign/LuaTests.hs +97/−6
• test/Test/HsLua/Arbitrary.hs +1/−1
• test/Test/HsLua/Util.hs +1/−2
• test/test-hslua.hs +1/−1

@@ -1,5 +1,55 @@ ## Changelog +### 1.1.0++Released 2020-03-25.++**WARNING:** The changes in this release are experimental. It is+recommended to skip this release unless the newly introduced+features are required.++- Allow custom error handling: conversion of Lua errors to+  Haskell exceptions and back is made configurable. Users can+  define their own exception/error handling strategies, even+  opening up the option to pass arbitrary exceptions through Lua.++    - New types exported from `Foreign.Lua.Types`:++        - `ErrorConversion`: defines the ways in which exceptions+          and errors are handled and converted.+        - `LuaEnvironment`: environment in which Lua computations+          are evaluated. Contains the Lua interpreter state and+          the error conversion strategy.++    - The environment of the `Lua` type is changed from a plain+      Lua `State` to the above mentioned `LuaEnvironment`.++    - New functions `run'` is exported from `Foreign.Lua.Util`+      and `Foreign.Lua`: it is analogous to `run`, but allows to+      run computations with a custom error conversion strategy.++    - New function `runWithConverter` exported from+      `Foreign.Lua.Core.Types` and `Foreign.Lua.Core`; like+      `run'`, but takes a custom state.++    - New function `unsafeRunWith` exported from+      `Foreign.Lua.Core.Types` and `Foreign.Lua.Core`; runs a+      computation without proper error handling.++    - New function `errorConversion` exported from+      `Foreign.Lua.Core.Types` and `Foreign.Lua.Core`: extract+      the error conversion strategy from the Lua type.++    - New function `throwErrorAsException` exported from+      `Foreign.Lua.Core.Error` and `Foreign.Lua.Core`: throws a+      Lua error as Haskell exception, using the current error+      conversion strategy.++- Function `runWith` is moved from module `Foreign.Lua.Core` to+  `Foreign.Lua.Util`.++- The module `Foreign.Lua.Utf8` is now exported.+  ### 1.0.3.2 

@@ -1,5 +1,5 @@ {--Copyright © 2018 Albert Krewinkel+Copyright © 2018-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -12,6 +12,17 @@ }  /*+** Marks the occurence of an error; the returned value should be used as+** the error message.+*/+int hslua_error(lua_State *L)+{+  hslua_pushhaskellerr(L);+  lua_insert(L, -2);+  return 2;+}++/* ** Checks whether the object at the given index is a Haskell error. */ int hslua_is_haskell_error(lua_State *L, int idx) {

@@ -1,6 +1,8 @@ #include "lua.h" #include "lauxlib.h" +int hslua_error(lua_State *L);+ int hslua_call_hs(lua_State *L);  int hslua_userdata_gc(lua_State *L);

@@ -1,5 +1,5 @@ name:                hslua-version:             1.0.3.2+version:             1.1.0 synopsis:            Bindings to Lua, an embeddable scripting language description:         HsLua provides bindings, wrappers, types, and helper                      functions to bridge Haskell and <https://www.lua.org/ Lua>.@@ -18,7 +18,7 @@ maintainer:          albert+hslua@zeitkraut.de copyright:           © 2007–2012 Gracjan Polak                      © 2012–2016 Ömer Sinan Ağacan-                     © 2016–2019 Albert Krewinkel+                     © 2016–2020 Albert Krewinkel category:            Foreign build-type:          Simple extra-source-files:  cbits/lua-5.3.5/*.h@@ -29,8 +29,12 @@                      CHANGELOG.md                      test/lua/*.lua cabal-version:       >=1.10-tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3-                   , GHC == 8.6.1+tested-with:         GHC == 7.10.3+                   , GHC == 8.0.2+                   , GHC == 8.2.2+                   , GHC == 8.4.3+                   , GHC == 8.6.5+                   , GHC == 8.8.3  source-repository head   type:                git@@ -95,15 +99,14 @@                      , Foreign.Lua.Types.Peekable                      , Foreign.Lua.Types.Pushable                      , Foreign.Lua.Userdata+                     , Foreign.Lua.Utf8                      , Foreign.Lua.Util-  other-modules:       Foreign.Lua.Utf8-                     , Foreign.Lua.Core.Auxiliary+  other-modules:       Foreign.Lua.Core.Auxiliary                      , Foreign.Lua.Core.Functions   build-depends:       base                 >= 4.8    && < 5                      , bytestring           >= 0.10.2 && < 0.11                      , containers           >= 0.5    && < 0.7                      , exceptions           >= 0.8    && < 0.11-                     , fail                 >= 4.9    && < 5                      , mtl                  >= 2.2    && < 2.3                      , text                 >= 1.0    && < 1.3   hs-source-dirs:      src@@ -189,7 +192,15 @@   if flag(hardcode-reg-keys)     cpp-options:         -DHARDCODE_REG_KEYS +  if !impl(ghc >= 8.0)+    build-depends:       fail                 >= 4.9    && < 5+                       , semigroups           >= 0.18   && < 0.20 +  if impl(ghc < 8.8)+    build-depends:       base-compat          >= 0.10+    hs-source-dirs:      prelude+    other-modules:       Prelude+ test-suite test-hslua   type:                exitcode-stdio-1.0   main-is:             test-hslua.hs@@ -213,7 +224,6 @@                      , bytestring           >= 0.10.2 && < 0.11                      , containers           >= 0.5    && < 0.7                      , exceptions           >= 0.8    && < 0.11-                     , fail                 >= 4.9    && < 5                      , mtl                  >= 2.2    && < 2.3                      , text                 >= 1.0    && < 1.3                      -- for testing@@ -223,6 +233,15 @@                      , tasty                >= 0.11                      , tasty-hunit          >= 0.9                      , tasty-quickcheck     >= 0.8++  if impl(ghc < 8.0)+    build-depends:       fail                 >= 4.9    && < 5+                       , semigroups           >= 0.18   && < 0.20+  if impl(ghc < 8.8)+    build-depends:       base-compat          >= 0.10+    hs-source-dirs:      prelude+    other-modules:       Prelude+  benchmark benchmark-hslua   type:                exitcode-stdio-1.0

@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}+module Prelude (+    module Prelude.Compat+  , Semigroup (..)+)+where++import Prelude.Compat+import Data.Semigroup (Semigroup ((<>)))

@@ -1,7 +1,7 @@ {- Copyright © 2007-2012 Gracjan Polak Copyright © 2012-2016 Ömer Sinan Ağacan-Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -25,7 +25,7 @@ Module      : Foreign.Lua Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -62,7 +62,9 @@   , registerHaskellFunction   -- * Utility functions and types   , run+  , run'   , runEither+  , runWith   , getglobal'   , setglobal'   , raiseError

@@ -2,7 +2,7 @@ Module      : Foreign.Lua.Core Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -16,9 +16,14 @@ module Foreign.Lua.Core (   -- * Lua Computations     Lua (..)-  , runWith+  , runWithConverter+  , unsafeRunWith   , liftIO   , state+  , LuaEnvironment (..)+  , ErrorConversion (..)+  , errorConversion+  , unsafeErrorConversion   -- * Lua API types   , CFunction   , Lua.Integer (..)@@ -173,7 +178,11 @@   , catchException   , withExceptionMessage   , try+  , throwMessage+  , errorMessage+  , throwErrorAsException   , throwTopMessage+  , throwTopMessageWithState   ) where  import Prelude hiding (EQ, LT, compare, concat, error)

@@ -4,7 +4,7 @@ Module      : Foreign.Lua.Core.Auxiliary Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -36,10 +36,9 @@  import Control.Exception (IOException, try) import Data.ByteString (ByteString)-import Data.Monoid ((<>)) import Foreign.C ( CChar, CInt (CInt), CSize (CSize), CString, withCString ) import Foreign.Lua.Core.Constants (multret, registryindex)-import Foreign.Lua.Core.Error (hsluaErrorRegistryField, throwTopMessage)+import Foreign.Lua.Core.Error (hsluaErrorRegistryField) import Foreign.Lua.Core.Types (Lua, Reference, StackIndex, Status, liftLua) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr@@ -250,7 +249,7 @@ newstate :: IO Lua.State newstate = do   l <- luaL_newstate-  Lua.runWith l $ do+  Lua.unsafeRunWith l $ do     Lua.createtable 0 0     Lua.setfield registryindex hsluaErrorRegistryField     return l@@ -288,13 +287,16 @@ -- calls the corresponding metamethod with the value as argument, and uses the -- result of the call as its result. tostring' :: StackIndex -> Lua B.ByteString-tostring' n = liftLua $ \l -> alloca $ \lenPtr -> do-  cstr <- hsluaL_tolstring l n lenPtr-  if cstr == nullPtr-    then Lua.runWith l throwTopMessage-    else do-      cstrLen <- Storable.peek lenPtr-      B.packCStringLen (cstr, fromIntegral cstrLen)+tostring' n = do+  l <- Lua.state+  e2e <- Lua.errorToException <$> Lua.errorConversion+  Lua.liftIO $ alloca $ \lenPtr -> do+    cstr <- hsluaL_tolstring l n lenPtr+    if cstr == nullPtr+      then e2e l+      else do+        cstrLen <- Storable.peek lenPtr+        B.packCStringLen (cstr, fromIntegral cstrLen)  foreign import ccall safe "error-conversion.h hsluaL_tolstring"   hsluaL_tolstring :: Lua.State -> StackIndex -> Ptr CSize -> IO (Ptr CChar)

@@ -2,7 +2,7 @@ Module      : Foreign.Lua.Core.Constants Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta

@@ -1,9 +1,10 @@ {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-} {-# OPTIONS_GHC -fno-warn-orphans       #-} {-| Module      : Foreign.Lua.Core.Error-Copyright   : © 2017-2019 Albert Krewinkel+Copyright   : © 2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -16,12 +17,16 @@   , catchException   , throwException   , withExceptionMessage+  , throwErrorAsException   , throwTopMessage+  , throwTopMessageWithState+  , errorMessage   , try     -- * Helpers for hslua C wrapper functions.   , Failable (..)   , fromFailable   , throwOnError+  , throwMessage   , boolFromFailable     -- * Signaling errors to Lua   , hsluaErrorRegistryField@@ -29,7 +34,7 @@  import Control.Applicative (Alternative (..)) import Data.Typeable (Typeable)-import Foreign.C (CChar, CInt (CInt), CSize)+import Foreign.C (CChar, CInt (CInt), CSize (CSize)) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Lua.Core.Types (Lua, StackIndex, fromLuaBool)@@ -38,6 +43,7 @@ import qualified Control.Monad.Catch as Catch import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as Char8+import qualified Data.ByteString.Unsafe as B import qualified Foreign.Storable as Storable import qualified Foreign.Lua.Core.Types as Lua import qualified Foreign.Lua.Utf8 as Utf8@@ -73,18 +79,44 @@ try = Catch.try {-# INLINABLE try #-} -instance Alternative Lua where-  empty = throwException "empty"-  x <|> y = either (const y) return =<< try x+-- | Convert a Lua error into a Haskell exception. The error message is+-- expected to be at the top of the stack.+throwErrorAsException :: Lua a+throwErrorAsException = do+  f <- Lua.errorToException <$> Lua.errorConversion+  l <- Lua.state+  Lua.liftIO (f l) --- | Convert the object at the top of the stack into a string and throw it as--- an @'Exception'@.+-- | Alias for `throwErrorAsException`; will be deprecated in the next+-- mayor release. throwTopMessage :: Lua a-throwTopMessage = do-  l <- Lua.state+throwTopMessage = throwErrorAsException++instance Alternative Lua where+  empty = throwMessage "empty"+  x <|> y = do+    alt <- Lua.alternative <$> Lua.errorConversion+    x `alt` y++-- | Convert the object at the top of the stack into a string and throw+-- it as a HsLua @'Exception'@.+--+-- This function serves as the default to convert Lua errors to Haskell+-- exceptions.+throwTopMessageWithState :: Lua.State -> IO a+throwTopMessageWithState l = do   msg <- Lua.liftIO (errorMessage l)-  throwException (Utf8.toString msg)+  Catch.throwM $ Exception (Utf8.toString msg) +-- | Helper function which uses proper error-handling to throw an+-- exception with the given message.+throwMessage :: String -> Lua a+throwMessage msg = do+  Lua.liftLua $ \l ->+    B.unsafeUseAsCStringLen (Utf8.fromString msg) $ \(msgPtr, z) ->+      lua_pushlstring l msgPtr (fromIntegral z)+  Lua.errorConversion >>= Lua.liftLua . Lua.errorToException+ -- | Retrieve and pop the top object as an error message. This is very similar -- to tostring', but ensures that we don't recurse if getting the message -- failed.@@ -105,6 +137,9 @@  foreign import capi unsafe "lua.h lua_pop"   lua_pop :: Lua.State -> CInt -> IO ()++foreign import capi unsafe "lua.h lua_pushlstring"+  lua_pushlstring :: Lua.State -> Ptr CChar -> CSize -> IO ()  -- | Registry field under which the special HsLua error indicator is stored. hsluaErrorRegistryField :: String

@@ -2,7 +2,7 @@ Module      : Foreign.Lua.Core.Functions Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -21,7 +21,6 @@  import Control.Monad import Data.ByteString (ByteString)-import Data.Monoid ((<>)) import Data.Maybe (fromMaybe) import Foreign.Lua.Core.Constants import Foreign.Lua.Core.Error@@ -40,7 +39,8 @@ -- Helper functions -- --- | Execute an action only if the given index is a table. Throw an error otherwise.+-- | Execute an action only if the given index is a table. Throw an+-- error otherwise. ensureTable :: StackIndex -> (Lua.State -> IO ()) -> Lua () ensureTable idx ioOp = do   isTbl <- istable idx@@ -48,7 +48,7 @@     then liftLua ioOp     else do       tyName <- ltype idx >>= typename-      throwException ("table expected, got " <> tyName)+      throwMessage ("table expected, got " <> tyName)  -- -- API functions@@ -193,10 +193,7 @@ -- `lua_error` function from Lua C API because it's never safe to use. (see -- [Error handling in hslua](#g:1) for details) error :: Lua NumResults-error = do-  getfield registryindex hsluaErrorRegistryField-  insert (-2)-  return 2+error = liftLua hslua_error  -- |  Controls the garbage collector. --

@@ -3,7 +3,7 @@ Module      : Foreign.Lua.Core.RawBindings Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -323,9 +323,15 @@ ------------------------------------------------------------------------------ -- * Miscellaneous functions --- lua_error is unsafe in a haskell context and hence not supported.+-- lua_error is unsafe, use hslua_error instead. -- lua_next is unsafe, use hslua_next instead. -- lua_concat is unsafe (may trigger a longjmp), use hslua_concat instead.++-- | Replacement for <https://lua.org/manual/5.3/manual.html#lua_error \+-- @lua_error@>; it uses the HsLua error signaling convention instead of raw+-- @longjmp@.+foreign import ccall "error-conversion.h hslua_error"+  hslua_error :: Lua.State -> IO NumResults  -- | Wrapper around <https://lua.org/manual/5.3/manual.html#lua_next \ -- @lua_next@> which catches any @longjmp@s.

@@ -1,10 +1,11 @@ {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes                 #-} {-| Module      : Foreign.Lua.Core.Types Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -14,12 +15,17 @@ -} module Foreign.Lua.Core.Types   ( Lua (..)+  , LuaEnvironment (..)+  , ErrorConversion (..)+  , errorConversion   , State (..)   , Reader   , liftLua   , liftLua1   , state-  , runWith+  , runWithConverter+  , unsafeRunWith+  , unsafeErrorConversion   , GCCONTROL (..)   , Type (..)   , TypeCode (..)@@ -59,17 +65,38 @@ import Prelude hiding (Integer, EQ, LT)  import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)-import Control.Monad.Reader (ReaderT (..), MonadReader, MonadIO, ask, liftIO)+import Control.Monad.Reader (ReaderT (..), MonadReader, MonadIO, asks, liftIO) import Data.Int (#{type LUA_INTEGER}) import Foreign.C (CChar, CInt, CSize) import Foreign.Ptr (FunPtr, Ptr) import Foreign.Storable (Storable) import GHC.Generics (Generic) +-- | Define the ways in which exceptions and errors are handled.+data ErrorConversion = ErrorConversion+  { errorToException :: forall a . State -> IO a+    -- ^ Translate Lua errors to Haskell exceptions+  , addContextToException :: forall a . String -> Lua a -> Lua a+    -- ^ Add information on the current context to an exception.+  , alternative :: forall a . Lua a -> Lua a -> Lua a+    -- ^ Runs the second computation only if the first fails; returns+    -- the result of the first successful computation, if any.+  , exceptionToError :: Lua NumResults -> Lua NumResults+    -- ^ Translate Haskell exceptions to Lua errors+  }++-- | Environment in which Lua computations are evaluated.+data LuaEnvironment = LuaEnvironment+  { luaEnvErrorConversion :: ErrorConversion+    -- ^ Functions for error and exception handling and conversion+  , luaEnvState :: State+    -- ^ Lua interpreter state+  }+ -- | A Lua computation. This is the base type used to run Lua programs of any -- kind. The Lua state is handled automatically, but can be retrieved via -- @'state'@.-newtype Lua a = Lua { unLua :: ReaderT State IO a }+newtype Lua a = Lua { unLua :: ReaderT LuaEnvironment IO a }   deriving     ( Applicative     , Functor@@ -77,26 +104,45 @@     , MonadCatch     , MonadIO     , MonadMask-    , MonadReader State+    , MonadReader LuaEnvironment     , MonadThrow     ) --- | Turn a function of typ @Lua.State -> IO a@ into a monadic lua operation.+-- | Turn a function of typ @Lua.State -> IO a@ into a monadic Lua operation. liftLua :: (State -> IO a) -> Lua a liftLua f = state >>= liftIO . f --- | Turn a function of typ @Lua.State -> a -> IO b@ into a monadic lua operation.+-- | Turn a function of typ @Lua.State -> a -> IO b@ into a monadic Lua operation. liftLua1 :: (State -> a -> IO b) -> a -> Lua b liftLua1 f x = liftLua $ \l -> f l x --- | Get the lua state of this lua computation.+-- | Get the Lua state of this Lua computation. state :: Lua State-state = ask+state = asks luaEnvState --- | Run lua computation with custom lua state. Errors are left unhandled, the--- caller of this function is responsible to catch lua errors.-runWith :: State -> Lua a -> IO a-runWith l s = runReaderT (unLua s) l+-- | Get the error-to-exception function.+errorConversion :: Lua ErrorConversion+errorConversion = asks luaEnvErrorConversion++-- | Run Lua computation with the given Lua state and error-to-exception+-- converter. Any resulting exceptions are left unhandled.+runWithConverter :: ErrorConversion -> State -> Lua a -> IO a+runWithConverter e2e l s =+  runReaderT (unLua s) (LuaEnvironment e2e l)++-- | Run the given operation, but crash if any Haskell exceptions occur.+unsafeRunWith :: State -> Lua a -> IO a+unsafeRunWith = runWithConverter unsafeErrorConversion++-- | Unsafe @'ErrorConversion'@; no proper error handling is attempted,+-- any error leads to a crash.+unsafeErrorConversion :: ErrorConversion+unsafeErrorConversion = ErrorConversion+  { errorToException = const (error "An unrecoverable Lua error occured.")+  , addContextToException = const id+  , alternative = const+  , exceptionToError = id+  }  -- | An opaque structure that points to a thread and indirectly (through the -- thread) to the whole state of a Lua interpreter. The Lua library is fully

@@ -6,7 +6,7 @@ Module      : Foreign.Lua.FunctionCalling Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -26,11 +26,11 @@   , freeCFunction   , newCFunction   , pushHaskellFunction+  , pushPreCFunction   , registerHaskellFunction   ) where  import Data.ByteString (ByteString)-import Data.Monoid ((<>)) import Foreign.C (CInt (..)) import Foreign.Lua.Core as Lua import Foreign.Lua.Types@@ -87,13 +87,18 @@ -- > toHaskellFunction (myFun `catchM` (\e -> raiseError (e :: FooException))) -- toHaskellFunction :: ToHaskellFunction a => a -> HaskellFunction-toHaskellFunction a = toHsFun 1 a `catchException` \(Lua.Exception msg) ->-  raiseError ("Error during function call: " <> msg)+toHaskellFunction a = do+  errConv <- Lua.errorConversion+  let ctx = "Error during function call: "+  Lua.exceptionToError errConv . Lua.addContextToException errConv ctx $+    toHsFun 1 a --- | Create new foreign Lua function. Function created can be called--- by Lua engine. Remeber to free the pointer with @freecfunction@.+-- | Create new foreign Lua function. Function created can be called by+-- the Lua engine. Remeber to free the pointer with @freecfunction@. newCFunction :: ToHaskellFunction a => a -> Lua CFunction-newCFunction = liftIO . mkWrapper . flip runWith . toHaskellFunction+newCFunction f = do+  e2e <- Lua.errorConversion+  liftIO . mkWrapper . flip (Lua.runWithConverter e2e) . toHaskellFunction $ f  -- | Turn a @'PreCFunction'@ into an actual @'CFunction'@. foreign import ccall "wrapper"@@ -140,7 +145,8 @@ -- or by returning the result of @'Lua.error'@. pushHaskellFunction :: ToHaskellFunction a => a -> Lua () pushHaskellFunction hsFn = do-  pushPreCFunction . flip runWith $ toHaskellFunction hsFn+  errConv <- Lua.errorConversion+  pushPreCFunction . flip (runWithConverter errConv) $ toHaskellFunction hsFn   -- Convert userdata object into a CFuntion.   pushcclosure hslua_call_hs_ptr 1 @@ -155,7 +161,7 @@ -- | Converts a pre C function to a Lua function and pushes it to the stack. -- -- Pre C functions collect parameters from the stack and return--- a `CInt` that represents number of return values left in the stack.+-- a `CInt` that represents number of return values left on the stack. pushPreCFunction :: PreCFunction -> Lua () pushPreCFunction f =   let pushMetatable = ensureUserdataMetatable hsLuaFunctionName $ do@@ -168,11 +174,12 @@ -- as a C function and then re-imported in order to get a C function pointer. hslua_call_wrapped_hs_fun :: Lua.State -> IO NumResults hslua_call_wrapped_hs_fun l = do-  mbFn <- runWith l (toAnyWithName stackBottom hsLuaFunctionName-                     <* remove stackBottom)+  mbFn <- unsafeRunWith l (toAnyWithName stackBottom hsLuaFunctionName+                           <* remove stackBottom)   case mbFn of-    Nothing -> runWith l (raiseError ("Could not call function" :: ByteString))     Just fn -> fn l+    Nothing -> unsafeRunWith l+               (raiseError ("Could not call function" :: ByteString))  foreign export ccall hslua_call_wrapped_hs_fun :: PreCFunction foreign import ccall "&hslua_call_wrapped_hs_fun"

@@ -1,6 +1,6 @@ {-| Module      : Foreign.Lua.Module-Copyright   : © 2019 Albert Krewinkel+Copyright   : © 2019-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de> Stability   : alpha

@@ -1,6 +1,6 @@ {-| Module      : Foreign.Lua.Types-Copyright   : © 2017-2019 Albert Krewinkel+Copyright   : © 2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta

@@ -6,7 +6,7 @@ Module      : Foreign.Lua.Types.Peekable Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -24,7 +24,6 @@ import Data.ByteString (ByteString) import Data.Map (Map, fromList) import Data.Set (Set)-import Data.Monoid ((<>)) import Foreign.Lua.Core as Lua import Foreign.Ptr (Ptr) import Text.Read (readMaybe)@@ -65,7 +64,7 @@   actualValue <- Utf8.toString <$> tostring' idx <* pop 1   let msg = "expected " <> expected <> ", got '" <>             actualValue <> "' (" <> actualType <> ")"-  Lua.throwException msg+  Lua.throwMessage msg  -- | A value that can be read from the Lua stack. class Peekable a where@@ -192,8 +191,11 @@             -- removes the value, keeps the key     else return Nothing +-- | Specify a name for the context in which a computation is run. The name is+-- added to the error message in case of an exception. inContext :: String -> Lua a -> Lua a-inContext ctx = Lua.withExceptionMessage (ctx <>)+inContext ctx op = Lua.errorConversion >>= \ec ->+  Lua.addContextToException ec ctx op  -- -- Tuples

@@ -5,7 +5,7 @@ Module      : Foreign.Lua.Types.Pushable Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta

@@ -3,7 +3,7 @@ Module      : Foreign.Lua.Userdata Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta

@@ -1,6 +1,6 @@ {-| Module      : Foreign.Lua.Utf8-Copyright   : © 2018-2019 Albert Krewinkel+Copyright   : © 2018-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -40,5 +40,3 @@ fromText :: Text -> ByteString fromText = TextEncoding.encodeUtf8 {-# INLINABLE fromText #-}--    -- Text.unpack (Encoding.decodeUtf8With TextError.lenientDecode msg)

@@ -2,7 +2,7 @@ Module      : Foreign.Lua.Util Copyright   : © 2007–2012 Gracjan Polak,                 2012–2016 Ömer Sinan Ağacan,-                2017-2019 Albert Krewinkel+                2017-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de> Stability   : beta@@ -14,10 +14,13 @@   ( getglobal'   , setglobal'   , run+  , run'   , runEither   , raiseError   , Optional (Optional, fromOptional)-  -- * getting values+    -- * Default error handling+  , runWith+    -- * getting values   , peekEither   , peekRead   , popValue@@ -38,14 +41,40 @@ -- All exceptions are passed through; error handling is the responsibility of -- the caller. run :: Lua a -> IO a-run = (Lua.newstate `bracket` Lua.close) . flip Lua.runWith . Catch.mask_+run = (Lua.newstate `bracket` Lua.close) . flip runWith . Catch.mask_ +-- | Run Lua computation using the default HsLua state as starting point.+-- Conversion from Lua errors to Haskell exceptions can be controlled through+-- @'Lua.ErrorConversion'@.+run' :: Lua.ErrorConversion -> Lua a -> IO a+run' ec = (Lua.newstate `bracket` Lua.close) .+  flip (Lua.runWithConverter ec) . Catch.mask_+ -- | Run the given Lua computation; exceptions raised in haskell code are -- caught, but other exceptions (user exceptions raised in haskell, unchecked -- type errors, etc.) are passed through.-runEither :: Lua a -> IO (Either Lua.Exception a)+runEither :: Catch.Exception e => Lua a -> IO (Either e a) runEither = try . run +-- | Run Lua computation with the given Lua state and the default+-- error-to-exception converter (@'throwTopStringAsException'@). Exception+-- handling is left to the caller.+runWith :: Lua.State -> Lua a -> IO a+runWith = Lua.runWithConverter defaultErrorConversion++-- | Conversions between Lua errors and Haskell exceptions; only deals with+-- @'Lua.Exception'@s.+defaultErrorConversion :: Lua.ErrorConversion+defaultErrorConversion = Lua.ErrorConversion+  { Lua.errorToException = Lua.throwTopMessageWithState+  , Lua.addContextToException = Lua.withExceptionMessage . (++)+  , Lua.alternative = \x y -> Lua.try x >>= \case+      Left _   -> y+      Right x' -> return x'+  , Lua.exceptionToError = (`Lua.catchException` \ (Lua.Exception msg) ->+                            raiseError msg)+  }+ -- | Like @getglobal@, but knows about packages and nested tables. E.g. -- -- > getglobal' "math.sin"@@ -126,6 +155,8 @@  -- | Try to convert the value at the given stack index to a Haskell value. -- Returns @Left@ with an error message on failure.+--+-- WARNING: this is not save to use with custom error handling! peekEither :: Peekable a => StackIndex -> Lua (Either String a) peekEither idx = either (Left . Lua.exceptionMessage) Right <$>                  Lua.try (Lua.peek idx)

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -23,7 +23,7 @@ {-# OPTIONS_GHC -fno-warn-deprecations #-} {-| Module      :  Foreign.Lua.CoreTests-Copyright   :  © 2017-2019 Albert Krewinkel+Copyright   :  © 2017-2020 Albert Krewinkel License     :  MIT  Maintainer  :  Albert Krewinkel <tarleb+hslua@zeitkraut.de>@@ -38,7 +38,6 @@  import Control.Monad (forM_) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>)) import Foreign.Lua as Lua import Test.HsLua.Arbitrary () import Test.HsLua.Util ( (?:), (=:), shouldBeErrorMessageOf, shouldBeResultOf

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -25,7 +25,6 @@  import Control.Monad (forM_) import Data.ByteString.Char8 as Char8-import Data.Monoid ((<>)) import Foreign.Lua (Lua) import Test.HsLua.Util ( (=:), pushLuaExpr, shouldBeErrorMessageOf                        , shouldBeResultOf )

@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module      : Foreign.Lua.ModuleTests-Copyright   : © 2019 Albert Krewinkel+Copyright   : © 2019-2020 Albert Krewinkel License     : MIT Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de> Stability   : alpha

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -22,7 +22,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module      :  Foreign.Lua.Types.PeekableTests-Copyright   :  © 2017-2019 Albert Krewinkel+Copyright   :  © 2017-2020 Albert Krewinkel License     :  MIT  Maintainer  :  Albert Krewinkel <tarleb+hslua@zeitkraut.de>

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -22,7 +22,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module      :  Foreign.Lua.Types.PushableTests-Copyright   :  © 2017-2019 Albert Krewinkel+Copyright   :  © 2017-2020 Albert Krewinkel License     :  MIT  Maintainer  :  Albert Krewinkel <tarleb+hslua@zeitkraut.de>

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,5 +1,5 @@ {--Copyright © 2018-2019 Albert Krewinkel+Copyright © 2018-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,5 +1,5 @@ {--Copyright © 2018-2019 Albert Krewinkel+Copyright © 2018-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -58,11 +58,11 @@   , testGroup "runEither"     [ "Lua errors are caught" =:       isLeft `shouldHoldForResultOf`-        liftIO (runEither (push True *> peek (-1) :: Lua String))+        liftIO (runEither' (push True *> peek (-1) :: Lua String))      , "error-less code gives 'Right'" =:       isRight `shouldHoldForResultOf`-        liftIO (runEither (push True *> peek (-1) :: Lua Bool))+        liftIO (runEither' (push True *> peek (-1) :: Lua Bool))     ]    , testGroup "peekEither"@@ -105,3 +105,7 @@         return (p1 == p2)     ]   ]+++runEither' :: Lua a -> IO (Either Lua.Exception a)+runEither' = runEither

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -19,25 +19,31 @@ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-| Tests for HsLua -} module Foreign.LuaTests (tests) where  import Prelude hiding (concat) +import Control.Applicative (Alternative (..)) import Data.ByteString (ByteString)+import Data.Data (Typeable) import Data.Either (isLeft)-import Data.Monoid ((<>)) import Foreign.Lua as Lua import System.Mem (performMajorGC) import Test.HsLua.Util ( (=:), (?:), pushLuaExpr, shouldBeErrorMessageOf                        , shouldHoldForResultOf) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, assertEqual, testCase)+import Test.Tasty.HUnit ((@?=), assertBool, assertEqual, testCase) +import qualified Control.Monad.Catch as Catch import qualified Data.ByteString.Char8 as Char8 import qualified Data.Text as T import qualified Data.Text.Encoding as T+import qualified Foreign.Lua.Utf8 as Utf8  -- | Specifications for Attributes parsing functions. tests :: TestTree@@ -136,7 +142,8 @@               then peek (-1)               else throwException "Error in words function."       in assertEqual "greeting function failed"-          (Right ["Caffeine", "induced", "nonsense"]) =<< runEither comp+          (Right ["Caffeine", "induced", "nonsense"])+          =<< (runEither comp :: IO (Either Lua.Exception [String]))      , testCase "pushing a C closure to and calling it from Lua" $       -- Closures would usually be defined on the Haskell side, unless the@@ -157,7 +164,7 @@             peek (-1)        in assertEqual "greeting function failed" (Right "Hello, World!") =<<-         runEither comp+         (runEither comp :: IO (Either Lua.Exception String))     ]    , testGroup "error handling"@@ -173,13 +180,97 @@       `shouldBeErrorMessageOf` do         openbase         loadstring "return error('error message')" *> call 0 1++    , let errTbl ="setmetatable({}, {__index = function(t, k) error(k) end})"+      in testGroup "error conversion"+      [ "throw custom exceptions" =: do+          let comp = do+                openlibs+                pushLuaExpr errTbl+                pushnumber 23+                gettable (Lua.nthFromTop 2) :: Lua ()+          result <- tryCustom comp+          result @?= Left (ExceptionWithNumber 23)++      , "catch custom exception in exposed function" =: do+          let frob n = do+                pushLuaExpr errTbl+                pushnumber n+                gettable (Lua.nthFromTop 2) :: Lua ()+          result <- tryCustom $ do+            openlibs+            registerHaskellFunction "frob" frob+            callFunc "frob" (Lua.Number 42) :: Lua ()+          result @?= Left (ExceptionWithNumber 42)++      , "pass exception through Lua" =: do+          let frob = Catch.throwM (ExceptionWithMessage "borked") :: Lua ()+          result <- tryCustom $ do+            pushHaskellFunction frob+            call 0 1+          result @?= Left (ExceptionWithMessage "borked")++      , "failing peek" =: do+          let msg = "expected integer, got '1.1' (number)"+          result <- tryCustom $ do+            pushnumber 1.1+            peek stackTop :: Lua Lua.Integer+          result @?= Left (ExceptionWithMessage msg)++      , "alternative" =: do+          result <- tryCustom $ do+            pushstring "NaN"+            pushnumber 13.37+            (<|>) (peek (nthFromTop 2) :: Lua Number)+                  (peek stackTop :: Lua Number)+          result @?= Right 13.37+      ]     ]   ] ---------------------------------------------------------------------------------+------------------------------------------------------------------------------- -- luaopen_* functions  testOpen :: String -> Lua () -> TestTree testOpen lib openfn = testCase ("open" ++ lib) $   assertBool "opening the library failed" =<<   run (openfn *> istable (-1))+++-------------------------------------------------------------------------------+-- Custom exception handling++data CustomException =+    ExceptionWithNumber Lua.Number+  | ExceptionWithMessage String+  deriving (Eq, Show, Typeable)++instance Catch.Exception CustomException++customErrorConversion :: Lua.ErrorConversion+customErrorConversion = Lua.ErrorConversion+  { errorToException = errorToCustomException+  , addContextToException = const id+  , alternative = customAlternative+  , exceptionToError = flip Catch.catch $ \case+      ExceptionWithMessage m -> raiseError (Utf8.fromString m)+      ExceptionWithNumber n  -> raiseError n+  }++errorToCustomException :: Lua.State -> IO a+errorToCustomException l = Lua.unsafeRunWith l $+  Lua.tonumber Lua.stackTop >>= \case+    Just num -> do+      Lua.pop 1+      Catch.throwM (ExceptionWithNumber num)+    _        -> do+      msg <- Lua.liftIO (Lua.errorMessage l)+      Catch.throwM (ExceptionWithMessage (Utf8.toString msg))++tryCustom :: Lua a -> IO (Either CustomException a)+tryCustom = Catch.try . Lua.run' customErrorConversion++customAlternative :: Lua a -> Lua a -> Lua a+customAlternative x y = Catch.try x >>= \case+  Left (_ :: CustomException) -> y+  Right x' -> return x'

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -32,7 +32,6 @@   ) where  import Data.ByteString (ByteString)-import Data.Monoid ((<>)) import Foreign.Lua ( Lua, run, runEither, loadstring, call, multret) import Test.Tasty (TestTree) import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))

@@ -1,5 +1,5 @@ {--Copyright © 2017-2019 Albert Krewinkel+Copyright © 2017-2020 Albert Krewinkel  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal