@@ -1,8 +1,12 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
1+{-# LANGUAGE CPP #-}
22{-# LANGUAGE FlexibleInstances #-}
33{-# LANGUAGE TypeSynonymInstances #-}
44{-# LANGUAGE ScopedTypeVariables #-}
55{-# LANGUAGE Rank2Types #-}
6+{-# LANGUAGE ForeignFunctionInterface #-}
7+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
8+{-# LANGUAGE JavaScriptFFI #-}
9+#endif
610-----------------------------------------------------------------------------
711--
812-- Module : Language.Javascript.JSC.Object
@@ -63,7 +67,6 @@ module Language.Javascript.JSC.Object (
6367 , global
6468
6569 -- * Enumerating Properties
66− , copyPropertyNames
6770 , propertyNames
6871
6972 -- * Low level
@@ -72,10 +75,16 @@ module Language.Javascript.JSC.Object (
7275) where
7376
7477import Prelude hiding ((!!))
75−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
78+import Language.Javascript.JSC.Types
7679 (JSPropertyNameArrayRef, JSStringRef, JSObjectRef, JSValueRefRef,
77− JSValueRef, JSContextRef)
78−import Foreign.C (CSize(..), CUInt(..), CULong(..))
80+ JSValueRef, JSContextRef, Index)
81+import Foreign.C (CSize(..), CUInt(..))
82+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
83+import GHCJS.Types (nullRef, castRef, JSArray, JSFun)
84+import GHCJS.Foreign (newObj, toArray, fromArray, syncCallback2)
85+import Control.Monad (liftM)
86+import Control.Applicative ((<$>))
87+#else
7988import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
8089 (jsobjectmake, jspropertynamearraygetnameatindex,
8190 jspropertynamearraygetcount, jsobjectcopypropertynames,
@@ -84,6 +93,12 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
8493 jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,
8594 JSPropertyAttributes, JSObjectCallAsFunctionCallback,
8695 jsobjectmakefunctionwithcallback)
96+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
97+ (jsvaluemakeundefined)
98+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef
99+ (jscontextgetglobalobject)
100+import Foreign (peekArray, nullPtr, withArrayLen)
101+#endif
87102import Language.Javascript.JSC.Exception (rethrow)
88103import Language.Javascript.JSC.Value
89104 (JSUndefined, valMakeUndefined, valToObject)
@@ -95,15 +110,10 @@ import Language.Javascript.JSC.Monad
95110 (JSC)
96111import Control.Monad.Trans.Reader (runReaderT, ask)
97112import Control.Monad.IO.Class (MonadIO(..))
98−import Foreign (peekArray, nullPtr, withArrayLen)
99113import qualified Control.Exception as E (catch)
100114import Control.Exception (SomeException)
101115import qualified Data.Text as T (pack)
102116import Foreign.Storable (Storable(..))
103−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
104− (jsvaluemakeundefined)
105−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef
106− (jscontextgetglobalobject)
107117import Language.Javascript.JSC.Properties
108118import Control.Lens
109119 (IndexPreservingGetter, to, (^.))
@@ -144,7 +154,7 @@ this ! name = do
144154-- W
145155(!!) :: (MakeObjectRef this)
146156 => this -- ^ Object to look on
147− -> CUInt -- ^ Index of the property to lookup
157+ -> Index -- ^ Index of the property to lookup
148158 -> JSC JSPropRef -- ^ Property reference
149159this !! index = do
150160 rthis <- makeObjectRef this
@@ -282,15 +292,19 @@ call function this args = do
282292-- >>> testJSC $ do { a <- obj; a ^. js "x" <# "Hello"; a ^. js "x" }
283293-- Hello
284294obj :: JSC JSObjectRef
295+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
296+obj = liftIO $ newObj
297+#else
285298obj = do
286299 gctxt <- ask
287300 liftIO $ jsobjectmake gctxt nullPtr nullPtr
301+#endif
288302
289303type JSObjectCallAsFunctionCallback' =
290304 JSContextRef
291305 -> JSValueRef
292306 -> JSValueRef
293− -> CULong
307+ -> CUInt
294308 -> JSValueRefRef
295309 -> JSValueRefRef
296310 -> IO JSValueRef
@@ -315,8 +329,10 @@ type JSCallAsFunction = JSValueRef -- ^ Function object
315329fun :: JSCallAsFunction -> JSCallAsFunction
316330fun = id
317331
332+#if (!defined(__GHCJS__) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)
318333foreign import ccall "wrapper"
319334 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
335+#endif
320336
321337-- ^ Make a JavaScript function object that wraps a Haskell function.
322338function :: MakeStringRef name
@@ -324,6 +340,15 @@ function :: MakeStringRef name
324340 -> JSCallAsFunction -- ^ Haskell function to call
325341 -> JSC JSObjectRef -- ^ Returns a JavaScript function object that will
326342 -- call the Haskell one when it is called
343+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
344+function name f = liftIO $ do
345+ callback <- syncCallback2 False True $ \this args -> do
346+ rargs <- fromArray args
347+ runReaderT (f this this rargs) () -- TODO pass function object through
348+ makeFunctionWithCallback (makeStringRef name) callback
349+foreign import javascript unsafe "$r = function () { $2(this, arguments); }"
350+ makeFunctionWithCallback :: JSStringRef -> JSFun (JSValueRef -> JSValueRefRef -> IO ()) -> IO JSObjectRef
351+#elif defined(USE_WEBKIT)
327352function name f = do
328353 gctxt <- ask
329354 callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap
@@ -337,24 +362,39 @@ function name f = do
337362 str <- runReaderT (makeValueRef . T.pack $ show e) ctx
338363 poke exception str
339364 jsvaluemakeundefined ctx
365+#else
366+function = undefined
367+#endif
340368
341369-- | A callback to Haskell can be used as a JavaScript value. This will create
342370-- an anonymous JavaScript function object. Use 'function' to create one with
343371-- a name.
344372instance MakeValueRef JSCallAsFunction where
373+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
374+ makeValueRef = function (nullRef::JSStringRef)
375+#else
345376 makeValueRef = function (nullPtr::JSStringRef)
377+#endif
346378
347379instance MakeArgRefs JSCallAsFunction where
348380 makeArgRefs f = do
381+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
382+ rarg <- function (nullRef::JSStringRef) f
383+#else
349384 rarg <- function (nullPtr::JSStringRef) f
385+#endif
350386 return [rarg]
351387
352388makeArray :: MakeArgRefs args => args -> JSValueRefRef -> JSC JSObjectRef
389+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
390+makeArray args exceptions = makeArgRefs args >>= liftM castRef . liftIO . toArray
391+#else
353392makeArray args exceptions = do
354393 gctxt <- ask
355394 rargs <- makeArgRefs args
356395 liftIO $ withArrayLen rargs $ \ len ptr ->
357396 jsobjectmakearray gctxt (fromIntegral len) ptr exceptions
397+#endif
358398
359399-- | Make an JavaScript array from a list of values
360400--
@@ -369,9 +409,18 @@ array = rethrow . makeArray
369409
370410-- | JavaScript's global object
371411global :: JSC JSObjectRef
412+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
413+global = liftIO js_window
414+foreign import javascript unsafe "$r = window"
415+ js_window :: IO JSObjectRef
416+#elif defined(USE_WEBKIT)
372417global = ask >>= (liftIO . jscontextgetglobalobject)
418+#else
419+global = undefined
420+#endif
373421
374422-- | Get an array containing the property names present on a given object
423+#if (!defined(__GHCJS__) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)
375424copyPropertyNames :: MakeObjectRef this => this -> JSC JSPropertyNameArrayRef
376425copyPropertyNames this = do
377426 gctxt <- ask
@@ -391,10 +440,19 @@ propertyNamesList :: MonadIO m => JSPropertyNameArrayRef -> m [JSStringRef]
391440propertyNamesList names = do
392441 count <- propertyNamesCount names
393442 mapM (propertyNamesAt names) $ enumFromTo 0 (count - 1)
443+#endif
394444
395445-- | Get a list containing the property names present on a given object
396446propertyNames :: MakeObjectRef this => this -> JSC [JSStringRef]
447+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
448+propertyNames this = makeObjectRef this >>= liftIO . js_propertyNames >>= liftIO . fromArray
449+foreign import javascript unsafe "$r = []; h$forIn($1, function(n){$r.push(n);})"
450+ js_propertyNames :: JSObjectRef -> IO (JSArray a)
451+#elif defined(USE_WEBKIT)
397452propertyNames this = copyPropertyNames this >>= propertyNamesList
453+#else
454+propertyNames = undefined
455+#endif
398456
399457-- | Get a list containing references to all the properties present on a given object
400458properties :: MakeObjectRef this => this -> JSC [JSPropRef]
@@ -407,11 +465,21 @@ objCallAsFunction :: MakeArgRefs args
407465 -> args
408466 -> JSValueRefRef
409467 -> JSC JSValueRef
468+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
469+objCallAsFunction function this args exceptions = do
470+ rargs <- makeArgRefs args >>= liftIO . toArray
471+ liftIO $ js_apply function this rargs exceptions
472+foreign import javascript unsafe "try { $r = $1.apply($2, $3) } catch(e) { $4[0] = e }"
473+ js_apply :: JSObjectRef -> JSObjectRef -> JSValueRefRef -> JSValueRefRef -> IO JSValueRef
474+#elif defined(USE_WEBKIT)
410475objCallAsFunction function this args exceptions = do
411476 gctxt <- ask
412477 rargs <- makeArgRefs args
413478 liftIO $ withArrayLen rargs $ \ largs pargs ->
414479 jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions
480+#else
481+objCallAsFunction = undefined
482+#endif
415483
416484-- | Call a JavaScript object as a constructor. Consider using 'new'.
417485objCallAsConstructor :: MakeArgRefs args
@@ -419,11 +487,44 @@ objCallAsConstructor :: MakeArgRefs args
419487 -> args
420488 -> JSValueRefRef
421489 -> JSC JSValueRef
490+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
491+objCallAsConstructor function args exceptions = do
492+ rargs <- makeArgRefs args >>= liftIO . toArray
493+ liftIO $ js_new function rargs exceptions
494+foreign import javascript unsafe "\
495+ try {\
496+ switch($2.length) {\
497+ case 0 : $r = new $1();\
498+ case 1 : $r = new $1($2[0]);\
499+ case 2 : $r = new $1($2[0],$2[1]);\
500+ case 3 : $r = new $1($2[0],$2[1],$2[2]);\
501+ case 4 : $r = new $1($2[0],$2[1],$2[2],$2[3]);\
502+ case 5 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4]);\
503+ case 6 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5]);\
504+ case 6 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5],$2[6]);\
505+ default:\
506+ var ret;\
507+ var temp = function() {\
508+ ret = $1.apply(this, $2);\
509+ };\
510+ temp.prototype = f.prototype;\
511+ var i = new temp();\
512+ $r = ret instanceof Object ? ret : i;\
513+ }\
514+ }\
515+ catch(e) {\
516+ $3[0] = e;\
517+ }"
518+ js_new :: JSObjectRef -> JSValueRefRef -> JSValueRefRef -> IO JSValueRef
519+#elif defined(USE_WEBKIT)
422520objCallAsConstructor function args exceptions = do
423521 gctxt <- ask
424522 rargs <- makeArgRefs args
425523 liftIO $ withArrayLen rargs $ \ largs pargs ->
426524 jsobjectcallasconstructor gctxt function (fromIntegral largs) pargs exceptions
525+#else
526+objCallAsConstructor = undefined
527+#endif
427528
428529
429530