e56d776 · jsaddle · git.iko.soy

git.iko.soy/jsaddle

Remove support for using C ffi with GHCJS

e56d776Hamish Mackenzie11 years ago

.travis.yml+2−1

@@ -12,10 +12,11 @@ matrix:

12 addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}}

13 - env: CABALVER=1.22 GHCVER=7.10.2

14 addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}}

15+ - env: CABALVER=1.22 GHCVER=7.10.3

16+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}}

15 - env: CABALVER=head GHCVER=head

17 - env: CABALVER=head GHCVER=head

16 addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}}

18 addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}}

17 allow_failures:

19 allow_failures:

18− - env: CABALVER=1.22 GHCVER=7.10.2

19 - env: CABALVER=head GHCVER=head

20 - env: CABALVER=head GHCVER=head

21before_install:

22before_install:

jsaddle.cabal+13−32

@@ -21,25 +21,13 @@ flag gtk3

21 description:

22 Use GTK3 rather than GTK2

24−flag jsffi

25− description:

26− Use JavaScriptFFI extension for GHCJS JavaScript output

27−

28−flag webkit

29− description:

30− Use WebKitGtk and JavaScriptCore for GHCJS output

31− default: False

32−

33library

24library

35− if (impl(ghcjs -any) && flag(jsffi))

26+ if impl(ghcjs -any)

36 build-depends:

27 build-depends:

37 ghcjs-base -any,

28 ghcjs-base -any,

38 ghcjs-prim -any

29 ghcjs-prim -any

39− cpp-options: -DUSE_JAVASCRIPTFFI

30+ else

40−

41− if (!impl(ghcjs -any) || flag(webkit))

42−

43 if flag(gtk3)

31 if flag(gtk3)

44 build-depends:

32 build-depends:

45 gtk3 >=0.14.2 && <0.15,

33 gtk3 >=0.14.2 && <0.15,

@@ -50,7 +38,8 @@ library

50 gtk >=0.14.2 && <0.15,

38 gtk >=0.14.2 && <0.15,

51 webkit >=0.13.0.0 && <0.15,

39 webkit >=0.13.0.0 && <0.15,

52 webkit-javascriptcore >=0.13.0.0 && <0.14

40 webkit-javascriptcore >=0.13.0.0 && <0.14

53− cpp-options: -DUSE_WEBKIT

41+ build-depends:

42+ glib -any

54 exposed-modules:

43 exposed-modules:

55 Language.Javascript.JSaddle

44 Language.Javascript.JSaddle

56 Language.Javascript.JSaddle.Arguments

45 Language.Javascript.JSaddle.Arguments

@@ -64,6 +53,7 @@ library

64 Language.Javascript.JSaddle.String

53 Language.Javascript.JSaddle.String

65 Language.Javascript.JSaddle.Value

54 Language.Javascript.JSaddle.Value

66 Language.Javascript.JSaddle.Types

55 Language.Javascript.JSaddle.Types

56+ Language.Javascript.JSaddle.Test

67 build-depends:

57 build-depends:

68 template-haskell -any,

58 template-haskell -any,

69 base <5,

59 base <5,

@@ -76,17 +66,9 @@ library

77test-suite test-tool

67test-suite test-tool

79− if (impl(ghcjs -any) && !flag(webkit))

69+ if impl(ghcjs -any)

80 buildable: False

70 buildable: False

81−

71+ else

82− if (impl(ghcjs -any) && flag(jsffi))

83− build-depends:

84− ghcjs-base -any,

85− ghcjs-prim -any

86− cpp-options: -DUSE_JAVASCRIPTFFI

87−

88− if (!impl(ghcjs -any) || flag(webkit))

89−

90 if flag(gtk3)

72 if flag(gtk3)

91 build-depends:

73 build-depends:

92 gtk3 -any,

74 gtk3 -any,

@@ -99,16 +81,15 @@ test-suite test-tool

99 webkit-javascriptcore -any

81 webkit-javascriptcore -any

100 build-depends:

82 build-depends:

101 glib -any

83 glib -any

102− cpp-options: -DUSE_WEBKIT

103 type: exitcode-stdio-1.0

84 type: exitcode-stdio-1.0

104− main-is: TestJSaddle.hs

85+ main-is: DocTest.hs

105 build-depends:

86 build-depends:

106− template-haskell -any,

87+ QuickCheck -any,

107 base -any,

88 base -any,

108− lens -any,

89+ doctest -any,

90+ vector >=0.11.0.0 && <0.12,

109− text -any,

91+ text >=0.11.2.3 && <1.3,

110− transformers -any,

111− hslogger -any,

112 jsaddle -any

92 jsaddle -any

113 default-language: Haskell2010

93 default-language: Haskell2010

114 hs-source-dirs: tests

94 hs-source-dirs: tests

95+ ghc-options: -ferror-spans

src/Language/Javascript/JSaddle/Evaluate.hs+11−6

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

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE FlexibleInstances #-}

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

3+#ifdef ghcjs_HOST_OS

4{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}

5#endif

6-----------------------------------------------------------------------------

@@ -24,7 +24,7 @@ module Language.Javascript.JSaddle.Evaluate (

24import Control.Monad.Trans.Reader (ask)

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

26import Language.Javascript.JSaddle.Types (JSVal)

27−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

27+#ifdef ghcjs_HOST_OS

28import GHCJS.Types (nullRef)

29import GHCJS.Marshal.Pure (pFromJSVal)

30import Language.Javascript.JSaddle.Types (JSString)

@@ -41,6 +41,13 @@ import Language.Javascript.JSaddle.Classes

41 (MakeObject(..), ToJSString(..))

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

44+-- $setup

45+-- >>> import Language.Javascript.JSaddle.Test (testJSaddle)

46+-- >>> import Language.Javascript.JSaddle.Value (valToText)

47+-- >>> import Language.Javascript.JSaddle.Object (global, array, (!))

48+-- >>> import Language.Javascript.JSaddle.Monad (catch)

49+-- >>> import Language.Javascript.JSaddle.Exception (JSException(..))

50+

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

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

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

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

46--

53--

@@ -52,12 +59,12 @@ evaluateScript :: (ToJSString script, MakeObject this, ToJSString url)

52 -> url

59 -> url

53 -> Int -- ^ The Line number of the first line of the script

60 -> Int -- ^ The Line number of the first line of the script

54 -> JSM JSVal

61 -> JSM JSVal

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

62+#ifdef ghcjs_HOST_OS

56evaluateScript script this url line = liftIO $ js_eval (toJSString script)

63evaluateScript script this url line = liftIO $ js_eval (toJSString script)

57{-# INLINE evaluateScript #-}

64{-# INLINE evaluateScript #-}

58foreign import javascript unsafe "$r = eval($1);"

65foreign import javascript unsafe "$r = eval($1);"

59 js_eval :: JSString -> IO JSVal

66 js_eval :: JSString -> IO JSVal

60−#elif defined(USE_WEBKIT)

67+#else

61evaluateScript script this url line = do

68evaluateScript script this url line = do

62 gctxt <- ask

69 gctxt <- ask

63 rthis <- makeObject this

70 rthis <- makeObject this

@@ -68,8 +75,6 @@ evaluateScript script this url line = do

68 rethrow $ liftIO . jsevaluatescript gctxt script' this' url' line

75 rethrow $ liftIO . jsevaluatescript gctxt script' this' url' line

69 makeNewJSVal result

76 makeNewJSVal result

70{-# INLINE evaluateScript #-}

77{-# INLINE evaluateScript #-}

71−#else

72−evaluateScript = undefined

73#endif

78#endif

75-- | Evaluates a script (like eval in java script)

80-- | Evaluates a script (like eval in java script)

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

@@ -34,7 +34,7 @@ import Control.Monad.Trans.Reader (runReaderT, ask, ReaderT(..))

34import Language.Javascript.JSaddle.Types

35 (JSM, JSVal, MutableJSArray, JSContextRef)

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

37−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

37+#ifdef ghcjs_HOST_OS

38import GHCJS.Types (isUndefined, isNull)

39import qualified JavaScript.Array as Array (create, read)

40#else

@@ -77,7 +77,7 @@ bracket aquire release f = do

77-- to throw exceptions.

78catchval :: (MutableJSArray -> JSM a) -> (JSVal -> JSM a) -> JSM a

79catchval f catcher = do

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

80+#ifdef ghcjs_HOST_OS

81 pexc <- liftIO Array.create

82 result <- f pexc

83 exc <- liftIO $ Array.read 0 pexc

@@ -95,7 +95,7 @@ catchval f catcher = do

95 else makeNewJSVal exc >>= catcher

96#endif

98−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

98+#ifdef ghcjs_HOST_OS

99runJSaddle :: w -> JSM a -> IO a

100runJSaddle _ f = runReaderT f ()

101#else

@@ -107,7 +107,7 @@ runJSaddle webView f = do

107{-# INLINE runJSaddle #-}

108

109postGUIAsyncJS :: JSM () -> JSM ()

110−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

110+#ifdef ghcjs_HOST_OS

111postGUIAsyncJS = id

112#else

113postGUIAsyncJS f = do

@@ -117,7 +117,7 @@ postGUIAsyncJS f = do

117{-# INLINE postGUIAsyncJS #-}

118

119postGUISyncJS :: JSM a -> JSM a

120−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

120+#ifdef ghcjs_HOST_OS

121postGUISyncJS = id

122#else

123postGUISyncJS f = do

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

@@ -12,7 +12,7 @@

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

14module Language.Javascript.JSaddle.Native (

15−#if !defined(ghcjs_HOST_OS) || !defined(USE_JAVASCRIPTFFI)

15+#if !defined(ghcjs_HOST_OS)

16 makeNewJSVal

17 , makeNewJSString

18 , wrapJSString

@@ -24,7 +24,7 @@ module Language.Javascript.JSaddle.Native (

24#endif

25) where

27−#if !defined(ghcjs_HOST_OS) || !defined(USE_JAVASCRIPTFFI)

27+#if !defined(ghcjs_HOST_OS)

28import Control.Monad.Trans.Reader (ask)

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

30 (JSObjectRef, OpaqueJSString, JSStringRef, OpaqueJSContext,

src/Language/Javascript/JSaddle/Object.hs+33−36

@@ -3,7 +3,7 @@

3{-# LANGUAGE TypeSynonymInstances #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE Rank2Types #-}

6−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

6+#ifdef ghcjs_HOST_OS

7{-# LANGUAGE ForeignFunctionInterface #-}

8{-# LANGUAGE JavaScriptFFI #-}

9#endif

@@ -94,7 +94,7 @@ import Language.Javascript.JSaddle.Types

94 (JSPropertyNameArray, JSString, Object(..), MutableJSArray,

95 JSVal, Index)

96import Foreign.C.Types (CSize(..), CULong(..))

97−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

97+#ifdef ghcjs_HOST_OS

98import GHCJS.Types (nullRef, jsval)

99import GHCJS.Foreign.Callback

100 (releaseCallback, syncCallback2, OnBlocked(..), Callback)

@@ -144,7 +144,13 @@ import Control.Lens (IndexPreservingGetter, to)

144import Language.Javascript.JSaddle.String (nullJSString)

145import Data.Text (Text)

146

147+-- $setup

148+-- >>> import Language.Javascript.JSaddle.Test (testJSaddle)

149+-- >>> import Language.Javascript.JSaddle.Evaluate (eval)

150+-- >>> import Language.Javascript.JSaddle.Value (val)

151+-- >>> import Control.Lens.Operators ((^.))

152+

147−-- | Object can be made by evaluating a function in 'JSM' as long

153+-- | Object can be made by evaluating a fnction in 'JSM' as long

148-- as it returns something we can make into a Object.

154-- as it returns something we can make into a Object.

149instance MakeObject v => MakeObject (JSM v) where

155instance MakeObject v => MakeObject (JSM v) where

150 makeObject v = v >>= makeObject

156 makeObject v = v >>= makeObject

@@ -279,7 +285,8 @@ jsg name = global ! name

279--

285--

280-- > jsgf name = jsg name . to (# args)

286-- > jsgf name = jsg name . to (# args)

281--

287--

288+-- >>> testJSaddle $ eval "globalFunc = function(x) {x.length}"

282−-- >>> testJSaddle $ jsf "globalFunc" ["World"]

289+-- >>> testJSaddle $ jsgf "globalFunc" ["World"]

283-- 6

290-- 6

284jsgf :: (ToJSString name, MakeArgs args) => name -> args -> JSM JSVal

291jsgf :: (ToJSString name, MakeArgs args) => name -> args -> JSM JSVal

285jsgf name = global # name

292jsgf name = global # name

@@ -289,7 +296,7 @@ jsgf name = global # name

289--

296--

290-- > jsg0 name = jsgf name ()

297-- > jsg0 name = jsgf name ()

291--

298--

292−-- >>> testJSaddle $ js0 "globalFunc"

299+-- >>> testJSaddle $ jsg0 "globalFunc"

293-- hello world

300-- hello world

294jsg0 :: (ToJSString name) => name -> JSM JSVal

301jsg0 :: (ToJSString name) => name -> JSM JSVal

295jsg0 name = jsgf name ()

302jsg0 name = jsgf name ()

@@ -396,7 +403,7 @@ infixr 1 <##

396-- If you pass more than 7 arguments to a constructor for a built in

403-- If you pass more than 7 arguments to a constructor for a built in

397-- JavaScript type (like Date) then this function will fail.

404-- JavaScript type (like Date) then this function will fail.

398--

405--

399−-- >>> testJSaddle $ new "Date" (2013, 1, 1)

406+-- >>> testJSaddle $ new (jsg "Date") (2013, 1, 1)

400-- Fri Feb 01 2013 00:00:00 GMT+1300 (NZDT)

407-- Fri Feb 01 2013 00:00:00 GMT+1300 (NZDT)

401new :: (MakeObject constructor, MakeArgs args)

408new :: (MakeObject constructor, MakeArgs args)

402 => constructor

409 => constructor

@@ -426,12 +433,12 @@ call f this args = do

426-- >>> testJSaddle $ do { a <- obj; a ^. js "x" <# "Hello"; a ^. js "x" }

433-- >>> testJSaddle $ do { a <- obj; a ^. js "x" <# "Hello"; a ^. js "x" }

427-- Hello

434-- Hello

428obj :: JSM Object

435obj :: JSM Object

429−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

436+#ifdef ghcjs_HOST_OS

430obj = liftIO Object.create

437obj = liftIO Object.create

431#else

438#else

432obj = do

439obj = do

433 gctxt <- ask

440 gctxt <- ask

434− Object <$> ((liftIO $ jsobjectmake gctxt nullPtr nullPtr) >>= makeNewJSVal)

441+ Object <$> (liftIO (jsobjectmake gctxt nullPtr nullPtr) >>= makeNewJSVal)

435#endif

442#endif

436{-# INLINE obj #-}

443{-# INLINE obj #-}

437

444

@@ -456,12 +463,12 @@ fun :: JSCallAsFunction -> JSCallAsFunction

456fun = id

463fun = id

457{-# INLINE fun #-}

464{-# INLINE fun #-}

458

465

459−#if (!defined(ghcjs_HOST_OS) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)

466+#if !defined(ghcjs_HOST_OS)

460foreign import ccall "wrapper"

467foreign import ccall "wrapper"

461 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback

468 mkJSObjectCallAsFunctionCallback :: JSObjectCallAsFunctionCallback' -> IO JSObjectCallAsFunctionCallback

462#endif

469#endif

463

470

464−#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI) || !defined(USE_WEBKIT)

471+#ifdef ghcjs_HOST_OS

465type HaskellCallback = Callback (JSVal -> JSVal -> IO ())

472type HaskellCallback = Callback (JSVal -> JSVal -> IO ())

466#else

473#else

467type HaskellCallback = JSObjectCallAsFunctionCallback

474type HaskellCallback = JSObjectCallAsFunctionCallback

@@ -475,7 +482,7 @@ function :: ToJSString name

475 -> JSCallAsFunction -- ^ Haskell function to call

482 -> JSCallAsFunction -- ^ Haskell function to call

476 -> JSM Function -- ^ Returns a JavaScript function object that will

483 -> JSM Function -- ^ Returns a JavaScript function object that will

477 -- call the Haskell one when it is called

484 -- call the Haskell one when it is called

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

485+#ifdef ghcjs_HOST_OS

479function name f = liftIO $ do

486function name f = liftIO $ do

480 callback <- syncCallback2 ContinueAsync $ \this args -> do

487 callback <- syncCallback2 ContinueAsync $ \this args -> do

481 rargs <- Array.toListIO (coerce args)

488 rargs <- Array.toListIO (coerce args)

@@ -483,13 +490,13 @@ function name f = liftIO $ do

483 Function callback <$> makeFunctionWithCallback (toJSString name) callback

490 Function callback <$> makeFunctionWithCallback (toJSString name) callback

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

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

485 makeFunctionWithCallback :: JSString -> Callback (JSVal -> JSVal -> IO ()) -> IO Object

492 makeFunctionWithCallback :: JSString -> Callback (JSVal -> JSVal -> IO ()) -> IO Object

486−#elif defined(USE_WEBKIT)

493+#else

487function name f = do

494function name f = do

488 gctxt <- ask

495 gctxt <- ask

489 callback <- liftIO $ mkJSObjectCallAsFunctionCallback (wrap gctxt)

496 callback <- liftIO $ mkJSObjectCallAsFunctionCallback (wrap gctxt)

490 withJSString (toJSString name) $ \name' ->

497 withJSString (toJSString name) $ \name' ->

491 Function callback . Object <$>

498 Function callback . Object <$>

492− ((liftIO $ jsobjectmakefunctionwithcallback gctxt name' callback) >>= makeNewJSVal)

499+ (liftIO (jsobjectmakefunctionwithcallback gctxt name' callback) >>= makeNewJSVal)

493 where

500 where

494 wrap gctxt _ctx fobj' this' argc argv exception = do

501 wrap gctxt _ctx fobj' this' argc argv exception = do

495 args' <- peekArray (fromIntegral argc) argv

502 args' <- peekArray (fromIntegral argc) argv

@@ -499,17 +506,15 @@ function name f = do

499 args <- mapM makeNewJSVal args'

506 args <- mapM makeNewJSVal args'

500 f fobj this args

507 f fobj this args

501 liftIO $ jsvaluemakeundefined gctxt

508 liftIO $ jsvaluemakeundefined gctxt

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

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

503 (`runReaderT` gctxt) $ do

510 (`runReaderT` gctxt) $ do

504 withToJSVal (show e) $ liftIO . poke exception

511 withToJSVal (show e) $ liftIO . poke exception

505 liftIO $ jsvaluemakeundefined gctxt

512 liftIO $ jsvaluemakeundefined gctxt

506−#else

507−function = undefined

508#endif

513#endif

509

514

510freeFunction :: MonadIO m => Function -> m ()

515freeFunction :: MonadIO m => Function -> m ()

511freeFunction (Function callback _) = liftIO $

516freeFunction (Function callback _) = liftIO $

512−#if defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI) || !defined(USE_WEBKIT)

517+#ifdef ghcjs_HOST_OS

513 releaseCallback callback

518 releaseCallback callback

514#else

519#else

515 freeHaskellFunPtr callback

520 freeHaskellFunPtr callback

@@ -533,7 +538,7 @@ instance MakeArgs JSCallAsFunction where

533 {-# INLINE makeArgs #-}

538 {-# INLINE makeArgs #-}

534

539

535makeArray :: MakeArgs args => args -> MutableJSArray -> JSM Object

540makeArray :: MakeArgs args => args -> MutableJSArray -> JSM Object

536−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

541+#ifdef ghcjs_HOST_OS

537makeArray args exceptions = do

542makeArray args exceptions = do

538 rargs <- makeArgs args

543 rargs <- makeArgs args

539 liftIO $ Object . jsval <$> Array.fromListIO rargs

544 liftIO $ Object . jsval <$> Array.fromListIO rargs

@@ -599,23 +604,21 @@ instance ToJSVal [Bool] where

599

604

600-- | JavaScript's global object

605-- | JavaScript's global object

601global :: JSM Object

606global :: JSM Object

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

607+#ifdef ghcjs_HOST_OS

603global = liftIO js_window

608global = liftIO js_window

604{-# INLINE global #-}

609{-# INLINE global #-}

605foreign import javascript unsafe "$r = window"

610foreign import javascript unsafe "$r = window"

606 js_window :: IO Object

611 js_window :: IO Object

607−#elif defined(USE_WEBKIT)

612+#else

608global = do

613global = do

609 gctxt <- ask

614 gctxt <- ask

610 result <- liftIO $ jscontextgetglobalobject gctxt

615 result <- liftIO $ jscontextgetglobalobject gctxt

611 Object <$> makeNewJSVal result

616 Object <$> makeNewJSVal result

612{-# INLINE global #-}

617{-# INLINE global #-}

613−#else

614−global = undefined

615#endif

618#endif

616

619

617-- | Get an array containing the property names present on a given object

620-- | Get an array containing the property names present on a given object

618−#if (!defined(ghcjs_HOST_OS) || !defined(USE_JAVASCRIPTFFI)) && defined(USE_WEBKIT)

621+#if !defined(ghcjs_HOST_OS)

619copyPropertyNames :: MakeObject this => this -> JSM JSPropertyNameArray

622copyPropertyNames :: MakeObject this => this -> JSM JSPropertyNameArray

620copyPropertyNames this = do

623copyPropertyNames this = do

621 gctxt <- ask

624 gctxt <- ask

@@ -644,16 +647,14 @@ propertyNamesList names = do

644

647

645-- | Get a list containing the property names present on a given object

648-- | Get a list containing the property names present on a given object

646propertyNames :: MakeObject this => this -> JSM [JSString]

649propertyNames :: MakeObject this => this -> JSM [JSString]

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

650+#ifdef ghcjs_HOST_OS

648propertyNames this = makeObject this >>= liftIO . js_propertyNames >>= liftIO . (fmap (map pFromJSVal)) . Array.toListIO

651propertyNames this = makeObject this >>= liftIO . js_propertyNames >>= liftIO . (fmap (map pFromJSVal)) . Array.toListIO

649{-# INLINE propertyNames #-}

652{-# INLINE propertyNames #-}

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

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

651 js_propertyNames :: Object -> IO JSArray

654 js_propertyNames :: Object -> IO JSArray

652−#elif defined(USE_WEBKIT)

655+#else

653propertyNames this = copyPropertyNames this >>= propertyNamesList

656propertyNames this = copyPropertyNames this >>= propertyNamesList

654{-# INLINE propertyNames #-}

657{-# INLINE propertyNames #-}

655−#else

656−propertyNames = undefined

657#endif

658#endif

658

659

659-- | Get a list containing references to all the properties present on a given object

660-- | Get a list containing references to all the properties present on a given object

@@ -667,14 +668,14 @@ objCallAsFunction :: MakeArgs args

667 -> args

668 -> args

668 -> MutableJSArray

669 -> MutableJSArray

669 -> JSM JSVal

670 -> JSM JSVal

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

671+#ifdef ghcjs_HOST_OS

671objCallAsFunction f this args exceptions = do

672objCallAsFunction f this args exceptions = do

672 rargs <- makeArgs args >>= liftIO . Array.fromListIO

673 rargs <- makeArgs args >>= liftIO . Array.fromListIO

673 liftIO $ js_apply f this rargs exceptions

674 liftIO $ js_apply f this rargs exceptions

674{-# INLINE objCallAsFunction #-}

675{-# INLINE objCallAsFunction #-}

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

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

676 js_apply :: Object -> Object -> MutableJSArray -> MutableJSArray -> IO JSVal

677 js_apply :: Object -> Object -> MutableJSArray -> MutableJSArray -> IO JSVal

677−#elif defined(USE_WEBKIT)

678+#else

678objCallAsFunction f this args exceptions = do

679objCallAsFunction f this args exceptions = do

679 gctxt <- ask

680 gctxt <- ask

680 rargs <- makeArgs args

681 rargs <- makeArgs args

@@ -686,8 +687,6 @@ objCallAsFunction f this args exceptions = do

686 jsobjectcallasfunction gctxt rfunction rthis (fromIntegral largs) pargs exceptions

687 jsobjectcallasfunction gctxt rfunction rthis (fromIntegral largs) pargs exceptions

687 makeNewJSVal result

688 makeNewJSVal result

688{-# INLINE objCallAsFunction #-}

689{-# INLINE objCallAsFunction #-}

689−#else

690−objCallAsFunction = undefined

691#endif

690#endif

692

691

693-- | Call a JavaScript object as a constructor. Consider using 'new'.

692-- | Call a JavaScript object as a constructor. Consider using 'new'.

@@ -699,7 +698,7 @@ objCallAsConstructor :: MakeArgs args

699 -> args

698 -> args

700 -> MutableJSArray

699 -> MutableJSArray

701 -> JSM JSVal

700 -> JSM JSVal

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

701+#ifdef ghcjs_HOST_OS

703objCallAsConstructor f args exceptions = do

702objCallAsConstructor f args exceptions = do

704 rargs <- makeArgs args >>= liftIO . Array.fromListIO

703 rargs <- makeArgs args >>= liftIO . Array.fromListIO

705 liftIO $ js_new f rargs exceptions

704 liftIO $ js_new f rargs exceptions

@@ -731,7 +730,7 @@ foreign import javascript unsafe "\

731 $3[0] = e;\

730 $3[0] = e;\

732 }"

731 }"

733 js_new :: Object -> MutableJSArray -> MutableJSArray -> IO JSVal

732 js_new :: Object -> MutableJSArray -> MutableJSArray -> IO JSVal

734−#elif defined(USE_WEBKIT)

733+#else

735objCallAsConstructor f args exceptions = do

734objCallAsConstructor f args exceptions = do

736 gctxt <- ask

735 gctxt <- ask

737 rargs <- makeArgs args

736 rargs <- makeArgs args

@@ -741,12 +740,10 @@ objCallAsConstructor f args exceptions = do

741 liftIO $ withArrayLen rargs' $ \ largs pargs ->

740 liftIO $ withArrayLen rargs' $ \ largs pargs ->

742 jsobjectcallasconstructor gctxt rfunction (fromIntegral largs) pargs exceptions

741 jsobjectcallasconstructor gctxt rfunction (fromIntegral largs) pargs exceptions

743 makeNewJSVal result

742 makeNewJSVal result

744−#else

745−objCallAsConstructor = undefined

746#endif

743#endif

747

744

748nullObject :: Object

745nullObject :: Object

749−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

746+#ifdef ghcjs_HOST_OS

750nullObject = Object nullRef

747nullObject = Object nullRef

751#else

748#else

752nullObject = Object . unsafePerformIO $ newForeignPtr_ nullPtr

749nullObject = Object . unsafePerformIO $ newForeignPtr_ nullPtr

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

@@ -1,7 +1,7 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE TypeSynonymInstances #-}

4−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

4+#ifdef ghcjs_HOST_OS

5{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}

6#endif

7-----------------------------------------------------------------------------

@@ -35,7 +35,7 @@ import Language.Javascript.JSaddle.Monad (JSM)

35import Language.Javascript.JSaddle.Types

36 (MutableJSArray, Object(..), JSPropertyAttributes,

37 Index)

38−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

38+#ifdef ghcjs_HOST_OS

39import Language.Javascript.JSaddle.Types (JSString)

40#else

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

@@ -56,7 +56,7 @@ objGetPropertyByName :: ToJSString name

56 -> name -- ^ name of the property.

57 -> MutableJSArray -- ^ exception if one is raised.

58 -> JSM JSVal -- ^ returns the property value.

59−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

59+#ifdef ghcjs_HOST_OS

60objGetPropertyByName this name = liftIO . js_tryGetProp (toJSString name) this

61{-# INLINE objGetPropertyByName #-}

62foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"

@@ -75,7 +75,7 @@ objGetPropertyAtIndex :: Object -- ^ object to find the property on.

75 -> Index -- ^ index of the property.

76 -> MutableJSArray -- ^ exception if one is raised.

77 -> JSM JSVal -- ^ returns the property value.

78−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

78+#ifdef ghcjs_HOST_OS

79objGetPropertyAtIndex this index = liftIO . js_tryIndex index this

80{-# INLINE objGetPropertyAtIndex #-}

81foreign import javascript unsafe "try { $r=$2[$1] } catch(e) { $3[0] = e }"

@@ -96,7 +96,7 @@ objSetPropertyByName :: (ToJSString name, ToJSVal val)

96 -> JSPropertyAttributes -- ^ property attributes to give the property.

97 -> MutableJSArray -- ^ exception if one is raised.

98 -> JSM ()

99−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

99+#ifdef ghcjs_HOST_OS

100objSetPropertyByName this name val attributes exceptions = do

101 vref <- toJSVal val

102 liftIO $ js_trySetProp (toJSString name) this vref exceptions

@@ -120,7 +120,7 @@ objSetPropertyAtIndex :: (ToJSVal val)

120 -> val -- ^ new value to set the property to.

121 -> MutableJSArray -- ^ exception if one is raised.

122 -> JSM ()

123−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

123+#ifdef ghcjs_HOST_OS

124objSetPropertyAtIndex this index val exceptions = do

125 vref <- toJSVal val

126 liftIO $ js_trySetAtIndex index this vref exceptions

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

@@ -26,7 +26,7 @@ module Language.Javascript.JSaddle.String (

26import Data.Text (Text)

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

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

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

29+#ifdef ghcjs_HOST_OS

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

31import GHCJS.Marshal.Internal (PFromJSVal(..))

32import GHCJS.Types (nullRef)

@@ -46,7 +46,7 @@ import Language.Javascript.JSaddle.Classes (ToJSString(..))

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

48strToText :: MonadIO m => JSString -> m Text

49−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

49+#ifdef ghcjs_HOST_OS

50strToText = return . textFromJSString

51#else

52strToText jsstring' = liftIO $ withJSString jsstring' $ \jsstring -> do

@@ -58,7 +58,7 @@ strToText jsstring' = liftIO $ withJSString jsstring' $ \jsstring -> do

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

60textToStr :: Text -> JSString

61−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

61+#ifdef ghcjs_HOST_OS

62textToStr = textToJSString

63#else

64textToStr text = unsafePerformIO $

@@ -68,7 +68,7 @@ textToStr text = unsafePerformIO $

68{-# INLINE textToStr #-}

70nullJSString :: JSString

71−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

71+#ifdef ghcjs_HOST_OS

72nullJSString = pFromJSVal nullRef

73#else

74nullJSString = unsafePerformIO $ newForeignPtr_ nullPtr

tests/TestJSaddle.hs → src/Language/Javascript/JSaddle/Test.hsrenamed+3−11

@@ -11,8 +11,8 @@

11--

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

14−module Main (

14+module Language.Javascript.JSaddle.Test (

15− main

15+ testJSaddle

16 , showJSaddle

17 , listWindowProperties

18) where

@@ -38,7 +38,6 @@ import Language.Javascript.JSaddle

38import qualified Data.Text as T

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

40import Control.Monad (forM, when)

41−import System.Log.Logger (debugM)

42import Control.Lens.Getter ((^.))

41import Control.Lens.Getter ((^.))

43import Data.Monoid ((<>))

42import Data.Monoid ((<>))

44import Control.Concurrent.MVar (MVar)

43import Control.Concurrent.MVar (MVar)

@@ -62,7 +61,7 @@ showJSaddle :: ToJSVal val => JSM val -> IO ()

62showJSaddle = testJSaddle' True

61showJSaddle = testJSaddle' True

64debugLog :: String -> IO ()

63debugLog :: String -> IO ()

65−debugLog = debugM "jsaddle"

64+debugLog = putStrLn

67testJSaddle' :: ToJSVal val => Bool -> JSM val -> IO ()

66testJSaddle' :: ToJSVal val => Bool -> JSM val -> IO ()

68testJSaddle' showWindow f = do

67testJSaddle' showWindow f = do

@@ -118,13 +117,6 @@ testJSaddle' showWindow f = do

118 putMVar state $ Just TestState {..}

117 putMVar state $ Just TestState {..}

119 return x

118 return x

120

119

121−main :: IO ()

122−main = do

123− testJSaddle $ return ()

124− Just TestState{..} <- takeMVar state

125− postGUIAsync $ widgetDestroy window

126− takeMVar done

127−

128listWindowProperties :: IO ()

120listWindowProperties :: IO ()

129listWindowProperties = testJSaddle $ T.pack . show <$> do

121listWindowProperties = testJSaddle $ T.pack . show <$> do

130 window <- jsg "window"

122 window <- jsg "window"

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

@@ -26,7 +26,7 @@ module Language.Javascript.JSaddle.Types (

26) where

28import Control.Monad.Trans.Reader (ReaderT(..))

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

29+#ifdef ghcjs_HOST_OS

30import GHCJS.Types

31import JavaScript.Object.Internal (Object(..))

32import JavaScript.Array (MutableJSArray)

@@ -41,7 +41,7 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef (JSPropertyAttributes)

41import Foreign.C (CUInt(..))

42#endif

44−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

44+#ifdef ghcjs_HOST_OS

45newtype JSPropertyNameArray = JSPropertyNameArray { unJSPropertyNameArrayRef :: JSVal }

46type JSPropertyAttributes = Word

47type JSContextRef = ()

src/Language/Javascript/JSaddle/Value.hs+59−51

@@ -3,7 +3,7 @@

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE TypeSynonymInstances #-}

5{-# LANGUAGE LambdaCase #-}

6−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

6+#ifdef ghcjs_HOST_OS

7{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}

8#endif

9{-# OPTIONS_GHC -fno-warn-orphans #-}

@@ -41,6 +41,7 @@ module Language.Javascript.JSaddle.Value (

41 , JSUndefined

42 , JSString

43 , JSValue(..)

44+ , showJSValue

45 -- * Converting JavaScript values

46 -- * Converting JavaScript values

46 , valToBool

47 , valToBool

@@ -69,10 +70,11 @@ module Language.Javascript.JSaddle.Value (

69 , instanceOf

70 , instanceOf

70) where

71) where

73+import Control.Applicative ((<$>))

72import Prelude hiding (catch)

74import Prelude hiding (catch)

73import Language.Javascript.JSaddle.Types

75import Language.Javascript.JSaddle.Types

74 (Object(..), JSString, JSVal)

76 (Object(..), JSString, JSVal)

75−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

77+#ifdef ghcjs_HOST_OS

76import Language.Javascript.JSaddle.Types

78import Language.Javascript.JSaddle.Types

77 (MutableJSArray)

79 (MutableJSArray)

78import GHCJS.Types (JSVal(..), isNull, isUndefined)

80import GHCJS.Types (JSVal(..), isNull, isUndefined)

@@ -102,9 +104,14 @@ import Language.Javascript.JSaddle.Classes

102 (MakeObject(..), ToJSString(..), ToJSVal(..))

104 (MakeObject(..), ToJSString(..), ToJSVal(..))

103import Language.Javascript.JSaddle.String (strToText, textToStr)

105import Language.Javascript.JSaddle.String (strToText, textToStr)

104import Language.Javascript.JSaddle.Arguments (MakeArgs(..))

106import Language.Javascript.JSaddle.Arguments (MakeArgs(..))

105−import Data.Word (Word32, Word64)

107+import Data.Word (Word32, Word, Word64)

106import Data.Int (Int32, Int64)

108import Data.Int (Int32, Int64)

107

109

110+-- $setup

111+-- >>> import Language.Javascript.JSaddle.Test (testJSaddle)

112+-- >>> import Language.Javascript.JSaddle.Monad (catch)

113+-- >>> import Language.Javascript.JSaddle.Exception (JSException(..))

114+

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

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

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

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

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

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

@@ -122,7 +129,16 @@ data JSValue = ValNull -- ^ null

122 | ValNumber Double -- ^ a number

129 | ValNumber Double -- ^ a number

123 | ValString Text -- ^ a string

130 | ValString Text -- ^ a string

124 | ValObject Object -- ^ an object

131 | ValObject Object -- ^ an object

125−-- deriving(Show, Eq)

132+

133+-- | Show a JSValue but just say "object" if the value is a JavaScript object.

134+showJSValue :: JSValue -> String

135+showJSValue ValNull = "null"

136+showJSValue ValUndefined = "undefined"

137+showJSValue (ValBool True) = "true"

138+showJSValue (ValBool False) = "false"

139+showJSValue (ValNumber x) = show x

140+showJSValue (ValString s) = show s

141+showJSValue (ValObject _) = "object"

126

142

127-- | Given a JavaScript value get its boolean value.

143-- | Given a JavaScript value get its boolean value.

128-- All values in JavaScript convert to bool.

144-- All values in JavaScript convert to bool.

@@ -144,7 +160,7 @@ data JSValue = ValNull -- ^ null

144-- >>> testJSaddle $ valToBool "1"

160-- >>> testJSaddle $ valToBool "1"

145-- true

161-- true

146valToBool :: ToJSVal value => value -> JSM Bool

162valToBool :: ToJSVal value => value -> JSM Bool

147−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

163+#ifdef ghcjs_HOST_OS

148valToBool value = isTruthy <$> toJSVal value

164valToBool value = isTruthy <$> toJSVal value

149#else

165#else

150valToBool value = do

166valToBool value = do

@@ -174,18 +190,16 @@ valToBool value = do

174-- >>> testJSaddle $ show <$> valToNumber "1"

190-- >>> testJSaddle $ show <$> valToNumber "1"

175-- 1.0

191-- 1.0

176valToNumber :: ToJSVal value => value -> JSM Double

192valToNumber :: ToJSVal value => value -> JSM Double

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

193+#ifdef ghcjs_HOST_OS

178valToNumber value = jsrefToNumber <$> toJSVal value

194valToNumber value = jsrefToNumber <$> toJSVal value

179{-# INLINE valToNumber #-}

195{-# INLINE valToNumber #-}

180foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSVal -> Double

196foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSVal -> Double

181−#elif defined(USE_WEBKIT)

197+#else

182valToNumber value = do

198valToNumber value = do

183 gctxt <- ask

199 gctxt <- ask

184 withToJSVal value $ \rval ->

200 withToJSVal value $ \rval ->

185 rethrow $ liftIO . jsvaluetonumber gctxt rval

201 rethrow $ liftIO . jsvaluetonumber gctxt rval

186{-# INLINE valToNumber #-}

202{-# INLINE valToNumber #-}

187−#else

188−valToNumber = undefined

189#endif

203#endif

190

204

191-- | Given a JavaScript value get its string value (as a JavaScript string).

205-- | Given a JavaScript value get its string value (as a JavaScript string).

@@ -208,18 +222,16 @@ valToNumber = undefined

208-- >>> testJSaddle $ valToStr "1" >>= strToText

222-- >>> testJSaddle $ valToStr "1" >>= strToText

209-- 1

223-- 1

210valToStr :: ToJSVal value => value -> JSM JSString

224valToStr :: ToJSVal value => value -> JSM JSString

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

225+#ifdef ghcjs_HOST_OS

212valToStr value = jsrefToString <$> toJSVal value

226valToStr value = jsrefToString <$> toJSVal value

213{-# INLINE valToStr #-}

227{-# INLINE valToStr #-}

214foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSVal -> JSString

228foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSVal -> JSString

215−#elif defined(USE_WEBKIT)

229+#else

216valToStr value = do

230valToStr value = do

217 gctxt <- ask

231 gctxt <- ask

218 withToJSVal value $ \rval ->

232 withToJSVal value $ \rval ->

219− (rethrow $ liftIO . jsvaluetostringcopy gctxt rval) >>= wrapJSString

233+ rethrow (liftIO . jsvaluetostringcopy gctxt rval) >>= wrapJSString

220{-# INLINE valToStr #-}

234{-# INLINE valToStr #-}

221−#else

222−valToStr = undefined

223#endif

235#endif

224

236

225-- | Given a JavaScript value get its string value (as a Haskell 'Text').

237-- | Given a JavaScript value get its string value (as a Haskell 'Text').

@@ -267,18 +279,16 @@ valToText jsvar = valToStr jsvar >>= strToText

267-- >>> testJSaddle $ obj >>= valToJSON 0 >>= strToText

279-- >>> testJSaddle $ obj >>= valToJSON 0 >>= strToText

268-- {}

280-- {}

269valToJSON :: ToJSVal value => Word -> value -> JSM JSString

281valToJSON :: ToJSVal value => Word -> value -> JSM JSString

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

282+#ifdef ghcjs_HOST_OS

271valToJSON indent value = jsrefToJSON <$> toJSVal value

283valToJSON indent value = jsrefToJSON <$> toJSVal value

272{-# INLINE valToJSON #-}

284{-# INLINE valToJSON #-}

273foreign import javascript unsafe "$r = JSON.stringify($1);" jsrefToJSON :: JSVal -> JSString

285foreign import javascript unsafe "$r = JSON.stringify($1);" jsrefToJSON :: JSVal -> JSString

274−#elif defined(USE_WEBKIT)

286+#else

275valToJSON indent value = do

287valToJSON indent value = do

276 gctxt <- ask

288 gctxt <- ask

277 withToJSVal value $ \rval ->

289 withToJSVal value $ \rval ->

278− (rethrow $ liftIO . jsvaluecreatejsonstring gctxt rval (fromIntegral indent)) >>= wrapJSString

290+ rethrow (liftIO . jsvaluecreatejsonstring gctxt rval (fromIntegral indent)) >>= wrapJSString

279{-# INLINE valToJSON #-}

291{-# INLINE valToJSON #-}

280−#else

281−valToJSON = undefined

282#endif

292#endif

283

293

284-- | Given a JavaScript value get its object value.

294-- | Given a JavaScript value get its object value.

@@ -302,12 +312,12 @@ valToJSON = undefined

302-- 1

312-- 1

303valToObject :: ToJSVal value => value -> JSM Object

313valToObject :: ToJSVal value => value -> JSM Object

304valToObject value = Object <$>

314valToObject value = Object <$>

305−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

315+#ifdef ghcjs_HOST_OS

306 toJSVal value

316 toJSVal value

307#else

317#else

308 do gctxt <- ask

318 do gctxt <- ask

309 withToJSVal value $ \rval ->

319 withToJSVal value $ \rval ->

310− (rethrow $ liftIO . jsvaluetoobject gctxt rval) >>= makeNewJSVal

320+ rethrow (liftIO . jsvaluetoobject gctxt rval) >>= makeNewJSVal

311#endif

321#endif

312{-# INLINE valToObject #-}

322{-# INLINE valToObject #-}

313

323

@@ -341,7 +351,7 @@ instance ToJSVal v => ToJSVal (JSM v) where

341----------- null ---------------

351----------- null ---------------

342-- | Make a @null@ JavaScript value

352-- | Make a @null@ JavaScript value

343valMakeNull :: JSM JSVal

353valMakeNull :: JSM JSVal

344−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

354+#ifdef ghcjs_HOST_OS

345valMakeNull = return jsNull

355valMakeNull = return jsNull

346#else

356#else

347valMakeNull = ask >>= (liftIO . jsvaluemakenull) >>= makeNewJSVal

357valMakeNull = ask >>= (liftIO . jsvaluemakenull) >>= makeNewJSVal

@@ -366,7 +376,7 @@ instance ToJSVal a => ToJSVal (Maybe a) where

366

376

367-- | Test a JavaScript value to see if it is @null@

377-- | Test a JavaScript value to see if it is @null@

368valIsNull :: ToJSVal value => value -> JSM Bool

378valIsNull :: ToJSVal value => value -> JSM Bool

369−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

379+#ifdef ghcjs_HOST_OS

370valIsNull value = isNull <$> toJSVal value

380valIsNull value = isNull <$> toJSVal value

371#else

381#else

372valIsNull value = do

382valIsNull value = do

@@ -379,7 +389,7 @@ valIsNull value = do

379----------- undefined ---------------

389----------- undefined ---------------

380-- | Make an @undefined@ JavaScript value

390-- | Make an @undefined@ JavaScript value

381valMakeUndefined :: JSM JSVal

391valMakeUndefined :: JSM JSVal

382−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

392+#ifdef ghcjs_HOST_OS

383valMakeUndefined = return jsUndefined

393valMakeUndefined = return jsUndefined

384#else

394#else

385valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined) >>= makeNewJSVal

395valMakeUndefined = ask >>= (liftIO . jsvaluemakeundefined) >>= makeNewJSVal

@@ -403,7 +413,7 @@ instance MakeArgs () where

403

413

404-- | Test a JavaScript value to see if it is @undefined@

414-- | Test a JavaScript value to see if it is @undefined@

405valIsUndefined :: ToJSVal value => value -> JSM Bool

415valIsUndefined :: ToJSVal value => value -> JSM Bool

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

416+#ifdef ghcjs_HOST_OS

407valIsUndefined value = isUndefined <$> toJSVal value

417valIsUndefined value = isUndefined <$> toJSVal value

408#else

418#else

409valIsUndefined value = do

419valIsUndefined value = do

@@ -439,12 +449,12 @@ maybeNullOrUndefined' f value = do

439----------- booleans ---------------

449----------- booleans ---------------

440-- | Make a JavaScript boolean value

450-- | Make a JavaScript boolean value

441valMakeBool :: Bool -> JSM JSVal

451valMakeBool :: Bool -> JSM JSVal

442−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

452+#ifdef ghcjs_HOST_OS

443valMakeBool b = return $ toJSBool b

453valMakeBool b = return $ toJSBool b

444#else

454#else

445valMakeBool b = do

455valMakeBool b = do

446 gctxt <- ask

456 gctxt <- ask

447− (liftIO $ jsvaluemakeboolean gctxt b) >>= makeNewJSVal

457+ liftIO (jsvaluemakeboolean gctxt b) >>= makeNewJSVal

448#endif

458#endif

449{-# INLINE valMakeBool #-}

459{-# INLINE valMakeBool #-}

450

460

@@ -461,12 +471,12 @@ instance MakeArgs Bool where

461----------- numbers ---------------

471----------- numbers ---------------

462-- | Make a JavaScript number

472-- | Make a JavaScript number

463valMakeNumber :: Double -> JSM JSVal

473valMakeNumber :: Double -> JSM JSVal

464−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

474+#ifdef ghcjs_HOST_OS

465valMakeNumber n = liftIO $ GHCJS.toJSVal n

475valMakeNumber n = liftIO $ GHCJS.toJSVal n

466#else

476#else

467valMakeNumber n = do

477valMakeNumber n = do

468 gctxt <- ask

478 gctxt <- ask

469− (liftIO $ jsvaluemakenumber gctxt n) >>= makeNewJSVal

479+ liftIO (jsvaluemakenumber gctxt n) >>= makeNewJSVal

470#endif

480#endif

471{-# INLINE valMakeNumber #-}

481{-# INLINE valMakeNumber #-}

472

482

@@ -510,25 +520,25 @@ instance MakeArgs Double where

510

520

511-- | Make a JavaScript string from `Text`

521-- | Make a JavaScript string from `Text`

512valMakeText :: Text -> JSM JSVal

522valMakeText :: Text -> JSM JSVal

513−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

523+#ifdef ghcjs_HOST_OS

514valMakeText = return . pToJSVal . textToJSString

524valMakeText = return . pToJSVal . textToJSString

515#else

525#else

516valMakeText text = do

526valMakeText text = do

517 gctxt <- ask

527 gctxt <- ask

518 withJSString (textToStr text) $ \s ->

528 withJSString (textToStr text) $ \s ->

519− (liftIO $ jsvaluemakestring gctxt s) >>= makeNewJSVal

529+ liftIO (jsvaluemakestring gctxt s) >>= makeNewJSVal

520#endif

530#endif

521{-# INLINE valMakeText #-}

531{-# INLINE valMakeText #-}

522

532

523-- | Make a JavaScript string from `JSString`

533-- | Make a JavaScript string from `JSString`

524valMakeString :: JSString -> JSM JSVal

534valMakeString :: JSString -> JSM JSVal

525−#if (defined(ghcjs_HOST_OS) && defined(USE_JAVASCRIPTFFI)) || !defined(USE_WEBKIT)

535+#ifdef ghcjs_HOST_OS

526valMakeString = return . pToJSVal

536valMakeString = return . pToJSVal

527#else

537#else

528valMakeString str = do

538valMakeString str = do

529 gctxt <- ask

539 gctxt <- ask

530 withJSString str $ \s ->

540 withJSString str $ \s ->

531− (liftIO $ jsvaluemakestring gctxt s) >>= makeNewJSVal

541+ liftIO (jsvaluemakestring gctxt s) >>= makeNewJSVal

532#endif

542#endif

533{-# INLINE valMakeString #-}

543{-# INLINE valMakeString #-}

534

544

@@ -567,26 +577,26 @@ instance ToJSString String where

567

577

568-- | Derefernce a value reference.

578-- | Derefernce a value reference.

569--

579--

570−-- >>> testJSaddle $ show <$> deRefVal JSNull

580+-- >>> testJSaddle $ showJSValue <$> deRefVal JSNull

571-- ValNull

581-- ValNull

572−-- >>> testJSaddle $ show <$> deRefVal ()

582+-- >>> testJSaddle $ showJSValue <$> deRefVal ()

573-- ValUndefined

583-- ValUndefined

574−-- >>> testJSaddle $ show <$> deRefVal True

584+-- >>> testJSaddle $ showJSValue <$> deRefVal True

575-- ValBool True

585-- ValBool True

576−-- >>> testJSaddle $ show <$> deRefVal False

586+-- >>> testJSaddle $ showJSValue <$> deRefVal False

577-- ValBool False

587-- ValBool False

578−-- >>> testJSaddle $ show <$> deRefVal (1.0 :: Double)

588+-- >>> testJSaddle $ showJSValue <$> deRefVal (1.0 :: Double)

579-- ValNumber 1.0

589-- ValNumber 1.0

580−-- >>> testJSaddle $ show <$> deRefVal (0.0 :: Double)

590+-- >>> testJSaddle $ showJSValue <$> deRefVal (0.0 :: Double)

581-- ValNumber 0.0

591-- ValNumber 0.0

582−-- >>> testJSaddle $ show <$> deRefVal ""

592+-- >>> testJSaddle $ showJSValue <$> deRefVal ""

583-- ValString ""

593-- ValString ""

584−-- >>> testJSaddle $ show <$> deRefVal "1"

594+-- >>> testJSaddle $ showJSValue <$> deRefVal "1"

585-- ValString "1"

595-- ValString "1"

586−-- >>> testJSaddle $ show <$> valToObject True >>= deRefVal

596+-- >>> testJSaddle $ showJSValue <$> valToObject True >>= deRefVal

587-- ValObject 0x...

597-- ValObject 0x...

588deRefVal :: ToJSVal value => value -> JSM JSValue

598deRefVal :: ToJSVal value => value -> JSM JSValue

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

599+#ifdef ghcjs_HOST_OS

590deRefVal value = do

600deRefVal value = do

591 valref <- toJSVal value

601 valref <- toJSVal value

592 case (jsrefGetType valref :: Int) of

602 case (jsrefGetType valref :: Int) of

@@ -602,20 +612,18 @@ foreign import javascript unsafe "$r = ($1 === undefined)?0:\

602 (typeof $1===\"number\")?3:\

612 (typeof $1===\"number\")?3:\

603 (typeof $1===\"string\")?4:\

613 (typeof $1===\"string\")?4:\

604 (typeof $1===\"object\")?5:-1;" jsrefGetType :: JSVal -> Int

614 (typeof $1===\"object\")?5:-1;" jsrefGetType :: JSVal -> Int

605−#elif defined(USE_WEBKIT)

615+#else

606deRefVal value = do

616deRefVal value = do

607 gctxt <- ask

617 gctxt <- ask

608 v <- toJSVal value

618 v <- toJSVal value

609 withJSVal v $ \rval ->

619 withJSVal v $ \rval ->

610− (liftIO $ jsvaluegettype gctxt rval) >>= \case

620+ liftIO (jsvaluegettype gctxt rval) >>= \case

611 Kjstypenull -> return ValNull

621 Kjstypenull -> return ValNull

612 Kjstypeundefined -> return ValUndefined

622 Kjstypeundefined -> return ValUndefined

613 Kjstypeboolean -> ValBool <$> valToBool v

623 Kjstypeboolean -> ValBool <$> valToBool v

614 Kjstypenumber -> ValNumber <$> valToNumber v

624 Kjstypenumber -> ValNumber <$> valToNumber v

615 Kjstypestring -> ValString <$> valToText v

625 Kjstypestring -> ValString <$> valToText v

616 Kjstypeobject -> ValObject <$> valToObject v

626 Kjstypeobject -> ValObject <$> valToObject v

617−#else

618−deRefVal = undefined

619#endif

627#endif

620

628

621-- | Make a JavaScript value out of a 'JSValue' ADT.

629-- | Make a JavaScript value out of a 'JSValue' ADT.

@@ -654,7 +662,7 @@ instance MakeArgs JSValue where

654-- makeObjectRef _ = Object <$> valMakeNull

662-- makeObjectRef _ = Object <$> valMakeNull

655-- {-# INLINE makeObjectRef #-}

663-- {-# INLINE makeObjectRef #-}

656

664

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

665+#ifdef ghcjs_HOST_OS

658foreign import javascript unsafe

666foreign import javascript unsafe

659 "$1===$2" jsvalueisstrictequal :: JSVal -> JSVal -> Bool

667 "$1===$2" jsvalueisstrictequal :: JSVal -> JSVal -> Bool

660#endif

668#endif

@@ -663,7 +671,7 @@ strictEqual :: (ToJSVal a, ToJSVal b) => a -> b -> JSM Bool

663strictEqual a b = do

671strictEqual a b = do

664 aval <- toJSVal a

672 aval <- toJSVal a

665 bval <- toJSVal b

673 bval <- toJSVal b

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

674+#ifdef ghcjs_HOST_OS

667 return $ jsvalueisstrictequal aval bval

675 return $ jsvalueisstrictequal aval bval

668#else

676#else

669 gctxt <- ask

677 gctxt <- ask

@@ -672,7 +680,7 @@ strictEqual a b = do

672 liftIO $ jsvalueisstrictequal gctxt aref bref

680 liftIO $ jsvalueisstrictequal gctxt aref bref

673#endif

681#endif

674

682

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

683+#ifdef ghcjs_HOST_OS

676foreign import javascript unsafe "\

684foreign import javascript unsafe "\

677 try {\

685 try {\

678 $r = $1 instanceof $2\

686 $r = $1 instanceof $2\

@@ -687,7 +695,7 @@ instanceOf :: (ToJSVal value, MakeObject constructor) => value -> constructor ->

687instanceOf value constructor = do

695instanceOf value constructor = do

688 v <- toJSVal value

696 v <- toJSVal value

689 c <- makeObject constructor

697 c <- makeObject constructor

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

698+#ifdef ghcjs_HOST_OS

691 rethrow $ return . js_isInstanceOf v c

699 rethrow $ return . js_isInstanceOf v c

692#else

700#else

693 gctxt <- ask

701 gctxt <- ask

tests/DocTest.hsnew file+21

@@ -0,0 +1,21 @@

1+module Main (

2+ main

3+) where

5+import Test.DocTest

7+main :: IO ()

8+main = doctest ["-isrc",

9+ "src/Language/Javascript/JSaddle/Arguments.hs",

10+ "src/Language/Javascript/JSaddle/Classes.hs",

11+ "src/Language/Javascript/JSaddle/Evaluate.hs",

12+ "src/Language/Javascript/JSaddle/Exception.hs",

13+ "src/Language/Javascript/JSaddle/Monad.hs",

14+ "src/Language/Javascript/JSaddle/Native.hs",

15+ "src/Language/Javascript/JSaddle/Object.hs",

16+ "src/Language/Javascript/JSaddle/Properties.hs",

17+ "src/Language/Javascript/JSaddle/String.hs",

18+ "src/Language/Javascript/JSaddle/Test.hs",

19+ "src/Language/Javascript/JSaddle/Types.hs",

20+ "src/Language/Javascript/JSaddle/Value.hs" ]

21+