From 41d0309f660560a684f13bc845279e4dc26e7a1d Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sat, 8 Jul 2017 10:40:55 +0200
Subject: [PATCH] Re-add pushthread wrapper function

It's more difficult to argue why it was left out than to include it.
---
 src/Foreign/Lua.hs            |  1 +
 src/Foreign/Lua/Api.hs        |  8 ++++++++
 src/Foreign/Lua/Api/Types.hsc |  2 +-
 src/Foreign/Lua/Types/Lua.hs  |  1 +
 test/Foreign/Lua/ApiTest.hs   | 15 ++++++++++++++-
 5 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/src/Foreign/Lua.hs b/src/Foreign/Lua.hs
index 62249e6b..39d28bc3 100644
--- a/src/Foreign/Lua.hs
+++ b/src/Foreign/Lua.hs
@@ -99,6 +99,7 @@ module Foreign.Lua
   , pushnil
   , pushnumber
   , pushstring
+  , pushthread
   , pushvalue
   , rawequal
   , rawget
diff --git a/src/Foreign/Lua/Api.hs b/src/Foreign/Lua/Api.hs
index 6d997103..6f4498b5 100644
--- a/src/Foreign/Lua/Api.hs
+++ b/src/Foreign/Lua/Api.hs
@@ -674,6 +674,14 @@ pushstring :: B.ByteString -> Lua ()
 pushstring s = liftLua $ \l ->
   B.unsafeUseAsCStringLen s $ \(sPtr, z) -> lua_pushlstring l sPtr (fromIntegral z)
 
+-- | Pushes the current thread onto the stack. Returns @True@ if this thread is
+-- the main thread of its state, @False@ otherwise.
+--
+-- See also:
+-- <https://www.lua.org/manual/5.3/manual.html#lua_pushthread lua_pushthread>.
+pushthread :: Lua Bool
+pushthread = (1 ==)  <$> liftLua lua_pushthread
+
 -- | Pushes a copy of the element at the given index onto the stack.
 --
 -- See <https://www.lua.org/manual/5.3/manual.html#lua_pushvalue lua_pushvalue>.
diff --git a/src/Foreign/Lua/Api/Types.hsc b/src/Foreign/Lua/Api/Types.hsc
index a96f1118..0784b055 100644
--- a/src/Foreign/Lua/Api/Types.hsc
+++ b/src/Foreign/Lua/Api/Types.hsc
@@ -64,7 +64,7 @@ import Foreign.Ptr
 #include "lua.h"
 
 -- | Synonym for @lua_State *@. See <https://www.lua.org/manual/5.3/#lua_State lua_State>.
-newtype LuaState = LuaState (Ptr ())
+newtype LuaState = LuaState (Ptr ()) deriving (Eq)
 
 -- | Synonym for @lua_Alloc@. See <https://www.lua.org/manual/5.3/#lua_Alloc lua_Alloc>.
 type LuaAlloc = Ptr () -> Ptr () -> CSize -> CSize -> IO (Ptr ())
diff --git a/src/Foreign/Lua/Types/Lua.hs b/src/Foreign/Lua/Types/Lua.hs
index c14f1c70..b2d118bd 100644
--- a/src/Foreign/Lua/Types/Lua.hs
+++ b/src/Foreign/Lua/Types/Lua.hs
@@ -32,6 +32,7 @@ The core Lua types, including mappings of Lua types to Haskell.
 -}
 module Foreign.Lua.Types.Lua
   ( Lua (..)
+  , luaState
   , runLuaWith
   , liftIO
   , liftLua
diff --git a/test/Foreign/Lua/ApiTest.hs b/test/Foreign/Lua/ApiTest.hs
index 1a88ac6b..3839bf8f 100644
--- a/test/Foreign/Lua/ApiTest.hs
+++ b/test/Foreign/Lua/ApiTest.hs
@@ -43,6 +43,7 @@ import Test.QuickCheck (Property, (.&&.))
 import Test.QuickCheck.Arbitrary (Arbitrary (..), arbitraryBoundedEnum)
 import Test.QuickCheck.Monadic (assert, monadicIO, run)
 import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (assertBool, testCase)
 import Test.Tasty.QuickCheck (testProperty)
 
 import qualified Prelude
@@ -71,7 +72,7 @@ tests = testGroup "Haskell version of the C API"
         return (movedEl == 9 && newTop == 8)
     , luaTestCase "inserts stack elements using negative indices" $ do
         pushLuaExpr "1, 2, 3, 4, 5, 6, 7, 8, 9"
-        insert (4)
+        insert 4
         movedEl <- peek 4 :: Lua LuaInteger
         newTop <- peek (-1) :: Lua LuaInteger
         return (movedEl == 9 && newTop == 8)
@@ -112,6 +113,18 @@ tests = testGroup "Haskell version of the C API"
       pushLuaExpr "'Moin'"
       equal (-1) (-2)
 
+  , luaTestCase "can push and receive a thread" $ do
+      luaSt <- luaState
+      isMain <- pushthread
+      liftIO (assertBool "pushing the main thread should return True" isMain)
+      luaSt' <- peek (-1)
+      return (luaSt == luaSt')
+
+  , testCase "different threads are not equal" $ do
+      luaSt1 <- newstate
+      luaSt2 <- newstate
+      assertBool "different lua threads are equal in haskell" (luaSt1 /= luaSt2)
+
   , testGroup "compare"
     [ testProperty "identifies strictly smaller values" $ compareWith (<) OpLT
     , testProperty "identifies smaller or equal values" $ compareWith (<=) OpLE