remove duplicate OnBlocked data structure and add three-argument callbacks

Author: luite

GHCJS/Concurrent.hs

@@ -26,8 +26,8 @@
  -}
 
 module GHCJS.Concurrent ( isThreadSynchronous
-                        , isContinueAsync
-                        , OnBlock (..)
+                        , isThreadContinueAsync
+                        , OnBlocked(..)
                         , WouldBlockException(..)
                         , synchronously
                         ) where
@@ -47,9 +47,17 @@ import           Data.Typeable
 
 import           Unsafe.Coerce
 
-data OnBlock = ContinueAsync
-             | ThrowWouldBlock
-             deriving (Data, Typeable, Enum, Show, Eq, Ord)
+{- |
+     The runtime tries to run synchronous threads to completion. Sometimes it's
+     not possible to continue running a thread, for example when the thread
+     tries to take an empty 'MVar'. The runtime can then either throw a
+     'WouldBlockException', aborting the blocking action, or continue the
+     thread asynchronously.
+ -}
+
+data OnBlocked = ContinueAsync -- ^ continue the thread asynchronously if blocked
+               | ThrowWouldBlock -- ^ throw 'WouldBlockException' if blocked
+               deriving (Data, Typeable, Enum, Show, Eq, Ord)
 
 {- |
      Runs the action synchronously, which means that the thread will not
@@ -80,8 +88,8 @@ isThreadSynchronous = fmap (`testBit` 0) . syncThreadState
      Returns whether the 'ThreadId' will continue running async. Always
      returns 'True' when the thread is not synchronous.
  -}
-isContinueAsync :: ThreadId -> IO Bool
-isContinueAsync = fmap (`testBit` 1) . syncThreadState
+isThreadContinueAsync :: ThreadId -> IO Bool
+isThreadContinueAsync = fmap (`testBit` 1) . syncThreadState
 
 syncThreadState :: ThreadId-> IO Int
 syncThreadState (ThreadId tid) = js_syncThreadState tid

GHCJS/Foreign/Callback.hs

@@ -7,11 +7,14 @@ module GHCJS.Foreign.Callback
     , asyncCallback
     , asyncCallback1
     , asyncCallback2
+    , asyncCallback3
     , syncCallback
     , syncCallback1
     , syncCallback2
+    , syncCallback3
     ) where
 
+import           GHCJS.Concurrent
 import           GHCJS.Marshal
 import           GHCJS.Marshal.Pure
 import           GHCJS.Foreign.Callback.Internal
@@ -24,17 +27,6 @@ import           Data.Typeable
 
 import           Unsafe.Coerce
 
-{- |
-     The runtime tries to run synchronous threads to completion. Sometimes it's
-     not possible to continue running a thread, for example when the thread
-     tries to take an empty 'MVar'. The runtime can then either throw a
-     'WouldBlockException', aborting the blocking action, or continue the
-     thread asynchronously.
- -}
-data OnBlocked = ContinueAsync   -- ^ continue the thread asynchronously if blocked
-               | ThrowWouldBlock -- ^ throw 'WouldBlockException' if blocked
-               deriving (Show, Eq, Enum, Typeable)
-
 {- |
      When you create a callback, the Haskell runtime stores a reference to
      the exported IO action or function. This means that all data referenced by the
@@ -84,6 +76,19 @@ syncCallback2 :: OnBlocked                               -- ^ what to do when th
               -> IO (Callback (JSVal -> JSVal -> IO ())) -- ^ the callback
 syncCallback2 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 2 (unsafeCoerce x)
 
+{- | Make a callback (JavaScript function) that runs the supplied IO function in a synchronous
+     thread when called. The callback takes three arguments that it passes as JSVal values to
+     the Haskell function.
+
+     Call 'releaseCallback' when done with the callback, freeing data referenced
+     by the function.
+ -}
+syncCallback3 :: OnBlocked                               -- ^ what to do when the thread blocks
+              -> (JSVal -> JSVal -> JSVal -> IO ())               -- ^ the Haskell function
+              -> IO (Callback (JSVal -> JSVal -> JSVal -> IO ())) -- ^ the callback
+syncCallback3 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 3 (unsafeCoerce x)
+
+
 
 {- | Make a callback (JavaScript function) that runs the supplied IO action in an asynchronous
      thread when called.
@@ -103,6 +108,10 @@ asyncCallback2 :: (JSVal -> JSVal -> IO ())            -- ^ the Haskell function
                -> IO (Callback (JSVal -> JSVal -> IO ())) -- ^ the callback
 asyncCallback2 x = js_asyncCallbackApply 2 (unsafeCoerce x)
 
+asyncCallback3 :: (JSVal -> JSVal -> JSVal -> IO ())               -- ^ the Haskell function that the callback calls
+               -> IO (Callback (JSVal -> JSVal -> JSVal -> IO ())) -- ^ the callback
+asyncCallback3 x = js_asyncCallbackApply 3 (unsafeCoerce x)
+
 -- ----------------------------------------------------------------------------
 
 foreign import javascript unsafe "h$makeCallback(h$runSync, [$1], $2)"