git.iko.soy/jsaddle
on master help sign in
Add support for using JavaScriptFFI. Make JMacro support optional. Use new Gtk3 packages when building with webkit support.
3538e29Hamish Mackenzie
jsc.cabal+56−14
compare with master
unifiedsplit
@@ -15,20 +15,46 @@ flag gtk3
15 Description: Use GTK3 rather than GTK2
15 Description: Use GTK3 rather than GTK2
16 Default: True
16 Default: True
17
17
18+flag jsffi
19+ description: Use JavaScriptFFI extension for GHCJS JavaScript output
20+ default: True
21+
22+flag webkit
23+ description: Use WebKitGtk and JavaScriptCore for GHCJS output
24+ default: False
25+
26+flag jmacro
27+ description: Include some JMacro support
28+ default: False
29+
18library
30library
31+ if impl(ghcjs) && flag(jsffi)
32+ cpp-options: -DUSE_JAVASCRIPTFFI
33+ build-depends: ghcjs-base
34+
35+ if !impl(ghcjs) || flag(webkit)
36+ cpp-options: -DUSE_WEBKIT
19− if flag(gtk3)
37+ if flag(gtk3)
38+ build-depends: webkit3 >=0.12.5 && <0.13,
20− build-depends: webkit3-javascriptcore >=0.0.0.999 && <0.1, webkit3 -any
39+ webkit3-javascriptcore >=0.0.0.999 && <0.1
21− else
40+ else
41+ build-depends: webkit >=0.12.5 && <0.13,
22− build-depends: webkit-javascriptcore >=0.0.0.999 && <0.1, webkit -any
42+ webkit-javascriptcore >=0.0.0.999 && <0.1
43+
44+ if flag(jmacro)
45+ exposed-modules: Language.Javascript.JSC.JMacro
46+ build-depends: jmacro >=0.6.3 && <0.7
47+
23 build-depends: template-haskell -any, base -any, lens >=3.8.5 && <3.11,
48 build-depends: template-haskell -any, base -any, lens >=3.8.5 && <3.11,
24− text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4,
49+ text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4
25− jmacro >=0.6.3 && <0.7
50+
26 exposed-modules: Language.Javascript.JSC
51 exposed-modules: Language.Javascript.JSC
27 Language.Javascript.JSC.Arguments Language.Javascript.JSC.Classes
52 Language.Javascript.JSC.Arguments Language.Javascript.JSC.Classes
28 Language.Javascript.JSC.Evaluate Language.Javascript.JSC.Exception
53 Language.Javascript.JSC.Evaluate Language.Javascript.JSC.Exception
29− Language.Javascript.JSC.JMacro Language.Javascript.JSC.Monad
54+ Language.Javascript.JSC.Monad
30 Language.Javascript.JSC.Object Language.Javascript.JSC.Properties
55 Language.Javascript.JSC.Object Language.Javascript.JSC.Properties
31 Language.Javascript.JSC.String Language.Javascript.JSC.Value
56 Language.Javascript.JSC.String Language.Javascript.JSC.Value
57+ Language.Javascript.JSC.Types
32 exposed: True
58 exposed: True
33 buildable: True
59 buildable: True
34 default-language: Haskell2010
60 default-language: Haskell2010
@@ -36,16 +62,32 @@ library
36 other-modules: Language.Javascript.JSC.PropRef
62 other-modules: Language.Javascript.JSC.PropRef
37
63
38test-suite test-tool
64test-suite test-tool
39− if flag(gtk3)
65+ if flag(jsffi)
66+ buildable: False
67+
68+ if impl(ghcjs) && flag(jsffi)
69+ cpp-options: -DUSE_JAVASCRIPTFFI
70+ build-depends: ghcjs-base
71+
72+ if !impl(ghcjs) || flag(webkit)
73+ cpp-options: -DUSE_WEBKIT
74+ build-depends: glib >=0.12.3.1 && <0.13
75+ if flag(gtk3)
76+ build-depends: gtk3 >= 0.12.4.1 && <0.13,
77+ webkit3 >=0.12.5 && <0.13,
40− build-depends: webkit3-javascriptcore >=0.0.0.999 && <0.1, webkit3 -any
78+ webkit3-javascriptcore >=0.0.0.999 && <0.1
41− else
79+ else
80+ build-depends: gtk >= 0.12.4.1 && <0.13,
81+ webkit >=0.12.5 && <0.13,
42− build-depends: webkit-javascriptcore >=0.0.0.999 && <0.1, webkit -any
82+ webkit-javascriptcore >=0.0.0.999 && <0.1
83+
84+ if flag(jmacro)
85+ build-depends: jmacro >=0.6.3 && <0.7
86+
43 build-depends: template-haskell -any, base -any, lens >=3.8.5 && <3.11,
87 build-depends: template-haskell -any, base -any, lens >=3.8.5 && <3.11,
44 text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4,
88 text >=0.11.2.3 && <0.12, transformers >=0.3.0.0 && <0.4,
45− jmacro >=0.6.3 && <0.7,
46− hslogger -any, glib -any, gtk -any, jsc ==0.1.1.0
89+ hslogger -any, jsc ==0.1.1.0
47 type: exitcode-stdio-1.0
90 type: exitcode-stdio-1.0
48 main-is: TestJSC.hs
91 main-is: TestJSC.hs
49− buildable: True
50 default-language: Haskell2010
92 default-language: Haskell2010
51 hs-source-dirs: tests
93 hs-source-dirs: tests
src/Language/Javascript/JSC.hs+5
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1-----------------------------------------------------------------------------
2-----------------------------------------------------------------------------
2--
3--
3-- Module : Language.Javascript.JSC
4-- Module : Language.Javascript.JSC
@@ -61,7 +62,9 @@ module Language.Javascript.JSC (
61 , module Language.Javascript.JSC.Properties
62 , module Language.Javascript.JSC.Properties
62 , module Language.Javascript.JSC.Object
63 , module Language.Javascript.JSC.Object
63 , module Language.Javascript.JSC.Evaluate
64 , module Language.Javascript.JSC.Evaluate
65+#ifdef MIN_VERSION_jmacro
64 , module Language.Javascript.JSC.JMacro
66 , module Language.Javascript.JSC.JMacro
67+#endif
65 , module Language.Javascript.JSC.String
68 , module Language.Javascript.JSC.String
66) where
69) where
67
70
@@ -72,5 +75,7 @@ import Language.Javascript.JSC.Arguments
72import Language.Javascript.JSC.Properties
75import Language.Javascript.JSC.Properties
73import Language.Javascript.JSC.Object
76import Language.Javascript.JSC.Object
74import Language.Javascript.JSC.Evaluate
77import Language.Javascript.JSC.Evaluate
78+#ifdef MIN_VERSION_jmacro
75import Language.Javascript.JSC.JMacro
79import Language.Javascript.JSC.JMacro
80+#endif
76import Language.Javascript.JSC.String
81import Language.Javascript.JSC.String
src/Language/Javascript/JSC/Classes.hs+1−1
@@ -22,7 +22,7 @@ module Language.Javascript.JSC.Classes (
22) where
22) where
23
23
24import Control.Monad.IO.Class (MonadIO)
24import Control.Monad.IO.Class (MonadIO)
25−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
25+import Language.Javascript.JSC.Types
26 (JSObjectRef, JSStringRef, JSValueRef)
26 (JSObjectRef, JSStringRef, JSValueRef)
27import Language.Javascript.JSC.Monad (JSC)
27import Language.Javascript.JSC.Monad (JSC)
28import Language.Javascript.JSC.PropRef (JSPropRef)
28import Language.Javascript.JSC.PropRef (JSPropRef)
src/Language/Javascript/JSC/Evaluate.hs+25−4
@@ -1,3 +1,7 @@
1+{-# LANGUAGE CPP #-}
2+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
3+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}
4+#endif
1-----------------------------------------------------------------------------
5-----------------------------------------------------------------------------
2--
6--
3-- Module : Language.Javascript.JSC.Evaluate
7-- Module : Language.Javascript.JSC.Evaluate
@@ -18,10 +22,16 @@ module Language.Javascript.JSC.Evaluate (
18
22
19import Control.Monad.Trans.Reader (ask)
23import Control.Monad.Trans.Reader (ask)
20import Control.Monad.IO.Class (MonadIO(..))
24import Control.Monad.IO.Class (MonadIO(..))
21−import Foreign (nullPtr)
25+import Language.Javascript.JSC.Types
22−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
23− (JSStringRef, JSValueRef, JSObjectRef, jsevaluatescript,
26+ (JSStringRef, JSValueRef, JSObjectRef,
24 JSValueRefRef)
27 JSValueRefRef)
28+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
29+import GHCJS.Types (nullRef)
30+#else
31+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
32+ (jsevaluatescript)
33+import Foreign (nullPtr)
34+#endif
25import Language.Javascript.JSC.Exception (rethrow)
35import Language.Javascript.JSC.Exception (rethrow)
26import Language.Javascript.JSC.Value ()
36import Language.Javascript.JSC.Value ()
27import Language.Javascript.JSC.Object ()
37import Language.Javascript.JSC.Object ()
@@ -41,10 +51,18 @@ evaluateScript :: (MakeStringRef script, MakeObjectRef this, MakeStringRef url)
41 -> url
51 -> url
42 -> Int -- ^ The Line number of the first line of the script
52 -> Int -- ^ The Line number of the first line of the script
43 -> JSC JSValueRef
53 -> JSC JSValueRef
54+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
55+evaluateScript script this url line = liftIO $ js_eval (makeStringRef script)
56+foreign import javascript unsafe "$r = eval(s);"
57+ js_eval :: JSStringRef -> IO JSValueRef
58+#elif defined(USE_WEBKIT)
44evaluateScript script this url line = do
59evaluateScript script this url line = do
45 gctxt <- ask
60 gctxt <- ask
46 thisr <- makeObjectRef this
61 thisr <- makeObjectRef this
47 rethrow $ liftIO . jsevaluatescript gctxt (makeStringRef script) thisr (makeStringRef url) line
62 rethrow $ liftIO . jsevaluatescript gctxt (makeStringRef script) thisr (makeStringRef url) line
63+#else
64+evaluateScript = undefined
65+#endif
48
66
49-- | Evaluates a script (like eval in java script)
67-- | Evaluates a script (like eval in java script)
50--
68--
@@ -53,6 +71,9 @@ evaluateScript script this url line = do
53eval :: MakeStringRef script
71eval :: MakeStringRef script
54 => script -- ^ JavaScript to evaluate
72 => script -- ^ JavaScript to evaluate
55 -> JSC JSValueRef
73 -> JSC JSValueRef
74+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
75+eval script = evaluateScript script (nullRef::JSObjectRef) (nullRef::JSStringRef) 1
76+#else
56eval script = evaluateScript script (nullPtr::JSObjectRef) (nullPtr::JSStringRef) 1
77eval script = evaluateScript script (nullPtr::JSObjectRef) (nullPtr::JSStringRef) 1
57−
78+#endif
58
79
src/Language/Javascript/JSC/Exception.hs+1−1
@@ -17,7 +17,7 @@ module Language.Javascript.JSC.Exception (
17) where
17) where
18
18
19import qualified Control.Exception as E (throwIO, Exception)
19import qualified Control.Exception as E (throwIO, Exception)
20−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
20+import Language.Javascript.JSC.Types
21 (JSValueRefRef, JSValueRef)
21 (JSValueRefRef, JSValueRef)
22import Data.Typeable (Typeable)
22import Data.Typeable (Typeable)
23import Language.Javascript.JSC.Monad (catchval, JSC)
23import Language.Javascript.JSC.Monad (catchval, JSC)
src/Language/Javascript/JSC/Monad.hs+39−7
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1-----------------------------------------------------------------------------
2-----------------------------------------------------------------------------
2--
3--
3-- Module : Language.Javascript.JSC.Monad
4-- Module : Language.Javascript.JSC.Monad
@@ -15,6 +16,9 @@ module Language.Javascript.JSC.Monad (
15 JSC(..)
16 JSC(..)
16 , JSContextRef
17 , JSContextRef
17
18
19+ -- * Running JSC given a DOM Window
20+ , runJSC
21+
18 -- * Exception Handling
22 -- * Exception Handling
19 , catchval
23 , catchval
20 , catch
24 , catch
@@ -22,11 +26,22 @@ module Language.Javascript.JSC.Monad (
22
26
23import Prelude hiding (catch)
27import Prelude hiding (catch)
24import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))
28import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))
25−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
29+import Language.Javascript.JSC.Types
26 (JSValueRefRef, JSValueRef, JSContextRef)
30 (JSValueRefRef, JSValueRef, JSContextRef)
27import Control.Monad.IO.Class (MonadIO(..))
31import Control.Monad.IO.Class (MonadIO(..))
32+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
33+import GHCJS.Types (isUndefined, isNull)
34+import GHCJS.Foreign (newArray, indexArray)
35+#else
28import Foreign (nullPtr, alloca)
36import Foreign (nullPtr, alloca)
29import Foreign.Storable (Storable(..))
37import Foreign.Storable (Storable(..))
38+import Graphics.UI.Gtk.WebKit.Types
39+ (WebView(..))
40+import Graphics.UI.Gtk.WebKit.WebView
41+ (webViewGetMainFrame)
42+import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame
43+ (webFrameGetGlobalContext)
44+#endif
30import qualified Control.Exception as E (Exception, catch)
45import qualified Control.Exception as E (Exception, catch)
31
46
32-- | The @JSC@ monad keeps track of the JavaScript context.
47-- | The @JSC@ monad keeps track of the JavaScript context.
@@ -53,13 +68,30 @@ t `catch` c = do
53-- to throw exceptions.
68-- to throw exceptions.
54catchval :: (JSValueRefRef -> JSC a) -> (JSValueRef -> JSC a) -> JSC a
69catchval :: (JSValueRefRef -> JSC a) -> (JSValueRef -> JSC a) -> JSC a
55catchval f catcher = do
70catchval f catcher = do
56− gctxt <- ask
71+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
57− liftIO . alloca $ \pexc -> flip runReaderT gctxt $ do
72+ pexc <- liftIO $ newArray
58− liftIO $ poke pexc nullPtr
59 result <- f pexc
73 result <- f pexc
60− exc <- liftIO $ peek pexc
74+ exc <- liftIO $ indexArray 0 pexc
61− if exc == nullPtr
75+ if isUndefined exc || isNull exc
62 then return result
76 then return result
63 else catcher exc
77 else catcher exc
78+#else
79+ gctxt <- ask
80+ liftIO . alloca $ \pexc -> flip runReaderT gctxt $ do
81+ liftIO $ poke pexc nullPtr
82+ result <- f pexc
83+ exc <- liftIO $ peek pexc
84+ if exc == nullPtr
85+ then return result
86+ else catcher exc
87+#endif
64
88
65−
89+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
90+runJSC :: w -> JSC a -> IO a
91+runJSC _ f = runReaderT f ()
92+#else
93+runJSC :: WebView -> JSC a -> IO a
94+runJSC webView f = do
95+ gctxt <- webViewGetMainFrame webView >>= webFrameGetGlobalContext
96+ runReaderT f gctxt
97+#endif
src/Language/Javascript/JSC/Object.hs+113−12
@@ -1,8 +1,12 @@
1−{-# LANGUAGE ForeignFunctionInterface #-}
1+{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE TypeSynonymInstances #-}
4{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE Rank2Types #-}
5{-# LANGUAGE Rank2Types #-}
6+{-# LANGUAGE ForeignFunctionInterface #-}
7+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
8+{-# LANGUAGE JavaScriptFFI #-}
9+#endif
6-----------------------------------------------------------------------------
10-----------------------------------------------------------------------------
7--
11--
8-- Module : Language.Javascript.JSC.Object
12-- Module : Language.Javascript.JSC.Object
@@ -63,7 +67,6 @@ module Language.Javascript.JSC.Object (
63 , global
67 , global
64
68
65 -- * Enumerating Properties
69 -- * Enumerating Properties
66− , copyPropertyNames
67 , propertyNames
70 , propertyNames
68
71
69 -- * Low level
72 -- * Low level
@@ -72,10 +75,16 @@ module Language.Javascript.JSC.Object (
72) where
75) where
73
76
74import Prelude hiding ((!!))
77import Prelude hiding ((!!))
75−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
78+import Language.Javascript.JSC.Types
76 (JSPropertyNameArrayRef, JSStringRef, JSObjectRef, JSValueRefRef,
79 (JSPropertyNameArrayRef, JSStringRef, JSObjectRef, JSValueRefRef,
77− JSValueRef, JSContextRef)
80+ JSValueRef, JSContextRef, Index)
78−import Foreign.C (CSize(..), CUInt(..), CULong(..))
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
79import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
88import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
80 (jsobjectmake, jspropertynamearraygetnameatindex,
89 (jsobjectmake, jspropertynamearraygetnameatindex,
81 jspropertynamearraygetcount, jsobjectcopypropertynames,
90 jspropertynamearraygetcount, jsobjectcopypropertynames,
@@ -84,6 +93,12 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
84 jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,
93 jsobjectcallasfunction, jsobjectgetproperty, jsobjectsetproperty,
85 JSPropertyAttributes, JSObjectCallAsFunctionCallback,
94 JSPropertyAttributes, JSObjectCallAsFunctionCallback,
86 jsobjectmakefunctionwithcallback)
95 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
87import Language.Javascript.JSC.Exception (rethrow)
102import Language.Javascript.JSC.Exception (rethrow)
88import Language.Javascript.JSC.Value
103import Language.Javascript.JSC.Value
89 (JSUndefined, valMakeUndefined, valToObject)
104 (JSUndefined, valMakeUndefined, valToObject)
@@ -95,15 +110,10 @@ import Language.Javascript.JSC.Monad
95 (JSC)
110 (JSC)
96import Control.Monad.Trans.Reader (runReaderT, ask)
111import Control.Monad.Trans.Reader (runReaderT, ask)
97import Control.Monad.IO.Class (MonadIO(..))
112import Control.Monad.IO.Class (MonadIO(..))
98−import Foreign (peekArray, nullPtr, withArrayLen)
99import qualified Control.Exception as E (catch)
113import qualified Control.Exception as E (catch)
100import Control.Exception (SomeException)
114import Control.Exception (SomeException)
101import qualified Data.Text as T (pack)
115import qualified Data.Text as T (pack)
102import Foreign.Storable (Storable(..))
116import Foreign.Storable (Storable(..))
103−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
104− (jsvaluemakeundefined)
105−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef
106− (jscontextgetglobalobject)
107import Language.Javascript.JSC.Properties
117import Language.Javascript.JSC.Properties
108import Control.Lens
118import Control.Lens
109 (IndexPreservingGetter, to, (^.))
119 (IndexPreservingGetter, to, (^.))
@@ -144,7 +154,7 @@ this ! name = do
144-- W
154-- W
145(!!) :: (MakeObjectRef this)
155(!!) :: (MakeObjectRef this)
146 => this -- ^ Object to look on
156 => this -- ^ Object to look on
147− -> CUInt -- ^ Index of the property to lookup
157+ -> Index -- ^ Index of the property to lookup
148 -> JSC JSPropRef -- ^ Property reference
158 -> JSC JSPropRef -- ^ Property reference
149this !! index = do
159this !! index = do
150 rthis <- makeObjectRef this
160 rthis <- makeObjectRef this
@@ -282,15 +292,19 @@ call function this args = do
282-- >>> testJSC $ do { a <- obj; a ^. js "x" <# "Hello"; a ^. js "x" }
292-- >>> testJSC $ do { a <- obj; a ^. js "x" <# "Hello"; a ^. js "x" }
283-- Hello
293-- Hello
284obj :: JSC JSObjectRef
294obj :: JSC JSObjectRef
295+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
296+obj = liftIO $ newObj
297+#else
285obj = do
298obj = do
286 gctxt <- ask
299 gctxt <- ask
287 liftIO $ jsobjectmake gctxt nullPtr nullPtr
300 liftIO $ jsobjectmake gctxt nullPtr nullPtr
301+#endif
288
302
289type JSObjectCallAsFunctionCallback' =
303type JSObjectCallAsFunctionCallback' =
290 JSContextRef
304 JSContextRef
291 -> JSValueRef
305 -> JSValueRef
292 -> JSValueRef
306 -> JSValueRef
293− -> CULong
307+ -> CUInt
294 -> JSValueRefRef
308 -> JSValueRefRef
295 -> JSValueRefRef
309 -> JSValueRefRef
296 -> IO JSValueRef
310 -> IO JSValueRef
@@ -315,8 +329,10 @@ type JSCallAsFunction = JSValueRef -- ^ Function object
315fun :: JSCallAsFunction -> JSCallAsFunction
329fun :: JSCallAsFunction -> JSCallAsFunction
316fun = id
330fun = id
317
331
332+#if (!defined(__GHCJS__) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)
318foreign import ccall "wrapper"
333foreign import ccall "wrapper"
319 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
334 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback
335+#endif
320
336
321-- ^ Make a JavaScript function object that wraps a Haskell function.
337-- ^ Make a JavaScript function object that wraps a Haskell function.
322function :: MakeStringRef name
338function :: MakeStringRef name
@@ -324,6 +340,15 @@ function :: MakeStringRef name
324 -> JSCallAsFunction -- ^ Haskell function to call
340 -> JSCallAsFunction -- ^ Haskell function to call
325 -> JSC JSObjectRef -- ^ Returns a JavaScript function object that will
341 -> JSC JSObjectRef -- ^ Returns a JavaScript function object that will
326 -- call the Haskell one when it is called
342 -- 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)
327function name f = do
352function name f = do
328 gctxt <- ask
353 gctxt <- ask
329 callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap
354 callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap
@@ -337,24 +362,39 @@ function name f = do
337 str <- runReaderT (makeValueRef . T.pack $ show e) ctx
362 str <- runReaderT (makeValueRef . T.pack $ show e) ctx
338 poke exception str
363 poke exception str
339 jsvaluemakeundefined ctx
364 jsvaluemakeundefined ctx
365+#else
366+function = undefined
367+#endif
340
368
341-- | A callback to Haskell can be used as a JavaScript value. This will create
369-- | A callback to Haskell can be used as a JavaScript value. This will create
342-- an anonymous JavaScript function object. Use 'function' to create one with
370-- an anonymous JavaScript function object. Use 'function' to create one with
343-- a name.
371-- a name.
344instance MakeValueRef JSCallAsFunction where
372instance MakeValueRef JSCallAsFunction where
373+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
374+ makeValueRef = function (nullRef::JSStringRef)
375+#else
345 makeValueRef = function (nullPtr::JSStringRef)
376 makeValueRef = function (nullPtr::JSStringRef)
377+#endif
346
378
347instance MakeArgRefs JSCallAsFunction where
379instance MakeArgRefs JSCallAsFunction where
348 makeArgRefs f = do
380 makeArgRefs f = do
381+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
382+ rarg <- function (nullRef::JSStringRef) f
383+#else
349 rarg <- function (nullPtr::JSStringRef) f
384 rarg <- function (nullPtr::JSStringRef) f
385+#endif
350 return [rarg]
386 return [rarg]
351
387
352makeArray :: MakeArgRefs args => args -> JSValueRefRef -> JSC JSObjectRef
388makeArray :: 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
353makeArray args exceptions = do
392makeArray args exceptions = do
354 gctxt <- ask
393 gctxt <- ask
355 rargs <- makeArgRefs args
394 rargs <- makeArgRefs args
356 liftIO $ withArrayLen rargs $ \ len ptr ->
395 liftIO $ withArrayLen rargs $ \ len ptr ->
357 jsobjectmakearray gctxt (fromIntegral len) ptr exceptions
396 jsobjectmakearray gctxt (fromIntegral len) ptr exceptions
397+#endif
358
398
359-- | Make an JavaScript array from a list of values
399-- | Make an JavaScript array from a list of values
360--
400--
@@ -369,9 +409,18 @@ array = rethrow . makeArray
369
409
370-- | JavaScript's global object
410-- | JavaScript's global object
371global :: JSC JSObjectRef
411global :: 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)
372global = ask >>= (liftIO . jscontextgetglobalobject)
417global = ask >>= (liftIO . jscontextgetglobalobject)
418+#else
419+global = undefined
420+#endif
373
421
374-- | Get an array containing the property names present on a given object
422-- | Get an array containing the property names present on a given object
423+#if (!defined(__GHCJS__) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)
375copyPropertyNames :: MakeObjectRef this => this -> JSC JSPropertyNameArrayRef
424copyPropertyNames :: MakeObjectRef this => this -> JSC JSPropertyNameArrayRef
376copyPropertyNames this = do
425copyPropertyNames this = do
377 gctxt <- ask
426 gctxt <- ask
@@ -391,10 +440,19 @@ propertyNamesList :: MonadIO m => JSPropertyNameArrayRef -> m [JSStringRef]
391propertyNamesList names = do
440propertyNamesList names = do
392 count <- propertyNamesCount names
441 count <- propertyNamesCount names
393 mapM (propertyNamesAt names) $ enumFromTo 0 (count - 1)
442 mapM (propertyNamesAt names) $ enumFromTo 0 (count - 1)
443+#endif
394
444
395-- | Get a list containing the property names present on a given object
445-- | Get a list containing the property names present on a given object
396propertyNames :: MakeObjectRef this => this -> JSC [JSStringRef]
446propertyNames :: 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)
397propertyNames this = copyPropertyNames this >>= propertyNamesList
452propertyNames this = copyPropertyNames this >>= propertyNamesList
453+#else
454+propertyNames = undefined
455+#endif
398
456
399-- | Get a list containing references to all the properties present on a given object
457-- | Get a list containing references to all the properties present on a given object
400properties :: MakeObjectRef this => this -> JSC [JSPropRef]
458properties :: MakeObjectRef this => this -> JSC [JSPropRef]
@@ -407,11 +465,21 @@ objCallAsFunction :: MakeArgRefs args
407 -> args
465 -> args
408 -> JSValueRefRef
466 -> JSValueRefRef
409 -> JSC JSValueRef
467 -> 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)
410objCallAsFunction function this args exceptions = do
475objCallAsFunction function this args exceptions = do
411 gctxt <- ask
476 gctxt <- ask
412 rargs <- makeArgRefs args
477 rargs <- makeArgRefs args
413 liftIO $ withArrayLen rargs $ \ largs pargs ->
478 liftIO $ withArrayLen rargs $ \ largs pargs ->
414 jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions
479 jsobjectcallasfunction gctxt function this (fromIntegral largs) pargs exceptions
480+#else
481+objCallAsFunction = undefined
482+#endif
415
483
416-- | Call a JavaScript object as a constructor. Consider using 'new'.
484-- | Call a JavaScript object as a constructor. Consider using 'new'.
417objCallAsConstructor :: MakeArgRefs args
485objCallAsConstructor :: MakeArgRefs args
@@ -419,11 +487,44 @@ objCallAsConstructor :: MakeArgRefs args
419 -> args
487 -> args
420 -> JSValueRefRef
488 -> JSValueRefRef
421 -> JSC JSValueRef
489 -> 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)
422objCallAsConstructor function args exceptions = do
520objCallAsConstructor function args exceptions = do
423 gctxt <- ask
521 gctxt <- ask
424 rargs <- makeArgRefs args
522 rargs <- makeArgRefs args
425 liftIO $ withArrayLen rargs $ \ largs pargs ->
523 liftIO $ withArrayLen rargs $ \ largs pargs ->
426 jsobjectcallasconstructor gctxt function (fromIntegral largs) pargs exceptions
524 jsobjectcallasconstructor gctxt function (fromIntegral largs) pargs exceptions
525+#else
526+objCallAsConstructor = undefined
527+#endif
427
528
428
529
429
530
src/Language/Javascript/JSC/PropRef.hs+4−4
@@ -13,13 +13,13 @@
13module Language.Javascript.JSC.PropRef (
13module Language.Javascript.JSC.PropRef (
14 JSPropRef(..)
14 JSPropRef(..)
15) where
15) where
16−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
16+
17+import Language.Javascript.JSC.Types
17− (JSStringRef, JSObjectRef)
18+ (JSStringRef, JSObjectRef, Index)
18−import Foreign.C (CUInt)
19
19
20-- | A reference to a property.
20-- | A reference to a property.
21-- Implemented as a reference to an object and something to find the property.
21-- Implemented as a reference to an object and something to find the property.
22data JSPropRef = JSPropRef JSObjectRef JSStringRef -- ^ Object and property name.
22data JSPropRef = JSPropRef JSObjectRef JSStringRef -- ^ Object and property name.
23− | JSPropIndexRef JSObjectRef CUInt -- ^ Object and property index.
23+ | JSPropIndexRef JSObjectRef Index -- ^ Object and property index.
24
24
25
25
src/Language/Javascript/JSC/Properties.hs+49−5
@@ -1,5 +1,9 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE TypeSynonymInstances #-}
4+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
5+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}
6+#endif
3-----------------------------------------------------------------------------
7-----------------------------------------------------------------------------
4--
8--
5-- Module : Language.Javascript.JSC.Properties
9-- Module : Language.Javascript.JSC.Properties
@@ -32,20 +36,24 @@ module Language.Javascript.JSC.Properties (
32 , objSetProperty
36 , objSetProperty
33) where
37) where
34
38
39+import Control.Applicative ((<$>))
35import Language.Javascript.JSC.PropRef (JSPropRef(..))
40import Language.Javascript.JSC.PropRef (JSPropRef(..))
36import Language.Javascript.JSC.Classes
41import Language.Javascript.JSC.Classes
37 (MakePropRef(..), MakeObjectRef(..), MakeValueRef(..),
42 (MakePropRef(..), MakeObjectRef(..), MakeValueRef(..),
38 MakeArgRefs(..), MakeStringRef(..))
43 MakeArgRefs(..), MakeStringRef(..))
39import Language.Javascript.JSC.Monad (JSC)
44import Language.Javascript.JSC.Monad (JSC)
40−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
45+import Language.Javascript.JSC.Types
41− (JSValueRefRef, JSObjectRef)
46+ (JSValueRefRef, JSObjectRef, JSPropertyAttributes,
47+ Index(..), JSStringRef)
48+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
49+#else
42import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
50import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
43 (jsobjectgetpropertyatindex, jsobjectgetproperty,
51 (jsobjectgetpropertyatindex, jsobjectgetproperty,
44 jsobjectsetpropertyatindex, jsobjectsetproperty,
52 jsobjectsetpropertyatindex, jsobjectsetproperty,
45 JSPropertyAttributes)
53 JSPropertyAttributes)
54+#endif
46import Control.Monad.Trans.Reader (ask)
55import Control.Monad.Trans.Reader (ask)
47import Control.Monad.IO.Class (MonadIO(..))
56import Control.Monad.IO.Class (MonadIO(..))
48−import Foreign.C (CUInt)
49import Language.Javascript.JSC.Exception (rethrow)
57import Language.Javascript.JSC.Exception (rethrow)
50import Language.Javascript.JSC.Value (JSValueRef)
58import Language.Javascript.JSC.Value (JSValueRef)
51import Language.Javascript.JSC.Arguments ()
59import Language.Javascript.JSC.Arguments ()
@@ -80,18 +88,34 @@ objGetPropertyByName :: MakeStringRef name
80 -> name -- ^ name of the property.
88 -> name -- ^ name of the property.
81 -> JSValueRefRef -- ^ exception if one is raised.
89 -> JSValueRefRef -- ^ exception if one is raised.
82 -> JSC JSValueRef -- ^ returns the property value.
90 -> JSC JSValueRef -- ^ returns the property value.
91+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
92+objGetPropertyByName this name = liftIO . js_tryGetProp (makeStringRef name) this
93+foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"
94+ js_tryGetProp :: JSStringRef -> JSObjectRef -> JSValueRefRef -> IO JSValueRef
95+#elif defined(USE_WEBKIT)
83objGetPropertyByName this name exceptions = do
96objGetPropertyByName this name exceptions = do
84 gctxt <- ask
97 gctxt <- ask
85 liftIO $ jsobjectgetproperty gctxt this (makeStringRef name) exceptions
98 liftIO $ jsobjectgetproperty gctxt this (makeStringRef name) exceptions
99+#else
100+objGetPropertyByName = undefined
101+#endif
86
102
87-- | Get a property value given the object and the index of the property.
103-- | Get a property value given the object and the index of the property.
88objGetPropertyAtIndex :: JSObjectRef -- ^ object to find the property on.
104objGetPropertyAtIndex :: JSObjectRef -- ^ object to find the property on.
89− -> CUInt -- ^ index of the property.
105+ -> Index -- ^ index of the property.
90 -> JSValueRefRef -- ^ exception if one is raised.
106 -> JSValueRefRef -- ^ exception if one is raised.
91 -> JSC JSValueRef -- ^ returns the property value.
107 -> JSC JSValueRef -- ^ returns the property value.
108+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
109+objGetPropertyAtIndex this index = liftIO . js_tryIndex index this
110+foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"
111+ js_tryIndex :: Index -> JSObjectRef -> JSValueRefRef -> IO JSValueRef
112+#elif defined(USE_WEBKIT)
92objGetPropertyAtIndex this index exceptions = do
113objGetPropertyAtIndex this index exceptions = do
93 gctxt <- ask
114 gctxt <- ask
94 liftIO $ jsobjectgetpropertyatindex gctxt this index exceptions
115 liftIO $ jsobjectgetpropertyatindex gctxt this index exceptions
116+#else
117+objGetPropertyAtIndex = undefined
118+#endif
95
119
96-- | Gets the value of a property given a 'JSPropRef'.
120-- | Gets the value of a property given a 'JSPropRef'.
97objGetProperty :: JSPropRef -- ^ property reference.
121objGetProperty :: JSPropRef -- ^ property reference.
@@ -121,22 +145,42 @@ objSetPropertyByName :: (MakeStringRef name, MakeValueRef val)
121 -> JSPropertyAttributes -- ^ property attributes to give the property.
145 -> JSPropertyAttributes -- ^ property attributes to give the property.
122 -> JSValueRefRef -- ^ exception if one is raised.
146 -> JSValueRefRef -- ^ exception if one is raised.
123 -> JSC ()
147 -> JSC ()
148+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
149+objSetPropertyByName this name val attributes exceptions = do
150+ vref <- makeValueRef val
151+ liftIO $ js_trySetProp (makeStringRef name) this vref exceptions
152+foreign import javascript unsafe "try { $2[$1]=$3 } catch(e) { $4[0] = e }"
153+ js_trySetProp :: JSStringRef -> JSObjectRef -> JSValueRef -> JSValueRefRef -> IO ()
154+#elif defined(USE_WEBKIT)
124objSetPropertyByName this name val attributes exceptions = do
155objSetPropertyByName this name val attributes exceptions = do
125 gctxt <- ask
156 gctxt <- ask
126 vref <- makeValueRef val
157 vref <- makeValueRef val
127 liftIO $ jsobjectsetproperty gctxt this (makeStringRef name) vref attributes exceptions
158 liftIO $ jsobjectsetproperty gctxt this (makeStringRef name) vref attributes exceptions
159+#else
160+objSetPropertyByName = undefined
161+#endif
128
162
129-- | Set a property value given the object and the index of the property.
163-- | Set a property value given the object and the index of the property.
130objSetPropertyAtIndex :: (MakeValueRef val)
164objSetPropertyAtIndex :: (MakeValueRef val)
131 => JSObjectRef -- ^ object to find property on.
165 => JSObjectRef -- ^ object to find property on.
132− -> CUInt -- ^ index of the property.
166+ -> Index -- ^ index of the property.
133 -> val -- ^ new value to set the property to.
167 -> val -- ^ new value to set the property to.
134 -> JSValueRefRef -- ^ exception if one is raised.
168 -> JSValueRefRef -- ^ exception if one is raised.
135 -> JSC ()
169 -> JSC ()
170+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
171+objSetPropertyAtIndex this index val exceptions = do
172+ vref <- makeValueRef val
173+ liftIO $ js_trySetAtIndex index this vref exceptions
174+foreign import javascript unsafe "try { $2[$1]=$3 } catch(e) { $4[0] = e }"
175+ js_trySetAtIndex :: Index -> JSObjectRef -> JSValueRef -> JSValueRefRef -> IO ()
176+#elif defined(USE_WEBKIT)
136objSetPropertyAtIndex this index val exceptions = do
177objSetPropertyAtIndex this index val exceptions = do
137 gctxt <- ask
178 gctxt <- ask
138 vref <- makeValueRef val
179 vref <- makeValueRef val
139 liftIO $ jsobjectsetpropertyatindex gctxt this index vref exceptions
180 liftIO $ jsobjectsetpropertyatindex gctxt this index vref exceptions
181+#else
182+objSetPropertyAtIndex = undefined
183+#endif
140
184
141-- | Sets the value of a property given a 'JSPropRef'.
185-- | Sets the value of a property given a 'JSPropRef'.
142objSetProperty :: (MakeValueRef val)
186objSetProperty :: (MakeValueRef val)
src/Language/Javascript/JSC/String.hs+16−3
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE TypeSynonymInstances #-}
3-----------------------------------------------------------------------------
4-----------------------------------------------------------------------------
@@ -24,13 +25,17 @@ module Language.Javascript.JSC.String (
24import Data.Text (Text)
25import Data.Text (Text)
25import qualified Data.Text as T (pack)
26import qualified Data.Text as T (pack)
26import Control.Monad.IO.Class (MonadIO(..))
27import Control.Monad.IO.Class (MonadIO(..))
28+import Language.Javascript.JSC.Types (JSStringRef)
29+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
30+import GHCJS.Foreign (fromJSString, toJSString)
31+#else
27import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
32import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
28 (jsstringcreatewithcharacters, jsstringgetcharactersptr,
33 (jsstringcreatewithcharacters, jsstringgetcharactersptr,
29 jsstringgetlength)
34 jsstringgetlength)
35+#endif
30import qualified Data.Text.Foreign as T (fromPtr)
36import qualified Data.Text.Foreign as T (fromPtr)
31import Foreign (castPtr)
37import Foreign (castPtr)
32import Data.Text.Foreign (useAsPtr)
38import Data.Text.Foreign (useAsPtr)
33−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase (JSStringRef)
34import Language.Javascript.JSC.Classes (MakeStringRef(..))
39import Language.Javascript.JSC.Classes (MakeStringRef(..))
35import System.IO.Unsafe (unsafePerformIO)
40import System.IO.Unsafe (unsafePerformIO)
36
41
@@ -46,16 +51,24 @@ instance MakeStringRef String where
46
51
47-- | Convert a JavaScript string to a Haskell 'Text'
52-- | Convert a JavaScript string to a Haskell 'Text'
48strToText :: MonadIO m => JSStringRef -> m Text
53strToText :: MonadIO m => JSStringRef -> m Text
54+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
55+strToText = return . fromJSString
56+#else
49strToText jsstring = liftIO $ do
57strToText jsstring = liftIO $ do
50 l <- jsstringgetlength jsstring
58 l <- jsstringgetlength jsstring
51 p <- jsstringgetcharactersptr jsstring
59 p <- jsstringgetcharactersptr jsstring
52 T.fromPtr (castPtr p) (fromIntegral l)
60 T.fromPtr (castPtr p) (fromIntegral l)
61+#endif
53
62
54-- | Convert a Haskell 'Text' to a JavaScript string
63-- | Convert a Haskell 'Text' to a JavaScript string
55textToStr :: Text -> JSStringRef
64textToStr :: Text -> JSStringRef
65+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
66+textToStr = toJSString
67+#else
56−textToStr text =
68+textToStr text = unsafePerformIO $
57− unsafePerformIO $ useAsPtr text $ \p l ->
69+ useAsPtr text $ \p l ->
58 jsstringcreatewithcharacters (castPtr p) (fromIntegral l)
70 jsstringcreatewithcharacters (castPtr p) (fromIntegral l)
71+#endif
59
72
60
73
61
74
src/Language/Javascript/JSC/Types.hsnew file+53
@@ -0,0 +1,53 @@
1+{-# LANGUAGE CPP, FlexibleInstances #-}
2+-----------------------------------------------------------------------------
3+--
4+-- Module : Language.Javascript.JSC.Properties
5+-- Copyright : (c) Hamish Mackenzie
6+-- License : MIT
7+--
8+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
9+--
10+-- |
11+--
12+-----------------------------------------------------------------------------
13+
14+module Language.Javascript.JSC.Types (
15+ JSValueRef(..)
16+ , JSValueRefRef(..)
17+ , JSObjectRef(..)
18+ , JSPropertyNameArrayRef(..)
19+ , JSPropertyAttributes(..)
20+ , JSContextRef(..)
21+ , JSStringRef(..)
22+ , Index(..)
23+) where
24+
25+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
26+import GHCJS.Types
27+import Data.Word (Word(..))
28+#else
29+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
30+ (JSValueRef, JSValueRefRef, JSObjectRef, JSStringRef,
31+ JSContextRef, JSPropertyNameArrayRef)
32+import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef (JSPropertyAttributes)
33+import Foreign.C (CUInt(..))
34+#endif
35+
36+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
37+data ValueOrObject
38+data Object
39+data PropertyNameArray
40+type JSValueRef = JSRef ValueOrObject
41+type JSValueRefRef = JSArray ValueOrObject
42+type JSObjectRef = JSRef ValueOrObject
43+type JSPropertyNameArrayRef = JSRef PropertyNameArray
44+type JSPropertyAttributes = Word
45+type JSContextRef = ()
46+type JSStringRef = JSString
47+type Index = Int
48+
49+instance Show (JSRef ValueOrObject)
50+instance Eq (JSRef ValueOrObject)
51+#else
52+type Index = CUInt
53+#endif
src/Language/Javascript/JSC/Value.hs+86−5
@@ -1,5 +1,10 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
1{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE TypeSynonymInstances #-}
4{-# LANGUAGE TypeSynonymInstances #-}
5+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
6+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}
7+#endif
3-----------------------------------------------------------------------------
8-----------------------------------------------------------------------------
4--
9--
5-- Module : Language.Javascript.JSC.Value
10-- Module : Language.Javascript.JSC.Value
@@ -59,12 +64,13 @@ module Language.Javascript.JSC.Value (
59) where
64) where
60
65
61import Prelude hiding (catch)
66import Prelude hiding (catch)
62−import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
67+import Language.Javascript.JSC.Types
63 (JSValueRefRef, JSObjectRef, JSStringRef, JSValueRef)
68 (JSValueRefRef, JSObjectRef, JSStringRef, JSValueRef)
64−import Language.Javascript.JSC.Monad (JSC, catchval)
69+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
65−import Language.Javascript.JSC.Exception (rethrow)
70+import GHCJS.Types (castRef, JSRef(..))
66−import Control.Monad.Trans.Reader (ask)
71+import GHCJS.Foreign (toJSBool, fromJSBool', jsNull, jsUndefined, toJSString)
67−import Control.Monad.IO.Class (MonadIO, MonadIO(..))
72+import GHCJS.Marshal (toJSRef)
73+#else
68import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
74import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
69 (jsvaluecreatejsonstring, JSType(..), jsvaluegettype,
75 (jsvaluecreatejsonstring, JSType(..), jsvaluegettype,
70 jsvaluemakestring, jsvaluemakenumber, jsvaluemakeboolean,
76 jsvaluemakestring, jsvaluemakenumber, jsvaluemakeboolean,
@@ -73,6 +79,11 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
73import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
79import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
74 (jsstringcreatewithcharacters, jsstringgetcharactersptr,
80 (jsstringcreatewithcharacters, jsstringgetcharactersptr,
75 jsstringgetlength)
81 jsstringgetlength)
82+#endif
83+import Language.Javascript.JSC.Monad (JSC, catchval)
84+import Language.Javascript.JSC.Exception (rethrow)
85+import Control.Monad.Trans.Reader (ask)
86+import Control.Monad.IO.Class (MonadIO, MonadIO(..))
76import qualified Data.Text.Foreign as T (fromPtr)
87import qualified Data.Text.Foreign as T (fromPtr)
77import Foreign (castPtr)
88import Foreign (castPtr)
78import Data.Text.Foreign (useAsPtr)
89import Data.Text.Foreign (useAsPtr)
@@ -125,10 +136,14 @@ data JSValue = ValNull -- ^ null
125-- >>> testJSC $ valToBool "1"
136-- >>> testJSC $ valToBool "1"
126-- true
137-- true
127valToBool :: MakeValueRef val => val -> JSC JSBool
138valToBool :: MakeValueRef val => val -> JSC JSBool
139+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
140+valToBool val = fromJSBool' <$> makeValueRef val
141+#else
128valToBool val = do
142valToBool val = do
129 gctxt <- ask
143 gctxt <- ask
130 rval <- makeValueRef val
144 rval <- makeValueRef val
131 liftIO $ jsvaluetoboolean gctxt rval
145 liftIO $ jsvaluetoboolean gctxt rval
146+#endif
132
147
133-- | Given a JavaScript value get its numeric value.
148-- | Given a JavaScript value get its numeric value.
134-- May throw JSException.
149-- May throw JSException.
@@ -150,10 +165,17 @@ valToBool val = do
150-- >>> testJSC $ show <$> valToNumber "1"
165-- >>> testJSC $ show <$> valToNumber "1"
151-- 1.0
166-- 1.0
152valToNumber :: MakeValueRef val => val -> JSC JSNumber
167valToNumber :: MakeValueRef val => val -> JSC JSNumber
168+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
169+valToNumber val = jsrefToNumber <$> makeValueRef val
170+foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSRef a -> Double
171+#elif defined(USE_WEBKIT)
153valToNumber val = do
172valToNumber val = do
154 gctxt <- ask
173 gctxt <- ask
155 rval <- makeValueRef val
174 rval <- makeValueRef val
156 rethrow $ liftIO . jsvaluetonumber gctxt rval
175 rethrow $ liftIO . jsvaluetonumber gctxt rval
176+#else
177+valToNumber = undefined
178+#endif
157
179
158-- | Given a JavaScript value get its string value (as a JavaScript string).
180-- | Given a JavaScript value get its string value (as a JavaScript string).
159-- May throw JSException.
181-- May throw JSException.
@@ -175,10 +197,17 @@ valToNumber val = do
175-- >>> testJSC $ valToStr "1" >>= strToText
197-- >>> testJSC $ valToStr "1" >>= strToText
176-- 1
198-- 1
177valToStr :: MakeValueRef val => val -> JSC JSStringRef
199valToStr :: MakeValueRef val => val -> JSC JSStringRef
200+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
201+valToStr val = jsrefToString <$> makeValueRef val
202+foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSRef a -> JSStringRef
203+#elif defined(USE_WEBKIT)
178valToStr val = do
204valToStr val = do
179 gctxt <- ask
205 gctxt <- ask
180 rval <- makeValueRef val
206 rval <- makeValueRef val
181 rethrow $ liftIO . jsvaluetostringcopy gctxt rval
207 rethrow $ liftIO . jsvaluetostringcopy gctxt rval
208+#else
209+valToStr = undefined
210+#endif
182
211
183-- | Given a JavaScript value get its string value (as a Haskell 'Text').
212-- | Given a JavaScript value get its string value (as a Haskell 'Text').
184-- May throw JSException.
213-- May throw JSException.
@@ -224,10 +253,17 @@ valToText jsvar = valToStr jsvar >>= strToText
224-- >>> testJSC $ obj >>= valToJSON 0 >>= strToText
253-- >>> testJSC $ obj >>= valToJSON 0 >>= strToText
225-- {}
254-- {}
226valToJSON :: MakeValueRef val => Word -> val -> JSC JSStringRef
255valToJSON :: MakeValueRef val => Word -> val -> JSC JSStringRef
256+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
257+valToJSON indent val = jsrefToJSON <$> makeValueRef val
258+foreign import javascript unsafe "$r = JSON.stringify($1);" jsrefToJSON :: JSRef a -> JSStringRef
259+#elif defined(USE_WEBKIT)
227valToJSON indent val = do
260valToJSON indent val = do
228 gctxt <- ask
261 gctxt <- ask
229 rval <- makeValueRef val
262 rval <- makeValueRef val
230 rethrow $ liftIO . jsvaluecreatejsonstring gctxt rval (fromIntegral indent)
263 rethrow $ liftIO . jsvaluecreatejsonstring gctxt rval (fromIntegral indent)
264+#else
265+valToJSON = undefined
266+#endif
231
267
232-- | Given a JavaScript value get its object value.
268-- | Given a JavaScript value get its object value.
233-- May throw JSException.
269-- May throw JSException.
@@ -249,10 +285,14 @@ valToJSON indent val = do
249-- >>> testJSC $ valToObject "1"
285-- >>> testJSC $ valToObject "1"
250-- 1
286-- 1
251valToObject :: MakeValueRef val => val -> JSC JSObjectRef
287valToObject :: MakeValueRef val => val -> JSC JSObjectRef
288+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
289+valToObject val = castRef <$> makeValueRef val
290+#else
252valToObject val = do
291valToObject val = do
253 gctxt <- ask
292 gctxt <- ask
254 rval <- makeValueRef val
293 rval <- makeValueRef val
255 rethrow $ liftIO . jsvaluetoobject gctxt rval
294 rethrow $ liftIO . jsvaluetoobject gctxt rval
295+#endif
256
296
257-- | Convert to a JavaScript value (just an alias for 'makeValueRef')
297-- | Convert to a JavaScript value (just an alias for 'makeValueRef')
258val :: MakeValueRef value
298val :: MakeValueRef value
@@ -276,7 +316,11 @@ instance MakeValueRef v => MakeValueRef (JSC v) where
276----------- null ---------------
316----------- null ---------------
277-- | Make a @null@ JavaScript value
317-- | Make a @null@ JavaScript value
278valMakeNull :: JSC JSValueRef
318valMakeNull :: JSC JSValueRef
319+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
320+valMakeNull = return jsNull
321+#else
279valMakeNull = ask >>= (liftIO . jsvaluemakenull)
322valMakeNull = ask >>= (liftIO . jsvaluemakenull)
323+#endif
280
324
281-- | Makes a @null@ JavaScript value
325-- | Makes a @null@ JavaScript value
282instance MakeValueRef JSNull where
326instance MakeValueRef JSNull where
@@ -289,7 +333,11 @@ instance MakeArgRefs JSNull where
289----------- undefined ---------------
333----------- undefined ---------------
290-- | Make an @undefined@ JavaScript value
334-- | Make an @undefined@ JavaScript value
291valMakeUndefined :: JSC JSValueRef
335valMakeUndefined :: JSC JSValueRef
336+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
337+valMakeUndefined = return jsUndefined
338+#else
292valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)
339valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)
340+#endif
293
341
294-- | Makes an @undefined@ JavaScript value
342-- | Makes an @undefined@ JavaScript value
295instance MakeValueRef JSUndefined where
343instance MakeValueRef JSUndefined where
@@ -307,9 +355,13 @@ instance MakeArgRefs () where
307----------- booleans ---------------
355----------- booleans ---------------
308-- | Make a JavaScript boolean value
356-- | Make a JavaScript boolean value
309valMakeBool :: JSBool -> JSC JSValueRef
357valMakeBool :: JSBool -> JSC JSValueRef
358+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
359+valMakeBool b = return . castRef $ toJSBool b
360+#else
310valMakeBool b = do
361valMakeBool b = do
311 gctxt <- ask
362 gctxt <- ask
312 liftIO $ jsvaluemakeboolean gctxt b
363 liftIO $ jsvaluemakeboolean gctxt b
364+#endif
313
365
314-- | Make a JavaScript boolean value
366-- | Make a JavaScript boolean value
315instance MakeValueRef Bool where
367instance MakeValueRef Bool where
@@ -322,9 +374,13 @@ instance MakeArgRefs Bool where
322----------- numbers ---------------
374----------- numbers ---------------
323-- | Make a JavaScript number
375-- | Make a JavaScript number
324valMakeNumber :: JSNumber -> JSC JSValueRef
376valMakeNumber :: JSNumber -> JSC JSValueRef
377+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
378+valMakeNumber n = liftIO $ castRef <$> toJSRef n
379+#else
325valMakeNumber n = do
380valMakeNumber n = do
326 gctxt <- ask
381 gctxt <- ask
327 liftIO $ jsvaluemakenumber gctxt n
382 liftIO $ jsvaluemakenumber gctxt n
383+#endif
328
384
329-- | Makes a JavaScript number
385-- | Makes a JavaScript number
330instance MakeValueRef Double where
386instance MakeValueRef Double where
@@ -337,9 +393,13 @@ instance MakeArgRefs Double where
337----------- numbers ---------------
393----------- numbers ---------------
338-- | Make a JavaScript string
394-- | Make a JavaScript string
339valMakeString :: Text -> JSC JSValueRef
395valMakeString :: Text -> JSC JSValueRef
396+#if (defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)
397+valMakeString = return . castRef . toJSString
398+#else
340valMakeString text = do
399valMakeString text = do
341 gctxt <- ask
400 gctxt <- ask
342 liftIO $ jsvaluemakestring gctxt (textToStr text)
401 liftIO $ jsvaluemakestring gctxt (textToStr text)
402+#endif
343
403
344-- | Makes a JavaScript string
404-- | Makes a JavaScript string
345instance MakeValueRef Text where
405instance MakeValueRef Text where
@@ -374,6 +434,24 @@ instance MakeValueRef String where
374-- >>> testJSC $ show <$> valToObject True >>= deRefVal
434-- >>> testJSC $ show <$> valToObject True >>= deRefVal
375-- ValObject 0x...
435-- ValObject 0x...
376deRefVal :: MakeValueRef val => val -> JSC JSValue
436deRefVal :: MakeValueRef val => val -> JSC JSValue
437+#if defined(__GHCJS__) && defined(USE_JAVASCRIPTFFI)
438+deRefVal val = do
439+ gctxt <- ask
440+ valref <- makeValueRef val
441+ case (jsrefGetType valref :: Int) of
442+ 0 -> return ValUndefined
443+ 1 -> return ValNull
444+ 2 -> ValBool <$> valToBool valref
445+ 3 -> ValNumber <$> valToNumber valref
446+ 4 -> ValString <$> (valToStr valref >>= strToText)
447+ 5 -> ValObject <$> valToObject valref
448+foreign import javascript unsafe "$r = ($1 === undefined)?0:\
449+ ($1===null)?1:\
450+ (typeof $1===\"boolean\")?2:\
451+ (typeof $1===\"number\")?3:\
452+ (typeof $1===\"string\")?4:\
453+ (typeof $1===\"object\")?5:-1;" jsrefGetType :: JSValueRef -> Int
454+#elif defined(USE_WEBKIT)
377deRefVal val = do
455deRefVal val = do
378 gctxt <- ask
456 gctxt <- ask
379 valref <- makeValueRef val
457 valref <- makeValueRef val
@@ -385,6 +463,9 @@ deRefVal val = do
385 Kjstypenumber -> ValNumber <$> valToNumber valref
463 Kjstypenumber -> ValNumber <$> valToNumber valref
386 Kjstypestring -> ValString <$> (valToStr valref >>= strToText)
464 Kjstypestring -> ValString <$> (valToStr valref >>= strToText)
387 Kjstypeobject -> ValObject <$> valToObject valref
465 Kjstypeobject -> ValObject <$> valToObject valref
466+#else
467+deRefVal = undefined
468+#endif
388
469
389-- | Make a JavaScript value out of a 'JSValue' ADT.
470-- | Make a JavaScript value out of a 'JSValue' ADT.
390--
471--
tests/TestJSC.hs+3−2
@@ -18,7 +18,7 @@ module Main (
18import Prelude hiding((!!), catch)
18import Prelude hiding((!!), catch)
19import Graphics.UI.Gtk
19import Graphics.UI.Gtk
20 (Window, widgetDestroy, postGUIAsync, postGUISync, widgetShowAll,
20 (Window, widgetDestroy, postGUIAsync, postGUISync, widgetShowAll,
21− mainGUI, mainQuit, onDestroy, containerAdd, scrolledWindowNew,
21+ mainGUI, mainQuit, on, destroyEvent, containerAdd, scrolledWindowNew,
22 windowSetPosition, windowSetDefaultSize, timeoutAddFull, windowNew,
22 windowSetPosition, windowSetDefaultSize, timeoutAddFull, windowNew,
23 initGUI)
23 initGUI)
24import Control.Concurrent
24import Control.Concurrent
@@ -82,7 +82,7 @@ testJSC' showWindow f = do
82 webView <- webViewNew
82 webView <- webViewNew
83 window `containerAdd` scrollWin
83 window `containerAdd` scrollWin
84 scrollWin `containerAdd` webView
84 scrollWin `containerAdd` webView
85− window `onDestroy` do
85+ on window destroyEvent . liftIO $ do
86 debugLog "onDestroy"
86 debugLog "onDestroy"
87 tryTakeMVar state
87 tryTakeMVar state
88 debugLog "put state"
88 debugLog "put state"
@@ -91,6 +91,7 @@ testJSC' showWindow f = do
91 mainQuit
91 mainQuit
92 debugLog "put done"
92 debugLog "put done"
93 putMVar done ()
93 putMVar done ()
94+ return True
94 debugLog "get context"
95 debugLog "get context"
95 jsContext <- webViewGetMainFrame webView >>= webFrameGetGlobalContext
96 jsContext <- webViewGetMainFrame webView >>= webFrameGetGlobalContext
96 debugLog "put initial state"
97 debugLog "put initial state"