Make Lua type an instance of Alternative

When one operation fails, it should be possible to try a second.

src/Foreign/Lua.hs

@@ -138,8 +138,9 @@ module Foreign.Lua
   -- Lua program, you need to define @_HASKELLERR = {}@ manually, after creating
   -- the Lua state.
   , LuaException (..)
-  , throwLuaError
   , catchLuaError
+  , throwLuaError
+  , tryLua
   ) where
 
 import Prelude hiding (compare, concat)

src/Foreign/Lua/Types/Error.hs

@@ -20,6 +20,7 @@ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
 THE SOFTWARE.
 -}
 {-# LANGUAGE DeriveDataTypeable         #-}
+{-# OPTIONS_GHC -fno-warn-orphans       #-}
 {-|
 Module      : Foreign.Lua.Types.Error
 Copyright   : © 2017 Albert Krewinkel
@@ -34,16 +35,18 @@ module Foreign.Lua.Types.Error
   ( LuaException (..)
   , catchLuaError
   , throwLuaError
+  , tryLua
   ) where
 
+import Control.Applicative (Alternative (..))
 import Control.Exception (Exception)
-import Control.Monad.Catch (throwM, catch)
+import Control.Monad.Catch (catch, throwM, try)
 import Data.Typeable (Typeable)
 import Foreign.Lua.Types.Lua (Lua)
 
 -- | Exceptions raised by Lua-related operations.
 data LuaException = LuaException String
-  deriving (Typeable)
+  deriving (Eq, Typeable)
 
 instance Show LuaException where
   show (LuaException err) = err
@@ -57,3 +60,12 @@ throwLuaError = throwM . LuaException
 -- | Catch a @'LuaException'@.
 catchLuaError :: Lua a -> (LuaException -> Lua a) -> Lua a
 catchLuaError = catch
+
+-- | Return either the result of a Lua computation or, if an exception was
+-- thrown, the error.
+tryLua :: Lua a -> Lua (Either LuaException a)
+tryLua = try
+
+instance Alternative Lua where
+  empty = throwLuaError "empty"
+  x <|> y = either (const y) return =<< tryLua x

test/Foreign/LuaTest.hs

@@ -25,6 +25,7 @@ module Foreign.LuaTest (tests) where
 
 import Prelude hiding (concat)
 
+import Control.Applicative ((<|>))
 import Data.ByteString (ByteString)
 import Data.Either (isLeft, isRight)
 import Data.Monoid ((<>))
@@ -144,6 +145,13 @@ tests = testGroup "lua integration tests"
     , testCase "error-less code gives in 'Right' result" $
       assertBool "error was not intercepted" . isRight =<<
       runLuaEither (push True *> peek (-1) :: Lua Bool)
+
+    , testCase "catching lua errors within the lua type" $
+      assert . isLeft =<< (runLua $ tryLua (throwLuaError "test"))
+
+    , testCase "second alternative is used when first fails" $
+      assertEqual "alternative failed" (Right True) =<<
+      runLuaEither (throwLuaError "test" <|> return True)
     ]
   ]