@@ -77,13 +77,20 @@ module Language.Javascript.JSaddle.Object (
7777import Prelude hiding ((!!))
7878import Language.Javascript.JSaddle.Types
7979 (JSPropertyNameArrayRef, JSStringRef, JSObjectRef, JSValueRefRef,
80− JSValueRef, JSContextRef, Index)
80+ JSValueRef, JSContextRef, Index, castRef)
8181import Foreign.C.Types (CSize(..), CULong(..), CUInt(..), CULLong(..))
8282#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
83−import GHCJS.Types (nullRef, castRef, JSArray, JSFun)
84−import GHCJS.Foreign (newObj, toArray, fromArray, syncCallback2, ForeignRetention(..))
83+import GHCJS.Types (nullRef)
84+import qualified JavaScript.Object.Internal as Object
85+import JavaScript.Object.Internal (Object(Object))
86+import GHCJS.Foreign.Callback (syncCallback2, OnBlocked(ThrowWouldBlock))
87+--import GHCJS.Foreign (newObj, toArray, fromArray, syncCallback2, ForeignRetention(..))
8588import Control.Monad (liftM)
8689import Control.Applicative ((<$>))
90+import qualified JavaScript.Array as Array
91+import JavaScript.Array (JSArray)
92+import GHCJS.Prim (JSRef)
93+import Data.JSString (JSString)
8794#else
8895import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
8996 (jsobjectmake, jspropertynamearraygetnameatindex,
@@ -119,6 +126,15 @@ import Control.Lens
119126 (IndexPreservingGetter, to, (^.))
120127import Language.Javascript.JSaddle.String (textToStr)
121128
129+objectToRef (Object r) = r
130+
131+foreign import javascript unsafe
132+ "$r = $1" jsRefToJSSTring :: JSRef -> JSString
133+
134+foreign import javascript unsafe
135+ "$r = $1" getJSArrayRef :: JSArray -> JSRef
136+
137+
122138-- | If we already have a JSObjectRef we are fine
123139instance MakeObjectRef JSObjectRef where
124140 makeObjectRef = return
@@ -245,7 +261,7 @@ infixr 2 #
245261prop # args = do
246262 rprop <- makePropRef prop
247263 (this, f) <- objGetProperty' rprop
248− rethrow $ objCallAsFunction f this args
264+ rethrow $ objCallAsFunction (castRef f) this args
249265
250266-- | Call a JavaScript function
251267--
@@ -296,7 +312,7 @@ call function this args = do
296312-- Hello
297313obj :: JSM JSObjectRef
298314#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
299−obj = liftIO $ newObj
315+obj = liftIO (castRef . objectToRef <$> Object.create)
300316#else
301317obj = do
302318 gctxt <- ask
@@ -328,60 +344,68 @@ foreign import ccall "wrapper"
328344 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
329345#endif
330346
347+fromArray :: JSArray -> IO [JSStringRef]
348+fromArray a = fmap jsRefToJSSTring <$> Array.toListIO a
349+toArray :: [JSValueRef] -> IO JSArray
350+toArray a = Array.fromListIO (fmap castRef a)
351+
331352-- ^ Make a JavaScript function object that wraps a Haskell function.
332353function :: MakeStringRef name
333354 => name -- ^ Name of the function
334355 -> JSCallAsFunction -- ^ Haskell function to call
335356 -> JSM JSObjectRef -- ^ Returns a JavaScript function object that will
336357 -- call the Haskell one when it is called
337−#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
338−function name f = liftIO $ do
339− callback <- syncCallback2 AlwaysRetain True $ \this args -> do
340− rargs <- fromArray args
341− runReaderT (f this this rargs) () -- TODO pass function object through
342− makeFunctionWithCallback (makeStringRef name) callback
343−foreign import javascript unsafe "$r = function () { $2(this, arguments); }"
344− makeFunctionWithCallback :: JSStringRef -> JSFun (JSValueRef -> JSValueRefRef -> IO ()) -> IO JSObjectRef
345−#elif defined(USE_WEBKIT)
346−function name f = do
347− gctxt <- ask
348− callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap
349− liftIO $ jsobjectmakefunctionwithcallback gctxt (makeStringRef name) callback
350− where
351− wrap ctx fobj this argc argv exception = do
352− args <- peekArray (fromIntegral argc) argv
353− (`runReaderT` ctx) $
354− f fobj this args >>= makeValueRef
355− `E.catch` \(e :: SomeException) -> do
356− str <- runReaderT (makeValueRef . T.pack $ show e) ctx
357− poke exception str
358− jsvaluemakeundefined ctx
359−#else
360−function = undefined
361−#endif
358+-- #if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
359+-- function name f = liftIO $ do
360+-- callback <- syncCallback2 ThrowWouldBlock True $ \this args -> do
361+-- rargs <- fromArray args
362+-- runReaderT (f this this rargs) () -- TODO pass function object through
363+-- makeFunctionWithCallback (makeStringRef name) callback
364+-- foreign import javascript unsafe "$r = function () { $2(this, arguments); }"
365+-- makeFunctionWithCallback :: JSStringRef -> JSFun (JSValueRef -> JSValueRefRef -> IO ()) -> IO JSObjectRef
366+-- #elif defined(USE_WEBKIT)
367+-- function name f = do
368+-- gctxt <- ask
369+-- callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap
370+-- liftIO $ jsobjectmakefunctionwithcallback gctxt (makeStringRef name) callback
371+-- where
372+-- wrap ctx fobj this argc argv exception = do
373+-- args <- peekArray (fromIntegral argc) argv
374+-- (`runReaderT` ctx) $
375+-- f fobj this args >>= makeValueRef
376+-- `E.catch` \(e :: SomeException) -> do
377+-- str <- runReaderT (makeValueRef . T.pack $ show e) ctx
378+-- poke exception str
379+-- jsvaluemakeundefined ctx
380+-- #else
381+-- function = undefined
382+-- #endif
383+
384+function = undefined
362385
363386-- | A callback to Haskell can be used as a JavaScript value. This will create
364387-- an anonymous JavaScript function object. Use 'function' to create one with
365388-- a name.
366389instance MakeValueRef JSCallAsFunction where
367390#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
368− makeValueRef = function (nullRef:: JSStringRef)
391+ makeValueRef a = castRef <$> function (jsRefToJSSTring nullRef :: JSStringRef) a
369392#else
370− makeValueRef = function (nullPtr:: JSStringRef)
393+ makeValueRef a = castRef <$> function (jsRefToJSSTring nullPtr :: JSStringRef) a
371394#endif
372395
373396instance MakeArgRefs JSCallAsFunction where
374397 makeArgRefs f = do
375398#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
376− rarg <- function (nullRef:: JSStringRef) f
399+ rarg <- function (jsRefToJSSTring nullRef :: JSStringRef) f
377400#else
378− rarg <- function (nullPtr:: JSStringRef) f
401+ rarg <- function (jsRefToJSSTring nullPtr :: JSStringRef) f
379402#endif
380− return [rarg]
403+ return [castRef rarg]
381404
382405makeArray :: MakeArgRefs args => args -> JSValueRefRef -> JSM JSObjectRef
383406#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
384−makeArray args exceptions = makeArgRefs args >>= liftM castRef . liftIO . toArray
407+--makeArray args exceptions = makeArgRefs args >>= liftIO . toArray
408+makeArray args exceptions = makeArgRefs args >>= liftM (castRef . getJSArrayRef) . liftIO . toArray
385409#else
386410makeArray args exceptions = do
387411 gctxt <- ask
@@ -441,7 +465,7 @@ propertyNames :: MakeObjectRef this => this -> JSM [JSStringRef]
441465#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
442466propertyNames this = makeObjectRef this >>= liftIO . js_propertyNames >>= liftIO . fromArray
443467foreign import javascript unsafe "$r = []; h$forIn($1, function(n){$r.push(n);})"
444− js_propertyNames :: JSObjectRef -> IO (JSArray a)
468+ js_propertyNames :: JSObjectRef -> IO JSArray
445469#elif defined(USE_WEBKIT)
446470propertyNames this = copyPropertyNames this >>= propertyNamesList
447471#else
@@ -461,7 +485,7 @@ objCallAsFunction :: MakeArgRefs args
461485 -> JSM JSValueRef
462486#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
463487objCallAsFunction function this args exceptions = do
464− rargs <- makeArgRefs args >>= liftIO . toArray
488+ rargs <- (makeArgRefs args >>= liftIO . toArray) >>= (liftIO . Array.thaw)
465489 liftIO $ js_apply function this rargs exceptions
466490foreign import javascript unsafe "try { $r = $1.apply($2, $3) } catch(e) { $4[0] = e }"
467491 js_apply :: JSObjectRef -> JSObjectRef -> JSValueRefRef -> JSValueRefRef -> IO JSValueRef
@@ -486,7 +510,7 @@ objCallAsConstructor :: MakeArgRefs args
486510 -> JSM JSValueRef
487511#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
488512objCallAsConstructor function args exceptions = do
489− rargs <- makeArgRefs args >>= liftIO . toArray
513+ rargs <- (makeArgRefs args >>= liftIO . toArray) >>= (liftIO . Array.thaw)
490514 liftIO $ js_new function rargs exceptions
491515foreign import javascript unsafe "\
492516 try {\