073347d · jsaddle · git.iko.soy

git.iko.soy/jsaddle

on master help sign in

Fixing JSAddle to work with new GHCJS.

073347dWojciech Danilo11 years ago

jsaddle.cabal+5−3

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1name: jsaddle

2−version: 0.2.1.0

2+version: 0.2.2.0

3cabal-version: >=1.10

4license: MIT

5license-file: LICENSE

@@ -32,7 +32,8 @@ flag webkit

32library

33 if impl(ghcjs) && flag(jsffi)

34 cpp-options: -DUSE_JAVASCRIPTFFI

35− build-depends: ghcjs-base

35+ build-depends: ghcjs-base,

36+ ghcjs-prim

37 if !impl(ghcjs) || flag(webkit)

38 if !impl(ghcjs) || flag(webkit)

38 cpp-options: -DUSE_WEBKIT

39 cpp-options: -DUSE_WEBKIT

@@ -67,7 +68,8 @@ test-suite test-tool

68 if impl(ghcjs) && flag(jsffi)

69 if impl(ghcjs) && flag(jsffi)

69 cpp-options: -DUSE_JAVASCRIPTFFI

70 cpp-options: -DUSE_JAVASCRIPTFFI

70− build-depends: ghcjs-base

71+ build-depends: ghcjs-base,

72+ ghcjs-prim

72 if !impl(ghcjs) || flag(webkit)

74 if !impl(ghcjs) || flag(webkit)

73 cpp-options: -DUSE_WEBKIT

75 cpp-options: -DUSE_WEBKIT

src/Language/Javascript/JSaddle/Arguments.hs+11

@@ -56,3 +56,14 @@ instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3, MakeValueRef

56 rarg5 <- makeValueRef arg5

57 return [rarg1, rarg2, rarg3, rarg4, rarg5]

59+

60+instance (MakeValueRef arg1, MakeValueRef arg2, MakeValueRef arg3, MakeValueRef arg4, MakeValueRef arg5, MakeValueRef arg6) => MakeArgRefs (arg1, arg2, arg3, arg4, arg5, arg6) where

61+ makeArgRefs (arg1, arg2, arg3, arg4, arg5, arg6) = do

62+ rarg1 <- makeValueRef arg1

63+ rarg2 <- makeValueRef arg2

64+ rarg3 <- makeValueRef arg3

65+ rarg4 <- makeValueRef arg4

66+ rarg5 <- makeValueRef arg5

67+ rarg6 <- makeValueRef arg6

68+ return [rarg1, rarg2, rarg3, rarg4, rarg5, rarg6]

69+

src/Language/Javascript/JSaddle/Classes.hs+8−1

@@ -23,9 +23,10 @@ module Language.Javascript.JSaddle.Classes (

24import Control.Monad.IO.Class (MonadIO)

25import Language.Javascript.JSaddle.Types

26− (JSObjectRef, JSStringRef, JSValueRef)

26+ (JSObjectRef, JSStringRef, JSValueRef, castRef)

27import Language.Javascript.JSaddle.Monad (JSM)

28import Language.Javascript.JSaddle.PropRef (JSPropRef)

29+import GHCJS.Types (JSRef(..))

30-- | Anything that can be used to make a JavaScript value reference

31-- | Anything that can be used to make a JavaScript value reference

31class MakeValueRef a where

32class MakeValueRef a where

@@ -49,4 +50,10 @@ class MakePropRef this where

49 makePropRef :: this -> JSM JSPropRef

50 makePropRef :: this -> JSM JSPropRef

53+instance MakeObjectRef JSValueRef where

54+ makeObjectRef = return . castRef

55+

56+instance MakeObjectRef JSRef where

57+ makeObjectRef = return . castRef

58+

src/Language/Javascript/JSaddle/Evaluate.hs+13−3

@@ -1,4 +1,5 @@

1{-# LANGUAGE CPP #-}

2+{-# LANGUAGE FlexibleInstances #-}

2#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

3#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

3{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}

4{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}

4#endif

5#endif

@@ -24,9 +25,11 @@ import Control.Monad.Trans.Reader (ask)

24import Control.Monad.IO.Class (MonadIO(..))

25import Control.Monad.IO.Class (MonadIO(..))

25import Language.Javascript.JSaddle.Types

26import Language.Javascript.JSaddle.Types

26 (JSStringRef, JSValueRef, JSObjectRef,

27 (JSStringRef, JSValueRef, JSObjectRef,

27− JSValueRefRef)

28+ JSValueRefRef, castRef)

28#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

29#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

29import GHCJS.Types (nullRef)

30import GHCJS.Types (nullRef)

31+import GHCJS.Prim (JSRef)

32+import Data.JSString (JSString)

30#else

33#else

31import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

34import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

32 (jsevaluatescript)

35 (jsevaluatescript)

@@ -40,6 +43,9 @@ import Language.Javascript.JSaddle.Classes

40import Language.Javascript.JSaddle.Monad (JSM)

43import Language.Javascript.JSaddle.Monad (JSM)

46+foreign import javascript unsafe

47+ "$r = $1" jsRefToJSSTring :: JSRef -> JSString

48+

43-- | Evaluates a script (like eval in java script). Unlike 'eval' this function lets you

49-- | Evaluates a script (like eval in java script). Unlike 'eval' this function lets you

44-- specify a source URL and starting line number for beter error information.

50-- specify a source URL and starting line number for beter error information.

45--

51--

@@ -72,8 +78,12 @@ eval :: MakeStringRef script

72 => script -- ^ JavaScript to evaluate

78 => script -- ^ JavaScript to evaluate

73 -> JSM JSValueRef

79 -> JSM JSValueRef

74#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

80#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

75−eval script = evaluateScript script (nullRef::JSObjectRef) (nullRef::JSStringRef) 1

81+eval script = evaluateScript script (castRef nullRef::JSObjectRef) (jsRefToJSSTring nullRef::JSStringRef) 1

76#else

82#else

77−eval script = evaluateScript script (nullPtr::JSObjectRef) (nullPtr::JSStringRef) 1

83+eval script = evaluateScript script (castRef nullPtr::JSObjectRef) (jsRefToJSSTring nullPtr::JSStringRef) 1

78#endif

84#endif

86+

87+

88+instance MakeObjectRef String where

89+ makeObjectRef = makeObjectRef . eval

src/Language/Javascript/JSaddle/Monad.hs+6−5

@@ -28,11 +28,12 @@ module Language.Javascript.JSaddle.Monad (

28import Prelude hiding (catch)

29import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))

30import Language.Javascript.JSaddle.Types

31− (JSValueRefRef, JSValueRef, JSContextRef)

31+ (JSValueRefRef, JSValueRef, JSContextRef, JSValueRef(..))

32import Control.Monad.IO.Class (MonadIO(..))

33#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

34import GHCJS.Types (isUndefined, isNull)

35−import GHCJS.Foreign (newArray, indexArray)

35+--import GHCJS.Foreign (newArray, indexArray)

36+import qualified JavaScript.Array as Array

36#else

37#else

37import Foreign (nullPtr, alloca)

38import Foreign (nullPtr, alloca)

38import Foreign.Storable (Storable(..))

39import Foreign.Storable (Storable(..))

@@ -70,12 +71,12 @@ t `catch` c = do

70catchval :: (JSValueRefRef -> JSM a) -> (JSValueRef -> JSM a) -> JSM a

71catchval :: (JSValueRefRef -> JSM a) -> (JSValueRef -> JSM a) -> JSM a

71catchval f catcher = do

72catchval f catcher = do

72#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

73#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

73− pexc <- liftIO newArray

74+ pexc <- liftIO Array.create

74 result <- f pexc

75 result <- f pexc

75− exc <- liftIO $ indexArray 0 pexc

76+ exc <- liftIO $ (Array.! 0) <$> Array.freeze pexc

76 if isUndefined exc || isNull exc

77 if isUndefined exc || isNull exc

77 then return result

78 then return result

78− else catcher exc

79+ else catcher (JSValueRef exc)

79#else

80#else

80 gctxt <- ask

81 gctxt <- ask

81 liftIO . alloca $ \pexc -> flip runReaderT gctxt $ do

82 liftIO . alloca $ \pexc -> flip runReaderT gctxt $ do

src/Language/Javascript/JSaddle/Object.hs+63−39

@@ -77,13 +77,20 @@ module Language.Javascript.JSaddle.Object (

77import Prelude hiding ((!!))

78import Language.Javascript.JSaddle.Types

79 (JSPropertyNameArrayRef, JSStringRef, JSObjectRef, JSValueRefRef,

80− JSValueRef, JSContextRef, Index)

80+ JSValueRef, JSContextRef, Index, castRef)

81import Foreign.C.Types (CSize(..), CULong(..), CUInt(..), CULLong(..))

82#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

83−import GHCJS.Types (nullRef, castRef, JSArray, JSFun)

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))

84−import GHCJS.Foreign (newObj, toArray, fromArray, syncCallback2, ForeignRetention(..))

87+--import GHCJS.Foreign (newObj, toArray, fromArray, syncCallback2, ForeignRetention(..))

85import Control.Monad (liftM)

88import Control.Monad (liftM)

86import Control.Applicative ((<$>))

89import Control.Applicative ((<$>))

90+import qualified JavaScript.Array as Array

91+import JavaScript.Array (JSArray)

92+import GHCJS.Prim (JSRef)

93+import Data.JSString (JSString)

87#else

94#else

88import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

95import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

89 (jsobjectmake, jspropertynamearraygetnameatindex,

96 (jsobjectmake, jspropertynamearraygetnameatindex,

@@ -119,6 +126,15 @@ import Control.Lens

119 (IndexPreservingGetter, to, (^.))

126 (IndexPreservingGetter, to, (^.))

120import Language.Javascript.JSaddle.String (textToStr)

127import Language.Javascript.JSaddle.String (textToStr)

121

128

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+

122-- | If we already have a JSObjectRef we are fine

138-- | If we already have a JSObjectRef we are fine

123instance MakeObjectRef JSObjectRef where

139instance MakeObjectRef JSObjectRef where

124 makeObjectRef = return

140 makeObjectRef = return

@@ -245,7 +261,7 @@ infixr 2 #

245prop # args = do

261prop # args = do

246 rprop <- makePropRef prop

262 rprop <- makePropRef prop

247 (this, f) <- objGetProperty' rprop

263 (this, f) <- objGetProperty' rprop

248− rethrow $ objCallAsFunction f this args

264+ rethrow $ objCallAsFunction (castRef f) this args

249

265

250-- | Call a JavaScript function

266-- | Call a JavaScript function

251--

267--

@@ -296,7 +312,7 @@ call function this args = do

296-- Hello

312-- Hello

297obj :: JSM JSObjectRef

313obj :: JSM JSObjectRef

298#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

314#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

299−obj = liftIO $ newObj

315+obj = liftIO (castRef . objectToRef <$> Object.create)

300#else

316#else

301obj = do

317obj = do

302 gctxt <- ask

318 gctxt <- ask

@@ -328,60 +344,68 @@ foreign import ccall "wrapper"

328 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback

344 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback

329#endif

345#endif

330

346

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+

331-- ^ Make a JavaScript function object that wraps a Haskell function.

352-- ^ Make a JavaScript function object that wraps a Haskell function.

332function :: MakeStringRef name

353function :: MakeStringRef name

333 => name -- ^ Name of the function

354 => name -- ^ Name of the function

334 -> JSCallAsFunction -- ^ Haskell function to call

355 -> JSCallAsFunction -- ^ Haskell function to call

335 -> JSM JSObjectRef -- ^ Returns a JavaScript function object that will

356 -> JSM JSObjectRef -- ^ Returns a JavaScript function object that will

336 -- call the Haskell one when it is called

357 -- call the Haskell one when it is called

337−#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

358+-- #if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

338−function name f = liftIO $ do

359+-- function name f = liftIO $ do

339− callback <- syncCallback2 AlwaysRetain True $ \this args -> do

360+-- callback <- syncCallback2 ThrowWouldBlock True $ \this args -> do

340− rargs <- fromArray args

361+-- rargs <- fromArray args

341− runReaderT (f this this rargs) () -- TODO pass function object through

362+-- runReaderT (f this this rargs) () -- TODO pass function object through

342− makeFunctionWithCallback (makeStringRef name) callback

363+-- makeFunctionWithCallback (makeStringRef name) callback

343−foreign import javascript unsafe "$r = function () { $2(this, arguments); }"

364+-- foreign import javascript unsafe "$r = function () { $2(this, arguments); }"

344− makeFunctionWithCallback :: JSStringRef -> JSFun (JSValueRef -> JSValueRefRef -> IO ()) -> IO JSObjectRef

365+-- makeFunctionWithCallback :: JSStringRef -> JSFun (JSValueRef -> JSValueRefRef -> IO ()) -> IO JSObjectRef

345−#elif defined(USE_WEBKIT)

366+-- #elif defined(USE_WEBKIT)

346−function name f = do

367+-- function name f = do

347− gctxt <- ask

368+-- gctxt <- ask

348− callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap

369+-- callback <- liftIO $ mkJSObjectCallAsFunctionCallback wrap

349− liftIO $ jsobjectmakefunctionwithcallback gctxt (makeStringRef name) callback

370+-- liftIO $ jsobjectmakefunctionwithcallback gctxt (makeStringRef name) callback

350− where

371+-- where

351− wrap ctx fobj this argc argv exception = do

372+-- wrap ctx fobj this argc argv exception = do

352− args <- peekArray (fromIntegral argc) argv

373+-- args <- peekArray (fromIntegral argc) argv

353− (`runReaderT` ctx) $

374+-- (`runReaderT` ctx) $

354− f fobj this args >>= makeValueRef

375+-- f fobj this args >>= makeValueRef

355− `E.catch` \(e :: SomeException) -> do

376+-- `E.catch` \(e :: SomeException) -> do

356− str <- runReaderT (makeValueRef . T.pack $ show e) ctx

377+-- str <- runReaderT (makeValueRef . T.pack $ show e) ctx

357− poke exception str

378+-- poke exception str

358− jsvaluemakeundefined ctx

379+-- jsvaluemakeundefined ctx

359−#else

380+-- #else

360−function = undefined

381+-- function = undefined

361−#endif

382+-- #endif

383+

384+function = undefined

362

385

363-- | A callback to Haskell can be used as a JavaScript value. This will create

386-- | A callback to Haskell can be used as a JavaScript value. This will create

364-- an anonymous JavaScript function object. Use 'function' to create one with

387-- an anonymous JavaScript function object. Use 'function' to create one with

365-- a name.

388-- a name.

366instance MakeValueRef JSCallAsFunction where

389instance MakeValueRef JSCallAsFunction where

367#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

390#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

369#else

392#else

370− makeValueRef = function (nullPtr:: JSStringRef)

393+ makeValueRef a = castRef <$> function (jsRefToJSSTring nullPtr :: JSStringRef) a

371#endif

394#endif

372

395

373instance MakeArgRefs JSCallAsFunction where

396instance MakeArgRefs JSCallAsFunction where

374 makeArgRefs f = do

397 makeArgRefs f = do

375#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

398#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

376− rarg <- function (nullRef:: JSStringRef) f

399+ rarg <- function (jsRefToJSSTring nullRef :: JSStringRef) f

377#else

400#else

378− rarg <- function (nullPtr:: JSStringRef) f

401+ rarg <- function (jsRefToJSSTring nullPtr :: JSStringRef) f

379#endif

402#endif

380− return [rarg]

403+ return [castRef rarg]

381

404

382makeArray :: MakeArgRefs args => args -> JSValueRefRef -> JSM JSObjectRef

405makeArray :: MakeArgRefs args => args -> JSValueRefRef -> JSM JSObjectRef

383#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

406#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

407+--makeArray args exceptions = makeArgRefs args >>= liftIO . toArray

384−makeArray args exceptions = makeArgRefs args >>= liftM castRef . liftIO . toArray

408+makeArray args exceptions = makeArgRefs args >>= liftM (castRef . getJSArrayRef) . liftIO . toArray

385#else

409#else

386makeArray args exceptions = do

410makeArray args exceptions = do

387 gctxt <- ask

411 gctxt <- ask

@@ -441,7 +465,7 @@ propertyNames :: MakeObjectRef this => this -> JSM [JSStringRef]

441#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

465#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

442propertyNames this = makeObjectRef this >>= liftIO . js_propertyNames >>= liftIO . fromArray

466propertyNames this = makeObjectRef this >>= liftIO . js_propertyNames >>= liftIO . fromArray

443foreign import javascript unsafe "$r = []; h$forIn($1, function(n){$r.push(n);})"

467foreign 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

445#elif defined(USE_WEBKIT)

469#elif defined(USE_WEBKIT)

446propertyNames this = copyPropertyNames this >>= propertyNamesList

470propertyNames this = copyPropertyNames this >>= propertyNamesList

447#else

471#else

@@ -461,7 +485,7 @@ objCallAsFunction :: MakeArgRefs args

461 -> JSM JSValueRef

485 -> JSM JSValueRef

462#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

486#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

463objCallAsFunction function this args exceptions = do

487objCallAsFunction function this args exceptions = do

464− rargs <- makeArgRefs args >>= liftIO . toArray

488+ rargs <- (makeArgRefs args >>= liftIO . toArray) >>= (liftIO . Array.thaw)

465 liftIO $ js_apply function this rargs exceptions

489 liftIO $ js_apply function this rargs exceptions

466foreign import javascript unsafe "try { $r = $1.apply($2, $3) } catch(e) { $4[0] = e }"

490foreign import javascript unsafe "try { $r = $1.apply($2, $3) } catch(e) { $4[0] = e }"

467 js_apply :: JSObjectRef -> JSObjectRef -> JSValueRefRef -> JSValueRefRef -> IO JSValueRef

491 js_apply :: JSObjectRef -> JSObjectRef -> JSValueRefRef -> JSValueRefRef -> IO JSValueRef

@@ -486,7 +510,7 @@ objCallAsConstructor :: MakeArgRefs args

486 -> JSM JSValueRef

510 -> JSM JSValueRef

487#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

511#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

488objCallAsConstructor function args exceptions = do

512objCallAsConstructor function args exceptions = do

489− rargs <- makeArgRefs args >>= liftIO . toArray

513+ rargs <- (makeArgRefs args >>= liftIO . toArray) >>= (liftIO . Array.thaw)

490 liftIO $ js_new function rargs exceptions

514 liftIO $ js_new function rargs exceptions

491foreign import javascript unsafe "\

515foreign import javascript unsafe "\

492 try {\

516 try {\

src/Language/Javascript/JSaddle/PropRef.hs+10−3

@@ -1,3 +1,6 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE MultiParamTypeClasses #-}

1-----------------------------------------------------------------------------

4-----------------------------------------------------------------------------

2--

5--

3-- Module : Language.Javascript.JSaddle.PropRef

6-- Module : Language.Javascript.JSaddle.PropRef

@@ -15,11 +18,15 @@ module Language.Javascript.JSaddle.PropRef (

15) where

18) where

17import Language.Javascript.JSaddle.Types

20import Language.Javascript.JSaddle.Types

18− (JSStringRef, JSObjectRef, Index)

21+ (JSStringRef, JSObjectRef, Index, RefCast(..))

22+import GHCJS.Types (JSRef)

23+

24+--foreign import javascript unsafe "$1[$2]"

25+-- getChild :: JSRef -> JSRef -> IO JSRef

20-- | A reference to a property.

27-- | A reference to a property.

21-- Implemented as a reference to an object and something to find the property.

28-- Implemented as a reference to an object and something to find the property.

22−data JSPropRef = JSPropRef JSObjectRef JSStringRef -- ^ Object and property name.

29+data JSPropRef = JSPropRef JSObjectRef JSStringRef -- ^ Object and property name.

23− | JSPropIndexRef JSObjectRef Index -- ^ Object and property index.

30+ | JSPropIndexRef JSObjectRef Index -- ^ Object and property index.

src/Language/Javascript/JSaddle/Properties.hs+2−2

@@ -44,7 +44,7 @@ import Language.Javascript.JSaddle.Classes

44import Language.Javascript.JSaddle.Monad (JSM)

45import Language.Javascript.JSaddle.Types

46 (JSValueRefRef, JSObjectRef, JSPropertyAttributes,

47− Index(..), JSStringRef)

47+ Index(..), JSStringRef, castRef)

48#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

49#else

50import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef

@@ -70,7 +70,7 @@ instance MakePropRef prop => MakePropRef (JSM prop) where

71-- | We can use a property as an object.

72instance MakeObjectRef JSPropRef where

73− makeObjectRef = objGetProperty

73+ makeObjectRef a = castRef <$> objGetProperty a

75-- | We can use a property as a value.

76instance MakeValueRef JSPropRef where

src/Language/Javascript/JSaddle/String.hs+3−3

@@ -27,7 +27,7 @@ import qualified Data.Text as T (unpack, pack)

27import Control.Monad.IO.Class (MonadIO(..))

28import Language.Javascript.JSaddle.Types (JSStringRef)

29#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

30−import GHCJS.Foreign (fromJSString, toJSString)

30+import Data.JSString.Text (textFromJSString, textToJSString)

31#else

32import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef

33 (jsstringcreatewithcharacters, jsstringgetcharactersptr,

@@ -52,7 +52,7 @@ instance MakeStringRef String where

52-- | Convert a JavaScript string to a Haskell 'Text'

53strToText :: MonadIO m => JSStringRef -> m Text

54#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

55−strToText = return . fromJSString

55+strToText = return . textFromJSString

56#else

57strToText jsstring = liftIO $ do

58 l <- jsstringgetlength jsstring

@@ -63,7 +63,7 @@ strToText jsstring = liftIO $ do

63-- | Convert a Haskell 'Text' to a JavaScript string

64textToStr :: Text -> JSStringRef

65#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

66−textToStr = toJSString

66+textToStr = textToJSString

67#else

68textToStr text = unsafePerformIO $

69 useAsPtr text $ \p l ->

src/Language/Javascript/JSaddle/Types.hs+32−20

@@ -1,4 +1,6 @@

1−{-# LANGUAGE CPP, FlexibleInstances #-}

1+{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE CPP #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

2-----------------------------------------------------------------------------

4-----------------------------------------------------------------------------

3--

5--

4-- Module : Language.Javascript.JSaddle.Properties

6-- Module : Language.Javascript.JSaddle.Properties

@@ -11,19 +13,11 @@

11--

13--

12-----------------------------------------------------------------------------

14-----------------------------------------------------------------------------

14−module Language.Javascript.JSaddle.Types (

16+module Language.Javascript.JSaddle.Types where

15− JSValueRef(..)

16− , JSValueRefRef(..)

17− , JSObjectRef(..)

18− , JSPropertyNameArrayRef(..)

19− , JSPropertyAttributes(..)

20− , JSContextRef(..)

21− , JSStringRef(..)

22− , Index(..)

23−) where

25#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

18#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

26import GHCJS.Types

19import GHCJS.Types

20+import JavaScript.Array

27import Data.Word (Word(..))

21import Data.Word (Word(..))

28#else

22#else

29import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

23import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase

@@ -34,20 +28,38 @@ import Foreign.C (CUInt(..))

34#endif

28#endif

36#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

30#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

37−data ValueOrObject

31+--data ValueOrObject

38−data Object

32+--data Object

39−data PropertyNameArray

33+--data PropertyNameArray

34+newtype JSValueRef = JSValueRef { fromJSValueRef :: JSRef }

35+newtype JSObjectRef = JSObjectRef { fromJSObjectRef :: JSRef }

36+newtype JSPropertyNameArrayRef = JSPropertyNameArrayRef { fromJSPropertyNameArrayRef :: JSRef }

37+

38+instance Show JSValueRef where show _ = "JSValueRef"

39+instance Show JSObjectRef where show _ = "JSObjectRef"

40+instance Show JSPropertyNameArrayRef where show _ = "JSPropertyNameArrayRef"

40−type JSValueRef = JSRef ValueOrObject

41+--type JSValueRef = JSRef ValueOrObject

41−type JSValueRefRef = JSArray ValueOrObject

42+--type JSValueRefRef = JSArray ValueOrObject

43+type JSValueRefRef = MutableJSArray

42−type JSObjectRef = JSRef ValueOrObject

44+--type JSObjectRef = JSRef ValueOrObject

43−type JSPropertyNameArrayRef = JSRef PropertyNameArray

45+--type JSPropertyNameArrayRef = JSRef PropertyNameArray

44type JSPropertyAttributes = Word

46type JSPropertyAttributes = Word

45type JSContextRef = ()

47type JSContextRef = ()

46type JSStringRef = JSString

48type JSStringRef = JSString

47type Index = Int

49type Index = Int

51+class RefCast a b where castRef :: a -> b

52+instance RefCast JSValueRef JSRef where castRef = fromJSValueRef

53+instance RefCast JSValueRef JSObjectRef where castRef = JSObjectRef . castRef

54+instance RefCast JSRef JSValueRef where castRef = JSValueRef

55+instance RefCast JSObjectRef JSValueRef where castRef = JSValueRef . castRef

56+instance RefCast JSObjectRef JSRef where castRef = fromJSObjectRef

57+instance RefCast JSRef JSObjectRef where castRef = JSObjectRef

58+

59+

60+instance Eq JSObjectRef

49−instance Show (JSRef ValueOrObject)

61+--instance Show (JSRef ValueOrObject)

50−instance Eq (JSRef ValueOrObject)

62+--instance Eq (JSRef ValueOrObject)

51#else

63#else

52type Index = CUInt

64type Index = CUInt

53#endif

65#endif

src/Language/Javascript/JSaddle/Value.hs+34−15

@@ -65,11 +65,15 @@ module Language.Javascript.JSaddle.Value (

66import Prelude hiding (catch)

67import Language.Javascript.JSaddle.Types

68− (JSValueRefRef, JSObjectRef, JSStringRef, JSValueRef)

68+ (JSValueRefRef, JSObjectRef, JSStringRef, JSValueRef(..), castRef)

69#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

70−import GHCJS.Types (castRef, JSRef(..))

70+import GHCJS.Types (JSRef(..))

71−import GHCJS.Foreign (toJSBool, fromJSBool', jsNull, jsUndefined, toJSString)

71+import GHCJS.Foreign (fromJSBool, toJSBool, jsNull, jsUndefined)

72import GHCJS.Marshal (toJSRef)

73+import Data.JSString.Text (textFromJSString, textToJSString)

74+import qualified Data.JSString as JS

75+import GHCJS.Marshal.Pure (PToJSRef(..))

76+

73#else

77#else

74import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

78import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef

75 (jsvaluecreatejsonstring, JSType(..), jsvaluegettype,

79 (jsvaluecreatejsonstring, JSType(..), jsvaluegettype,

@@ -96,6 +100,9 @@ import Language.Javascript.JSaddle.String (strToText, textToStr)

96import Language.Javascript.JSaddle.Arguments ()

100import Language.Javascript.JSaddle.Arguments ()

97import Data.Word (Word)

101import Data.Word (Word)

102

103+foreign import javascript unsafe

104+ "$r = $1" getJSStrRef :: JS.JSString -> JSRef

105+

99data JSNull = JSNull -- ^ Type that represents a value that can only be null.

106data JSNull = JSNull -- ^ Type that represents a value that can only be null.

100 -- Haskell of course has no null so we are adding this type.

107 -- Haskell of course has no null so we are adding this type.

101type JSUndefined = () -- ^ A type that can only be undefined in JavaScript. Using ()

108type JSUndefined = () -- ^ A type that can only be undefined in JavaScript. Using ()

@@ -136,7 +143,7 @@ data JSValue = ValNull -- ^ null

136-- true

143-- true

137valToBool :: MakeValueRef val => val -> JSM JSBool

144valToBool :: MakeValueRef val => val -> JSM JSBool

138#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

145#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

139−valToBool val = fromJSBool' <$> makeValueRef val

146+valToBool val = fromJSBool . castRef <$> makeValueRef val

140#else

147#else

141valToBool val = do

148valToBool val = do

142 gctxt <- ask

149 gctxt <- ask

@@ -165,8 +172,8 @@ valToBool val = do

165-- 1.0

172-- 1.0

166valToNumber :: MakeValueRef val => val -> JSM JSNumber

173valToNumber :: MakeValueRef val => val -> JSM JSNumber

167#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

174#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

168−valToNumber val = jsrefToNumber <$> makeValueRef val

175+valToNumber val = jsrefToNumber . castRef <$> makeValueRef val

169−foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSRef a -> Double

176+foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSRef -> Double

170#elif defined(USE_WEBKIT)

177#elif defined(USE_WEBKIT)

171valToNumber val = do

178valToNumber val = do

172 gctxt <- ask

179 gctxt <- ask

@@ -197,8 +204,8 @@ valToNumber = undefined

197-- 1

204-- 1

198valToStr :: MakeValueRef val => val -> JSM JSStringRef

205valToStr :: MakeValueRef val => val -> JSM JSStringRef

199#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

206#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

200−valToStr val = jsrefToString <$> makeValueRef val

207+valToStr val = jsrefToString . castRef <$> makeValueRef val

201−foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSRef a -> JSStringRef

208+foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSRef -> JSStringRef

202#elif defined(USE_WEBKIT)

209#elif defined(USE_WEBKIT)

203valToStr val = do

210valToStr val = do

204 gctxt <- ask

211 gctxt <- ask

@@ -253,8 +260,8 @@ valToText jsvar = valToStr jsvar >>= strToText

253-- {}

260-- {}

254valToJSON :: MakeValueRef val => Word -> val -> JSM JSStringRef

261valToJSON :: MakeValueRef val => Word -> val -> JSM JSStringRef

255#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

262#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)

256−valToJSON indent val = jsrefToJSON <$> makeValueRef val

263+valToJSON indent val = jsrefToJSON . castRef <$> makeValueRef val

257−foreign import javascript unsafe "$r = JSON.stringify($1);" jsrefToJSON :: JSRef a -> JSStringRef

264+foreign import javascript unsafe "$r = JSON.stringify($1);" jsrefToJSON :: JSRef -> JSStringRef

258#elif defined(USE_WEBKIT)

265#elif defined(USE_WEBKIT)

259valToJSON indent val = do

266valToJSON indent val = do

260 gctxt <- ask

267 gctxt <- ask

@@ -316,7 +323,7 @@ instance MakeValueRef v => MakeValueRef (JSM v) where

316-- | Make a @null@ JavaScript value

323-- | Make a @null@ JavaScript value

317valMakeNull :: JSM JSValueRef

324valMakeNull :: JSM JSValueRef

318#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

325#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

319−valMakeNull = return jsNull

326+valMakeNull = return $ JSValueRef jsNull

320#else

327#else

321valMakeNull = ask >>= (liftIO . jsvaluemakenull)

328valMakeNull = ask >>= (liftIO . jsvaluemakenull)

322#endif

329#endif

@@ -333,7 +340,7 @@ instance MakeArgRefs JSNull where

333-- | Make an @undefined@ JavaScript value

340-- | Make an @undefined@ JavaScript value

334valMakeUndefined :: JSM JSValueRef

341valMakeUndefined :: JSM JSValueRef

335#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

342#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

336−valMakeUndefined = return jsUndefined

343+valMakeUndefined = return $ JSValueRef jsUndefined

337#else

344#else

338valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)

345valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined)

339#endif

346#endif

@@ -393,7 +400,7 @@ instance MakeArgRefs Double where

393-- | Make a JavaScript string

400-- | Make a JavaScript string

394valMakeString :: Text -> JSM JSValueRef

401valMakeString :: Text -> JSM JSValueRef

395#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

402#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

396−valMakeString = return . castRef . toJSString

403+valMakeString = return . castRef . getJSStrRef . textToJSString

397#else

404#else

398valMakeString text = do

405valMakeString text = do

399 gctxt <- ask

406 gctxt <- ask

@@ -486,16 +493,28 @@ valMakeRef val =

486 ValBool b -> valMakeBool b

493 ValBool b -> valMakeBool b

487 ValNumber n -> valMakeNumber n

494 ValNumber n -> valMakeNumber n

488 ValString s -> valMakeString s

495 ValString s -> valMakeString s

489− ValObject o -> return o

496+ ValObject o -> return $ castRef o

490

497

491-- | Makes a JavaScript value from a 'JSValue' ADT.

498-- | Makes a JavaScript value from a 'JSValue' ADT.

492instance MakeValueRef JSValue where

499instance MakeValueRef JSValue where

493 makeValueRef = valMakeRef

500 makeValueRef = valMakeRef

494

501

502+instance MakeValueRef JSRef where

503+ makeValueRef = return . castRef

504+

505+instance MakeValueRef Int where

506+ makeValueRef = return . castRef . pToJSRef

507+

508+instance MakeValueRef Float where

509+ makeValueRef = return . castRef . pToJSRef

510+

511+

495-- | Makes an argument list with just a single JavaScript value from a 'JSValue' ADT.

512-- | Makes an argument list with just a single JavaScript value from a 'JSValue' ADT.

496instance MakeArgRefs JSValue where

513instance MakeArgRefs JSValue where

497 makeArgRefs v = valMakeRef v >>= (\ref -> return [ref])

514 makeArgRefs v = valMakeRef v >>= (\ref -> return [ref])

498

515

499instance MakeObjectRef JSNull where

516instance MakeObjectRef JSNull where

500− makeObjectRef = const valMakeNull

517+ makeObjectRef = const (castRef <$> valMakeNull)

518+

519+

501

520