@@ -3,10 +3,11 @@
33{-# LANGUAGE TypeSynonymInstances #-}
44{-# LANGUAGE ScopedTypeVariables #-}
55{-# LANGUAGE Rank2Types #-}
6−{-# LANGUAGE ForeignFunctionInterface #-}
76#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
7+{-# LANGUAGE ForeignFunctionInterface #-}
88{-# LANGUAGE JavaScriptFFI #-}
99#endif
10+{-# OPTIONS_GHC -fno-warn-orphans #-}
1011-----------------------------------------------------------------------------
1112--
1213-- Module : Language.Javascript.JSaddle.Object
@@ -28,7 +29,7 @@ module Language.Javascript.JSaddle.Object (
2829 , (!!)
2930 , js
3031 , jss
31− , JSF(..)
32+ , JSF
3233 , jsf
3334 , js0
3435 , js1
@@ -57,9 +58,11 @@ module Language.Javascript.JSaddle.Object (
5758 , obj
5859
5960 -- * Calling Haskell From JavaScript
61+ , Function(..)
6062 , function
63+ , freeFunction
6164 , fun
62− , JSCallAsFunction(..)
65+ , JSCallAsFunction
6366 -- ** Object Constructors
6467
6568 -- | There is no good way to support calling haskell code as a JavaScript
@@ -78,20 +81,23 @@ module Language.Javascript.JSaddle.Object (
7881
7982 -- * Enumerating Properties
8083 , propertyNames
84+ , properties
8185
8286 -- * Low level
8387 , objCallAsFunction
8488 , objCallAsConstructor
89+ , nullObject
8590) where
8691
8792import Prelude hiding ((!!))
8893import Language.Javascript.JSaddle.Types
8994 (JSPropertyNameArray, JSString, Object(..), MutableJSArray,
9095 JSVal, Index)
91−import Foreign.C.Types (CSize(..), CULong(..), CUInt(..), CULLong(..))
96+import Foreign.C.Types (CSize(..), CULong(..))
9297#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
9398import GHCJS.Types (nullRef, jsval)
94−import GHCJS.Foreign.Callback (syncCallback2, OnBlocked(..), Callback)
99+import GHCJS.Foreign.Callback
100+ (releaseCallback, syncCallback2, OnBlocked(..), Callback)
95101import GHCJS.Marshal.Pure (pFromJSVal)
96102import JavaScript.Array (JSArray)
97103import qualified JavaScript.Array as Array (toListIO, fromListIO)
@@ -104,39 +110,39 @@ import Data.Coerce (coerce)
104110import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
105111 (jsobjectmake, jspropertynamearraygetnameatindex,
106112 jspropertynamearraygetcount, jsobjectcopypropertynames,
107− jsobjectsetpropertyatindex, jsobjectgetpropertyatindex,
108113 jsobjectcallasconstructor, jsobjectmakearray,
109− jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,
110− JSPropertyAttributes, JSObjectCallAsFunctionCallback,
114+ jsobjectcallasfunction,
115+ JSObjectCallAsFunctionCallback,
111116 jsobjectmakefunctionwithcallback, JSObjectCallAsFunctionCallback')
112117import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
113118 (jsvaluemakeundefined)
114119import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef
115120 (jscontextgetglobalobject)
116121import Foreign (peekArray, nullPtr, withArrayLen)
122+import Foreign.Ptr (freeHaskellFunPtr)
123+import Language.Javascript.JSaddle.Native
124+ (makeNewJSVal, wrapJSString, withJSVals, withObject, withJSString,
125+ withToJSVal)
126+import System.IO.Unsafe (unsafePerformIO)
127+import Foreign.ForeignPtr (newForeignPtr_)
117128#endif
118129import Language.Javascript.JSaddle.Exception (rethrow)
119130import Language.Javascript.JSaddle.Value
120− (JSUndefined, valMakeUndefined, valToObject)
131+ (JSUndefined, valToObject)
121132import Language.Javascript.JSaddle.Classes
122− (MakeVal(..), MakeString(..), MakeArgs(..), MakeObject(..))
133+ (ToJSVal(..), ToJSString(..), MakeObject(..))
134+import Language.Javascript.JSaddle.Arguments (MakeArgs(..))
123135import Language.Javascript.JSaddle.Monad
124136 (JSM)
125137import Control.Monad.Trans.Reader (runReaderT, ask)
126138import Control.Monad.IO.Class (MonadIO(..))
127139import qualified Control.Exception as E (catch)
128140import Control.Exception (SomeException)
129−import qualified Data.Text as T (pack)
130141import Foreign.Storable (Storable(..))
131142import Language.Javascript.JSaddle.Properties
132−import Control.Lens
133− (IndexPreservingGetter, to, (^.))
134−import Language.Javascript.JSaddle.String (textToStr)
135−
136−-- | If we already have a Object we are fine
137−instance MakeObject Object where
138− makeObject = return
139− {-# INLINE makeObject #-}
143+import Control.Lens (IndexPreservingGetter, to)
144+import Language.Javascript.JSaddle.String (nullJSString)
145+import Data.Text (Text)
140146
141147-- | Object can be made by evaluating a function in 'JSM' as long
142148-- as it returns something we can make into a Object.
@@ -149,7 +155,7 @@ instance MakeObject v => MakeObject (JSM v) where
149155-- >>> testJSaddle $ eval "'Hello World'.length"
150156-- >>> testJSaddle $ val "Hello World" ! "length"
151157-- 11
152−(!) :: (MakeObject this, MakeString name)
158+(!) :: (MakeObject this, ToJSString name)
153159 => this -- ^ Object to look on
154160 -> name -- ^ Name of the property to find
155161 -> JSM JSVal -- ^ Property reference
@@ -157,7 +163,7 @@ this ! name = do
157163 rthis <- makeObject this
158164 rethrow $ objGetPropertyByName rthis rname
159165 where
160− rname = makeString name
166+ rname = toJSString name
161167{-# INLINE (!) #-}
162168
163169-- | Lookup a property based on its index.
@@ -181,7 +187,7 @@ this !! index = do
181187-- >>> testJSaddle $ eval "'Hello World'.length"
182188-- >>> testJSaddle $ val "Hello World" ^. js "length"
183189-- 11
184−js :: (MakeObject s, MakeString name)
190+js :: (MakeObject s, ToJSString name)
185191 => name -- ^ Name of the property to find
186192 -> IndexPreservingGetter s (JSM JSVal)
187193js name = to (!name)
@@ -194,7 +200,7 @@ js name = to (!name)
194200-- >>> testJSaddle $ eval "'Hello World'.length"
195201-- >>> testJSaddle $ val "Hello World" ^. js "length"
196202-- 11
197−jss :: (MakeString name, MakeVal val)
203+jss :: (ToJSString name, ToJSVal val)
198204 => name -- ^ Name of the property to find
199205 -> val
200206 -> forall o . MakeObject o => IndexPreservingGetter o (JSM ())
@@ -207,7 +213,7 @@ jss name val = to (\o -> o <# name $ val)
207213--
208214-- >>> testJSaddle $ val "Hello World" ^. jsf "indexOf" ["World"]
209215-- 6
210−jsf :: (MakeString name, MakeArgs args) => name -> args -> JSF
216+jsf :: (ToJSString name, MakeArgs args) => name -> args -> JSF
211217jsf name args = to (\o -> o # name $ args)
212218{-# INLINE jsf #-}
213219
@@ -220,7 +226,7 @@ type JSF = forall o . MakeObject o => IndexPreservingGetter o (JSM JSVal)
220226--
221227-- >>> testJSaddle $ val "Hello World" ^. js0 "toLowerCase"
222228-- hello world
223−js0 :: (MakeString name) => name -> JSF
229+js0 :: (ToJSString name) => name -> JSF
224230js0 name = jsf name ()
225231{-# INLINE js0 #-}
226232
@@ -230,31 +236,31 @@ js0 name = jsf name ()
230236--
231237-- >>> testJSaddle $ val "Hello World" ^. js1 "indexOf" "World"
232238-- 6
233−js1 :: (MakeString name, MakeVal a0) => name -> a0 -> JSF
239+js1 :: (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
234240js1 name a0 = jsf name [a0]
235241{-# INLINE js1 #-}
236242
237243-- | Handy way to call a function that expects two arguments
238−js2 :: (MakeString name, MakeVal a0, MakeVal a1) => name -> a0 -> a1 -> JSF
244+js2 :: (ToJSString name, ToJSVal a0, ToJSVal a1) => name -> a0 -> a1 -> JSF
239245js2 name a0 a1 = jsf name (a0, a1)
240246{-# INLINE js2 #-}
241247
242248-- | Handy way to call a function that expects three arguments
243−js3 :: (MakeString name, MakeVal a0, MakeVal a1, MakeVal a2)
249+js3 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2)
244250 => name -> a0 -> a1 -> a2 -> JSF
245251js3 name a0 a1 a2 = jsf name (a0, a1, a2)
246252{-# INLINE js3 #-}
247253
248254-- | Handy way to call a function that expects four arguments
249−js4 :: (MakeString name, MakeVal a0, MakeVal a1, MakeVal a2,
250− MakeVal a3)
255+js4 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,
256+ ToJSVal a3)
251257 => name -> a0 -> a1 -> a2 -> a3 -> JSF
252258js4 name a0 a1 a2 a3 = jsf name (a0, a1, a2, a3)
253259{-# INLINE js4 #-}
254260
255261-- | Handy way to call a function that expects five arguments
256−js5 :: (MakeString name, MakeVal a0, MakeVal a1, MakeVal a2,
257− MakeVal a3, MakeVal a4)
262+js5 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,
263+ ToJSVal a3, ToJSVal a4)
258264 => name -> a0 -> a1 -> a2 -> a3 -> a4 -> JSF
259265js5 name a0 a1 a2 a3 a4 = jsf name (a0, a1, a2, a3, a4)
260266{-# INLINE js5 #-}
@@ -265,7 +271,7 @@ js5 name a0 a1 a2 a3 a4 = jsf name (a0, a1, a2, a3, a4)
265271-- >>> testJSaddle $ eval "w = console; w.log('Hello World')"
266272-- >>> testJSaddle $ do w <- jsg "console"; w ^. js "log" # ["Hello World"]
267273-- 11
268−jsg :: MakeString a => a -> JSM JSVal
274+jsg :: ToJSString a => a -> JSM JSVal
269275jsg name = global ! name
270276{-# INLINE jsg #-}
271277
@@ -275,7 +281,7 @@ jsg name = global ! name
275281--
276282-- >>> testJSaddle $ jsf "globalFunc" ["World"]
277283-- 6
278−jsgf :: (MakeString name, MakeArgs args) => name -> args -> JSM JSVal
284+jsgf :: (ToJSString name, MakeArgs args) => name -> args -> JSM JSVal
279285jsgf name = global # name
280286{-# INLINE jsgf #-}
281287
@@ -285,7 +291,7 @@ jsgf name = global # name
285291--
286292-- >>> testJSaddle $ js0 "globalFunc"
287293-- hello world
288−jsg0 :: (MakeString name) => name -> JSM JSVal
294+jsg0 :: (ToJSString name) => name -> JSM JSVal
289295jsg0 name = jsgf name ()
290296{-# INLINE jsg0 #-}
291297
@@ -295,31 +301,31 @@ jsg0 name = jsgf name ()
295301--
296302-- >>> testJSaddle $ jsg1 "globalFunc" "World"
297303-- 6
298−jsg1 :: (MakeString name, MakeVal a0) => name -> a0 -> JSM JSVal
304+jsg1 :: (ToJSString name, ToJSVal a0) => name -> a0 -> JSM JSVal
299305jsg1 name a0 = jsgf name [a0]
300306{-# INLINE jsg1 #-}
301307
302308-- | Handy way to call a function that expects two arguments
303−jsg2 :: (MakeString name, MakeVal a0, MakeVal a1) => name -> a0 -> a1 -> JSM JSVal
309+jsg2 :: (ToJSString name, ToJSVal a0, ToJSVal a1) => name -> a0 -> a1 -> JSM JSVal
304310jsg2 name a0 a1 = jsgf name (a0, a1)
305311{-# INLINE jsg2 #-}
306312
307313-- | Handy way to call a function that expects three arguments
308−jsg3 :: (MakeString name, MakeVal a0, MakeVal a1, MakeVal a2)
314+jsg3 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2)
309315 => name -> a0 -> a1 -> a2 -> JSM JSVal
310316jsg3 name a0 a1 a2 = jsgf name (a0, a1, a2)
311317{-# INLINE jsg3 #-}
312318
313319-- | Handy way to call a function that expects four arguments
314−jsg4 :: (MakeString name, MakeVal a0, MakeVal a1, MakeVal a2,
315− MakeVal a3)
320+jsg4 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,
321+ ToJSVal a3)
316322 => name -> a0 -> a1 -> a2 -> a3 -> JSM JSVal
317323jsg4 name a0 a1 a2 a3 = jsgf name (a0, a1, a2, a3)
318324{-# INLINE jsg4 #-}
319325
320326-- | Handy way to call a function that expects five arguments
321−jsg5 :: (MakeString name, MakeVal a0, MakeVal a1, MakeVal a2,
322− MakeVal a3, MakeVal a4)
327+jsg5 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,
328+ ToJSVal a3, ToJSVal a4)
323329 => name -> a0 -> a1 -> a2 -> a3 -> a4 -> JSM JSVal
324330jsg5 name a0 a1 a2 a3 a4 = jsgf name (a0, a1, a2, a3, a4)
325331{-# INLINE jsg5 #-}
@@ -330,7 +336,7 @@ jsg5 name a0 a1 a2 a3 a4 = jsgf name (a0, a1, a2, a3, a4)
330336-- >>> testJSaddle $ val "Hello World" # "indexOf" $ ["World"]
331337-- 6
332338infixr 2 #
333−(#) :: (MakeObject this, MakeString name, MakeArgs args)
339+(#) :: (MakeObject this, ToJSString name, MakeArgs args)
334340 => this -> name -> args -> JSM JSVal
335341(#) this name args = do
336342 rthis <- makeObject this
@@ -359,7 +365,7 @@ infixr 2 ##
359365-- >>> testJSaddle $ do {j <- eval "({})"; j <# "x" 1; j!"x"}
360366-- 1
361367infixr 1 <#
362−(<#) :: (MakeObject this, MakeString name, MakeVal val)
368+(<#) :: (MakeObject this, ToJSString name, ToJSVal val)
363369 => this -- ^ Object to set the property on
364370 -> name -- ^ Name of the property to set
365371 -> val -- ^ Value to set it to
@@ -375,7 +381,7 @@ infixr 1 <#
375381-- >>> testJSaddle $ do {j <- eval "({})"; j <## 6 1; j!!6}
376382-- 1
377383infixr 1 <##
378−(<##) :: (MakeObject this, MakeVal val)
384+(<##) :: (MakeObject this, ToJSVal val)
379385 => this -- ^ Object to set the property on
380386 -> Index -- ^ Index of the property to set
381387 -> val -- ^ Value to set it to
@@ -406,10 +412,10 @@ new constructor args = do
406412-- >>> testJSaddle $ eval "(function(){return this;}).apply('Hello', [])"
407413-- >>> testJSaddle $ do { test <- eval "(function(){return this;})"; call test (val "Hello") () }
408414-- Hello
409−call :: (MakeObject function, MakeObject this, MakeArgs args)
410− => function -> this -> args -> JSM JSVal
411−call function this args = do
412− rfunction <- makeObject function
415+call :: (MakeObject f, MakeObject this, MakeArgs args)
416+ => f -> this -> args -> JSM JSVal
417+call f this args = do
418+ rfunction <- makeObject f
413419 rthis <- makeObject this
414420 rethrow $ objCallAsFunction rfunction rthis args
415421{-# INLINE call #-}
@@ -425,7 +431,7 @@ obj = liftIO Object.create
425431#else
426432obj = do
427433 gctxt <- ask
428− liftIO $ Object <$> jsobjectmake gctxt nullPtr nullPtr
434+ Object <$> ((liftIO $ jsobjectmake gctxt nullPtr nullPtr) >>= makeNewJSVal)
429435#endif
430436{-# INLINE obj #-}
431437
@@ -455,56 +461,74 @@ foreign import ccall "wrapper"
455461 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
456462#endif
457463
464+#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI) || !defined(USE_WEBKIT)
465+type HaskellCallback = Callback (JSVal -> JSVal -> IO ())
466+#else
467+type HaskellCallback = JSObjectCallAsFunctionCallback
468+#endif
469+
470+data Function = Function {functionCallback :: HaskellCallback, functionObject :: Object}
471+
458472-- ^ Make a JavaScript function object that wraps a Haskell function.
459−function :: MakeString name
473+function :: ToJSString name
460474 => name -- ^ Name of the function
461475 -> JSCallAsFunction -- ^ Haskell function to call
462− -> JSM Object -- ^ Returns a JavaScript function object that will
476+ -> JSM Function -- ^ Returns a JavaScript function object that will
463477 -- call the Haskell one when it is called
464478#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
465479function name f = liftIO $ do
466480 callback <- syncCallback2 ContinueAsync $ \this args -> do
467481 rargs <- Array.toListIO (coerce args)
468482 runReaderT (f this this rargs) () -- TODO pass function object through
469− makeFunctionWithCallback (makeString name) callback
483+ Function callback <$> makeFunctionWithCallback (toJSString name) callback
470484foreign import javascript unsafe "$r = function () { $2(this, arguments); }"
471485 makeFunctionWithCallback :: JSString -> Callback (JSVal -> JSVal -> IO ()) -> IO Object
472486#elif defined(USE_WEBKIT)
473487function name f = do
474488 gctxt <- ask
475− callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap
476− liftIO $ Object <$> jsobjectmakefunctionwithcallback gctxt (makeString name) callback
489+ callback <- liftIO $ mkJSObjectCallAsFunctionCallback (wrap gctxt)
490+ withJSString (toJSString name) $ \name' ->
491+ Function callback . Object <$>
492+ ((liftIO $ jsobjectmakefunctionwithcallback gctxt name' callback) >>= makeNewJSVal)
477493 where
478− wrap ctx fobj this argc argv exception = do
479− args <- peekArray (fromIntegral argc) argv
480− (`runReaderT` ctx) $
481− f fobj this args >>= makeVal
494+ wrap gctxt _ctx fobj' this' argc argv exception = do
495+ args' <- peekArray (fromIntegral argc) argv
496+ (`runReaderT` gctxt) $ do
497+ fobj <- makeNewJSVal fobj'
498+ this <- makeNewJSVal this'
499+ args <- mapM makeNewJSVal args'
500+ f fobj this args
501+ liftIO $ jsvaluemakeundefined gctxt
482502 `E.catch` \(e :: SomeException) -> do
483− str <- runReaderT (makeVal . T.pack $ show e) ctx
484− poke exception str
485− jsvaluemakeundefined ctx
503+ (`runReaderT` gctxt) $ do
504+ withToJSVal (show e) $ liftIO . poke exception
505+ liftIO $ jsvaluemakeundefined gctxt
486506#else
487507function = undefined
488508#endif
489509
510+freeFunction :: MonadIO m => Function -> m ()
511+freeFunction (Function callback _) = liftIO $
512+#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI) || !defined(USE_WEBKIT)
513+ releaseCallback callback
514+#else
515+ freeHaskellFunPtr callback
516+#endif
517+
518+instance ToJSVal Function where
519+ toJSVal (Function _ f) = toJSVal f
520+ {-# INLINE toJSVal #-}
521+
490522-- | A callback to Haskell can be used as a JavaScript value. This will create
491523-- an anonymous JavaScript function object. Use 'function' to create one with
492524-- a name.
493−instance MakeVal JSCallAsFunction where
494−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
495− makeVal f = jsval <$> function (pFromJSVal nullRef :: JSString) f
496−#else
497− makeVal f = function (nullPtr :: JSString) f >>= makeVal
498−#endif
499− {-# INLINE makeVal #-}
525+instance ToJSVal JSCallAsFunction where
526+ toJSVal f = functionObject <$> function nullJSString f >>= toJSVal
527+ {-# INLINE toJSVal #-}
500528
501529instance MakeArgs JSCallAsFunction where
502530 makeArgs f = do
503−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
504− rarg <- jsval <$> function (pFromJSVal nullRef :: JSString) f
505−#else
506− rarg <- function (nullPtr:: JSString) f >>= makeVal
507−#endif
531+ rarg <- functionObject <$> function nullJSString f >>= toJSVal
508532 return [rarg]
509533 {-# INLINE makeArgs #-}
510534
@@ -517,8 +541,11 @@ makeArray args exceptions = do
517541makeArray args exceptions = do
518542 gctxt <- ask
519543 rargs <- makeArgs args
520− liftIO $ withArrayLen rargs $ \ len ptr ->
521− Object <$> jsobjectmakearray gctxt (fromIntegral len) ptr exceptions
544+ result <-
545+ withJSVals rargs $ \rargs' ->
546+ liftIO $ withArrayLen rargs' $ \ len ptr ->
547+ jsobjectmakearray gctxt (fromIntegral len) ptr exceptions
548+ Object <$> makeNewJSVal result
522549#endif
523550{-# INLINE makeArray #-}
524551
@@ -533,6 +560,43 @@ makeArray args exceptions = do
533560array :: MakeArgs args => args -> JSM Object
534561array = rethrow . makeArray
535562
563+-- Make an array out of various lists
564+instance ToJSVal [JSVal] where
565+ toJSVal = toJSVal . array
566+ {-# INLINE toJSVal #-}
567+
568+instance ToJSVal [JSM JSVal] where
569+ toJSVal = toJSVal . array
570+ {-# INLINE toJSVal #-}
571+
572+instance ToJSVal [Double] where
573+ toJSVal = toJSVal . array
574+ {-# INLINE toJSVal #-}
575+
576+instance ToJSVal [Float] where
577+ toJSVal = toJSVal . array
578+ {-# INLINE toJSVal #-}
579+
580+instance ToJSVal [Int] where
581+ toJSVal = toJSVal . array
582+ {-# INLINE toJSVal #-}
583+
584+instance ToJSVal [JSString] where
585+ toJSVal = toJSVal . array
586+ {-# INLINE toJSVal #-}
587+
588+instance ToJSVal [String] where
589+ toJSVal = toJSVal . array
590+ {-# INLINE toJSVal #-}
591+
592+instance ToJSVal [Text] where
593+ toJSVal = toJSVal . array
594+ {-# INLINE toJSVal #-}
595+
596+instance ToJSVal [Bool] where
597+ toJSVal = toJSVal . array
598+ {-# INLINE toJSVal #-}
599+
536600-- | JavaScript's global object
537601global :: JSM Object
538602#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
@@ -541,7 +605,10 @@ global = liftIO js_window
541605foreign import javascript unsafe "$r = window"
542606 js_window :: IO Object
543607#elif defined(USE_WEBKIT)
544−global = ask >>= (liftIO . fmap Object . jscontextgetglobalobject)
608+global = do
609+ gctxt <- ask
610+ result <- liftIO $ jscontextgetglobalobject gctxt
611+ Object <$> makeNewJSVal result
545612{-# INLINE global #-}
546613#else
547614global = undefined
@@ -552,8 +619,9 @@ global = undefined
552619copyPropertyNames :: MakeObject this => this -> JSM JSPropertyNameArray
553620copyPropertyNames this = do
554621 gctxt <- ask
555− Object rthis <- makeObject this
556− liftIO $ jsobjectcopypropertynames gctxt rthis
622+ this' <- makeObject this
623+ withObject this' $ \rthis ->
624+ liftIO $ jsobjectcopypropertynames gctxt rthis
557625{-# INLINE copyPropertyNames #-}
558626
559627-- | Get the number of names in a property name array
@@ -563,7 +631,7 @@ propertyNamesCount names = liftIO $ jspropertynamearraygetcount names
563631
564632-- | Get a name out of a property name array
565633propertyNamesAt :: MonadIO m => JSPropertyNameArray -> CSize -> m JSString
566−propertyNamesAt names index = liftIO $ jspropertynamearraygetnameatindex names index
634+propertyNamesAt names index = liftIO $ jspropertynamearraygetnameatindex names index >>= wrapJSString
567635{-# INLINE propertyNamesAt #-}
568636
569637-- | Convert property array to a list
@@ -600,18 +668,23 @@ objCallAsFunction :: MakeArgs args
600668 -> MutableJSArray
601669 -> JSM JSVal
602670#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
603−objCallAsFunction function this args exceptions = do
671+objCallAsFunction f this args exceptions = do
604672 rargs <- makeArgs args >>= liftIO . Array.fromListIO
605− liftIO $ js_apply function this rargs exceptions
673+ liftIO $ js_apply f this rargs exceptions
606674{-# INLINE objCallAsFunction #-}
607675foreign import javascript unsafe "try { $r = $1.apply($2, $3) } catch(e) { $4[0] = e }"
608676 js_apply :: Object -> Object -> MutableJSArray -> MutableJSArray -> IO JSVal
609677#elif defined(USE_WEBKIT)
610−objCallAsFunction (Object function) (Object this) args exceptions = do
678+objCallAsFunction f this args exceptions = do
611679 gctxt <- ask
612680 rargs <- makeArgs args
613− liftIO $ withArrayLen rargs $ \ largs pargs ->
614− jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions
681+ result <-
682+ withObject f $ \rfunction ->
683+ withObject this $ \rthis ->
684+ withJSVals rargs $ \rargs' ->
685+ liftIO $ withArrayLen rargs' $ \ largs pargs ->
686+ jsobjectcallasfunction gctxt rfunction rthis (fromIntegral largs) pargs exceptions
687+ makeNewJSVal result
615688{-# INLINE objCallAsFunction #-}
616689#else
617690objCallAsFunction = undefined
@@ -627,9 +700,9 @@ objCallAsConstructor :: MakeArgs args
627700 -> MutableJSArray
628701 -> JSM JSVal
629702#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)
630−objCallAsConstructor function args exceptions = do
703+objCallAsConstructor f args exceptions = do
631704 rargs <- makeArgs args >>= liftIO . Array.fromListIO
632− liftIO $ js_new function rargs exceptions
705+ liftIO $ js_new f rargs exceptions
633706foreign import javascript unsafe "\
634707 try {\
635708 switch($2.length) {\
@@ -659,15 +732,25 @@ foreign import javascript unsafe "\
659732 }"
660733 js_new :: Object -> MutableJSArray -> MutableJSArray -> IO JSVal
661734#elif defined(USE_WEBKIT)
662−objCallAsConstructor (Object function) args exceptions = do
735+objCallAsConstructor f args exceptions = do
663736 gctxt <- ask
664737 rargs <- makeArgs args
665− liftIO $ withArrayLen rargs $ \ largs pargs ->
666− jsobjectcallasconstructor gctxt function (fromIntegral largs) pargs exceptions
738+ result <-
739+ withObject f $ \rfunction ->
740+ withJSVals rargs $ \rargs' ->
741+ liftIO $ withArrayLen rargs' $ \ largs pargs ->
742+ jsobjectcallasconstructor gctxt rfunction (fromIntegral largs) pargs exceptions
743+ makeNewJSVal result
667744#else
668745objCallAsConstructor = undefined
669746#endif
670747
748+nullObject :: Object
749+#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
750+nullObject = Object nullRef
751+#else
752+nullObject = Object . unsafePerformIO $ newForeignPtr_ nullPtr
753+#endif
671754
672755
673756