src/Language/Javascript/JSaddle/Object.hs · jsaddle

git.iko.soy/jsaddle

on dcbc28e help sign in

jsaddle/src/Language/Javascript/JSaddle/Object.hs

772 lines 25 kB history raw

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE TypeSynonymInstances #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE Rank2Types #-}

6#ifdef ghcjs_HOST_OS

7{-# LANGUAGE ForeignFunctionInterface #-}

8{-# LANGUAGE JavaScriptFFI #-}

9#endif

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

11-----------------------------------------------------------------------------

12--

13-- Module : Language.Javascript.JSaddle.Object

14-- Copyright : (c) Hamish Mackenzie

15-- License : MIT

16--

17-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>

18--

19-- | Interface to JavaScript object

20--

21-----------------------------------------------------------------------------

23module Language.Javascript.JSaddle.Object (

24 Object

25 , MakeObject(..)

27 -- * Property lookup

28 , (!)

29 , (!!)

30 , js

31 , jss

32 , JSF

33 , jsf

34 , js0

35 , js1

36 , js2

37 , js3

38 , js4

39 , js5

40 , jsg

41 , jsgf

42 , jsg0

43 , jsg1

44 , jsg2

45 , jsg3

46 , jsg4

47 , jsg5

49 -- * Setting the value of a property

50 , (<#)

51 , (<##)

53 -- * Calling JavaSctipt

54 , (#)

55 , (##)

56 , new

57 , call

58 , obj

60 -- * Calling Haskell From JavaScript

61 , Function(..)

62 , function

63 , freeFunction

64 , fun

65 , JSCallAsFunction

66 -- ** Object Constructors

68 -- | There is no good way to support calling haskell code as a JavaScript

69 -- constructor for the same reason that the return type of

70 -- 'JSCallAsFunction' is 'JSUndefined'.

71 --

72 -- Instead of writing a constructor in Haskell write a function

73 -- that takes a continuation. Create the JavaScript object

74 -- and pass it to the continuation.

76 -- * Arrays

77 , array

79 -- * Global Object

80 , global

82 -- * Enumerating Properties

83 , propertyNames

84 , properties

86 -- * Low level

87 , objCallAsFunction

88 , objCallAsConstructor

89 , nullObject

90) where

92import Control.Applicative

93import Prelude hiding ((!!))

94import Language.Javascript.JSaddle.Types

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

96 JSVal, Index)

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

98#ifdef ghcjs_HOST_OS

99import GHCJS.Types (nullRef, jsval)

100import GHCJS.Foreign.Callback

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

102import GHCJS.Marshal.Pure (pFromJSVal)

103import JavaScript.Array (JSArray)

104import qualified JavaScript.Array as Array (toListIO, fromListIO)

105import JavaScript.Array.Internal (SomeJSArray(..))

106import qualified JavaScript.Object as Object (create)

107import Control.Monad (liftM)

108import Data.Coerce (coerce)

109#else

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

111 (jsobjectmake, jspropertynamearraygetnameatindex,

112 jspropertynamearraygetcount, jsobjectcopypropertynames,

113 jsobjectcallasconstructor, jsobjectmakearray,

114 jsobjectcallasfunction,

115 JSObjectCallAsFunctionCallback, mkJSObjectCallAsFunctionCallback,

116 jsobjectmakefunctionwithcallback)

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

118 (jsvaluemakeundefined)

119import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef

120 (jscontextgetglobalobject)

121import Foreign (peekArray, nullPtr, withArrayLen)

122import Foreign.Ptr (freeHaskellFunPtr)

123import Language.Javascript.JSaddle.Native

124 (makeNewJSString, makeNewJSVal, wrapJSString, withJSVals,

125 withObject, withJSString, withToJSVal)

126import System.IO.Unsafe (unsafePerformIO)

127import Foreign.ForeignPtr (newForeignPtr_)

128#endif

129import Language.Javascript.JSaddle.Exception (rethrow)

130import Language.Javascript.JSaddle.Value

131 (JSUndefined, valToObject)

132import Language.Javascript.JSaddle.Classes

133 (ToJSVal(..), ToJSString(..), MakeObject(..))

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

135import Language.Javascript.JSaddle.Monad

136 (JSM)

137import Control.Monad.Trans.Reader (runReaderT, ask)

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

139import qualified Control.Exception as E (catch)

140import Control.Exception (SomeException)

141import Foreign.Storable (Storable(..))

142import Language.Javascript.JSaddle.Properties

143import 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, valToText, JSNull(..))

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

152-- >>> import qualified Data.Text as T (unpack)

153

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

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

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

157 makeObject v = v >>= makeObject

158 {-# INLINE makeObject #-}

159

160-- | Lookup a property based on its name.

161--

162-- >>> testJSaddle $ eval "'Hello World'.length"

163-- 11

164-- >>> testJSaddle $ val "Hello World" ! "length"

165-- 11

166(!) :: (MakeObject this, ToJSString name)

167 => this -- ^ Object to look on

168 -> name -- ^ Name of the property to find

169 -> JSM JSVal -- ^ Property reference

170this ! name = do

171 rthis <- makeObject this

172 rethrow $ objGetPropertyByName rthis rname

173 where

174 rname = toJSString name

175{-# INLINE (!) #-}

176

177-- | Lookup a property based on its index.

178--

179-- >>> testJSaddle $ eval "'Hello World'[6]"

180-- W

181-- >>> testJSaddle $ val "Hello World" !! 6

182-- W

183(!!) :: (MakeObject this)

184 => this -- ^ Object to look on

185 -> Index -- ^ Index of the property to lookup

186 -> JSM JSVal -- ^ Property reference

187this !! index = do

188 rthis <- makeObject this

189 rethrow $ objGetPropertyAtIndex rthis index

190{-# INLINE (!!) #-}

191

192-- | Makes a getter for a particular property name.

193--

194-- > js name = to (!name)

195--

196-- >>> testJSaddle $ eval "'Hello World'.length"

197-- 11

198-- >>> testJSaddle $ val "Hello World" ^. js "length"

199-- 11

200js :: (MakeObject s, ToJSString name)

201 => name -- ^ Name of the property to find

202 -> IndexPreservingGetter s (JSM JSVal)

203js name = to (!name)

204{-# INLINE js #-}

205

206-- | Makes a setter for a particular property name.

207--

208-- > jss name = to (<#name)

209--

210-- >>> testJSaddle $ eval "'Hello World'.length"

211-- 11

212-- >>> testJSaddle $ val "Hello World" ^. js "length"

213-- 11

214jss :: (ToJSString name, ToJSVal val)

215 => name -- ^ Name of the property to find

216 -> val

217 -> forall o . MakeObject o => IndexPreservingGetter o (JSM ())

218jss name val = to (\o -> o <# name $ val)

219{-# INLINE jss #-}

220

221-- | Handy way to call a function

222--

223-- > jsf name = to (\o -> o # name $ args)

224--

225-- >>> testJSaddle $ val "Hello World" ^. jsf "indexOf" ["World"]

226-- 6

227jsf :: (ToJSString name, MakeArgs args) => name -> args -> JSF

228jsf name args = to (\o -> o # name $ args)

229{-# INLINE jsf #-}

230

231-- | Java script function applications have this type

232type JSF = forall o . MakeObject o => IndexPreservingGetter o (JSM JSVal)

233

234-- | Handy way to call a function that expects no arguments

235--

236-- > js0 name = jsf name ()

237--

238-- >>> testJSaddle $ val "Hello World" ^. js0 "toLowerCase"

239-- hello world

240js0 :: (ToJSString name) => name -> JSF

241js0 name = jsf name ()

242{-# INLINE js0 #-}

243

244-- | Handy way to call a function that expects one argument

245--

246-- > js1 name a0 = jsf name [a0]

247--

248-- >>> testJSaddle $ val "Hello World" ^. js1 "indexOf" "World"

249-- 6

250js1 :: (ToJSString name, ToJSVal a0) => name -> a0 -> JSF

251js1 name a0 = jsf name [a0]

252{-# INLINE js1 #-}

253

254-- | Handy way to call a function that expects two arguments

255js2 :: (ToJSString name, ToJSVal a0, ToJSVal a1) => name -> a0 -> a1 -> JSF

256js2 name a0 a1 = jsf name (a0, a1)

257{-# INLINE js2 #-}

258

259-- | Handy way to call a function that expects three arguments

260js3 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2)

261 => name -> a0 -> a1 -> a2 -> JSF

262js3 name a0 a1 a2 = jsf name (a0, a1, a2)

263{-# INLINE js3 #-}

264

265-- | Handy way to call a function that expects four arguments

266js4 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,

267 ToJSVal a3)

268 => name -> a0 -> a1 -> a2 -> a3 -> JSF

269js4 name a0 a1 a2 a3 = jsf name (a0, a1, a2, a3)

270{-# INLINE js4 #-}

271

272-- | Handy way to call a function that expects five arguments

273js5 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,

274 ToJSVal a3, ToJSVal a4)

275 => name -> a0 -> a1 -> a2 -> a3 -> a4 -> JSF

276js5 name a0 a1 a2 a3 a4 = jsf name (a0, a1, a2, a3, a4)

277{-# INLINE js5 #-}

278

279

280-- | Handy way to get and hold onto a reference top level javascript

281--

282-- >>> testJSaddle $ eval "w = console; w.log('Hello World')"

283-- ** Message: console message: @1: Hello World

284-- <BLANKLINE>

285-- undefined

286-- >>> testJSaddle $ do w <- jsg "console"; w ^. js1 "log" "Hello World"

287-- ** Message: console message: ... @0: Hello World

288-- <BLANKLINE>

289-- undefined

290jsg :: ToJSString a => a -> JSM JSVal

291jsg name = global ! name

292{-# INLINE jsg #-}

293

294-- | Handy way to call a function

295--

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

297--

298-- >>> testJSaddle $ eval "globalFunc = function (x) {return x.length;}"

299-- function (x) {return x.length;}

300-- >>> testJSaddle $ jsgf "globalFunc" ["World"]

301-- 5

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

303jsgf name = global # name

304{-# INLINE jsgf #-}

305

306-- | Handy way to call a function that expects no arguments

307--

308-- > jsg0 name = jsgf name ()

309--

310-- >>> testJSaddle $ jsg0 "globalFunc"

311-- TypeError:...undefined...is not an objec...

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

313jsg0 name = jsgf name ()

314{-# INLINE jsg0 #-}

315

316-- | Handy way to call a function that expects one argument

317--

318-- > jsg1 name a0 = jsgf name [a0]

319--

320-- >>> testJSaddle $ jsg1 "globalFunc" "World"

321-- 5

322jsg1 :: (ToJSString name, ToJSVal a0) => name -> a0 -> JSM JSVal

323jsg1 name a0 = jsgf name [a0]

324{-# INLINE jsg1 #-}

325

326-- | Handy way to call a function that expects two arguments

327jsg2 :: (ToJSString name, ToJSVal a0, ToJSVal a1) => name -> a0 -> a1 -> JSM JSVal

328jsg2 name a0 a1 = jsgf name (a0, a1)

329{-# INLINE jsg2 #-}

330

331-- | Handy way to call a function that expects three arguments

332jsg3 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2)

333 => name -> a0 -> a1 -> a2 -> JSM JSVal

334jsg3 name a0 a1 a2 = jsgf name (a0, a1, a2)

335{-# INLINE jsg3 #-}

336

337-- | Handy way to call a function that expects four arguments

338jsg4 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,

339 ToJSVal a3)

340 => name -> a0 -> a1 -> a2 -> a3 -> JSM JSVal

341jsg4 name a0 a1 a2 a3 = jsgf name (a0, a1, a2, a3)

342{-# INLINE jsg4 #-}

343

344-- | Handy way to call a function that expects five arguments

345jsg5 :: (ToJSString name, ToJSVal a0, ToJSVal a1, ToJSVal a2,

346 ToJSVal a3, ToJSVal a4)

347 => name -> a0 -> a1 -> a2 -> a3 -> a4 -> JSM JSVal

348jsg5 name a0 a1 a2 a3 a4 = jsgf name (a0, a1, a2, a3, a4)

349{-# INLINE jsg5 #-}

350

351-- | Call a JavaScript function

352--

353-- >>> testJSaddle $ eval "'Hello World'.indexOf('World')"

354-- 6

355-- >>> testJSaddle $ val "Hello World" # "indexOf" $ ["World"]

356-- 6

357infixr 2 #

358(#) :: (MakeObject this, ToJSString name, MakeArgs args)

359 => this -> name -> args -> JSM JSVal

360(#) this name args = do

361 rthis <- makeObject this

362 f <- rethrow $ objGetPropertyByName rthis name

363 f' <- valToObject f

364 rethrow $ objCallAsFunction f' rthis args

365{-# INLINE (#) #-}

366

367-- | Call a JavaScript function

368--

369-- >>> testJSaddle $ eval "something = {}; something[6]=function (x) {return x.length;}; something[6]('World')"

370-- 5

371-- >>> testJSaddle $ jsg "something" ## 6 $ ["World"]

372-- 5

373infixr 2 ##

374(##) :: (MakeObject this, MakeArgs args)

375 => this -> Index -> args -> JSM JSVal

376(##) this index args = do

377 rthis <- makeObject this

378 f <- rethrow $ objGetPropertyAtIndex rthis index

379 f' <- valToObject f

380 rethrow $ objCallAsFunction f' rthis args

381{-# INLINE (##) #-}

382

383-- | Set a JavaScript property

384--

385-- >>> testJSaddle $ eval "var j = {}; j.x = 1; j.x"

386-- 1

387-- >>> testJSaddle $ do {j <- obj; (j <# "x") 1; j!"x"}

388-- 1

389infixr 1 <#

390(<#) :: (MakeObject this, ToJSString name, ToJSVal val)

391 => this -- ^ Object to set the property on

392 -> name -- ^ Name of the property to set

393 -> val -- ^ Value to set it to

394 -> JSM ()

395(<#) this name val = do

396 rthis <- makeObject this

397 rethrow $ objSetPropertyByName rthis name val 0

398{-# INLINE (<#) #-}

399

400-- | Set a JavaScript property

401--

402-- >>> testJSaddle $ eval "var j = {}; j[6] = 1; j[6]"

403-- 1

404-- >>> testJSaddle $ do {j <- obj; (j <## 6) 1; j!!6}

405-- 1

406infixr 1 <##

407(<##) :: (MakeObject this, ToJSVal val)

408 => this -- ^ Object to set the property on

409 -> Index -- ^ Index of the property to set

410 -> val -- ^ Value to set it to

411 -> JSM ()

412(<##) this index val = do

413 rthis <- makeObject this

414 rethrow $ objSetPropertyAtIndex rthis index val

415{-# INLINE (<##) #-}

416

417-- | Use this to create a new JavaScript object

418--

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

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

421--

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

423-- Fri Feb 01 2013 00:00:00 GMT+... (...)

424new :: (MakeObject constructor, MakeArgs args)

425 => constructor

426 -> args

427 -> JSM JSVal

428new constructor args = do

429 f <- makeObject constructor

430 rethrow $ objCallAsConstructor f args

431{-# INLINE new #-}

432

433-- | Call function with a given @this@. In most cases you should use '#'.

434--

435-- >>> testJSaddle $ eval "(function(){return this;}).apply('Hello', [])"

436-- Hello

437-- >>> testJSaddle $ do { test <- eval "(function(){return this;})"; call test (val "Hello") () }

438-- Hello

439call :: (MakeObject f, MakeObject this, MakeArgs args)

440 => f -> this -> args -> JSM JSVal

441call f this args = do

442 rfunction <- makeObject f

443 rthis <- makeObject this

444 rethrow $ objCallAsFunction rfunction rthis args

445{-# INLINE call #-}

446

447-- | Make an empty object using the default constuctor

448--

449-- >>> testJSaddle $ eval "var a = {}; a.x = 'Hello'; a.x"

450-- Hello

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

452-- Hello

453obj :: JSM Object

454#ifdef ghcjs_HOST_OS

455obj = liftIO Object.create

456#else

457obj = do

458 gctxt <- ask

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

460#endif

461{-# INLINE obj #-}

462

463-- | Type used for Haskell functions called from JavaScript.

464type JSCallAsFunction = JSVal -- ^ Function object

465 -> JSVal -- ^ this

466 -> [JSVal] -- ^ Function arguments

467 -> JSM JSUndefined -- ^ Only 'JSUndefined' can be returned because

468 -- the function may need to be executed in a

469 -- different thread. If you need to get a

470 -- value out pass in a continuation function

471 -- as an argument and invoke it from haskell.

472

473-- | Short hand @::JSCallAsFunction@ so a haskell function can be passed to

474-- a to a JavaScipt one.

475--

476-- >>> testJSaddle $ eval "(function(f) {f('Hello');})(function (a) {console.log(a)})"

477-- ** Message: console message: @1: Hello

478-- <BLANKLINE>

479-- undefined

480-- >>> testJSaddle $ call (eval "(function(f) {f('Hello');})") global [fun $ \ _ _ args -> valToText (head args) >>= (liftIO . putStrLn . T.unpack) ]

481-- Hello

482-- undefined

483fun :: JSCallAsFunction -> JSCallAsFunction

484fun = id

485{-# INLINE fun #-}

486

487#ifdef ghcjs_HOST_OS

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

489#else

490type HaskellCallback = JSObjectCallAsFunctionCallback

491#endif

492

493data Function = Function {functionCallback :: HaskellCallback, functionObject :: Object}

494

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

496function :: ToJSString name

497 => name -- ^ Name of the function

498 -> JSCallAsFunction -- ^ Haskell function to call

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

500 -- call the Haskell one when it is called

501#ifdef ghcjs_HOST_OS

502function name f = liftIO $ do

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

504 rargs <- Array.toListIO (coerce args)

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

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

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

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

509#else

510function name f = do

511 gctxt <- ask

512 callback <- liftIO $ mkJSObjectCallAsFunctionCallback (wrap gctxt)

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

514 Function callback . Object <$>

515 (liftIO (jsobjectmakefunctionwithcallback gctxt name' callback) >>= makeNewJSVal)

516 where

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

518 args' <- peekArray (fromIntegral argc) argv

519 (`runReaderT` gctxt) $ do

520 fobj <- makeNewJSVal fobj'

521 this <- makeNewJSVal this'

522 args <- mapM makeNewJSVal args'

523 f fobj this args

524 liftIO $ jsvaluemakeundefined gctxt

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

526 (`runReaderT` gctxt) $ do

527 withToJSVal (show e) $ liftIO . poke exception

528 liftIO $ jsvaluemakeundefined gctxt

529#endif

530

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

532freeFunction (Function callback _) = liftIO $

533#ifdef ghcjs_HOST_OS

534 releaseCallback callback

535#else

536 freeHaskellFunPtr callback

537#endif

538

539instance ToJSVal Function where

540 toJSVal (Function _ f) = toJSVal f

541 {-# INLINE toJSVal #-}

542

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

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

545-- a name.

546instance ToJSVal JSCallAsFunction where

547 toJSVal f = functionObject <$> function nullJSString f >>= toJSVal

548 {-# INLINE toJSVal #-}

549

550instance MakeArgs JSCallAsFunction where

551 makeArgs f = do

552 rarg <- functionObject <$> function nullJSString f >>= toJSVal

553 return [rarg]

554 {-# INLINE makeArgs #-}

555

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

557#ifdef ghcjs_HOST_OS

558makeArray args exceptions = do

559 rargs <- makeArgs args

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

561#else

562makeArray args exceptions = do

563 gctxt <- ask

564 rargs <- makeArgs args

565 result <-

566 withJSVals rargs $ \rargs' ->

567 liftIO $ withArrayLen rargs' $ \ len ptr ->

568 jsobjectmakearray gctxt (fromIntegral len) ptr exceptions

569 Object <$> makeNewJSVal result

570#endif

571{-# INLINE makeArray #-}

572

573-- | Make an JavaScript array from a list of values

574--

575-- >>> testJSaddle $ eval "['Hello', 'World'][1]"

576-- World

577-- >>> testJSaddle $ array ["Hello", "World"] !! 1

578-- World

579-- >>> testJSaddle $ eval "['Hello', null, undefined, true, 1]"

580-- Hello,,,true,1

581-- >>> testJSaddle $ array ("Hello", JSNull, (), True, 1.0::Double)

582-- Hello,,,true,1

583array :: MakeArgs args => args -> JSM Object

584array = rethrow . makeArray

585

586-- Make an array out of various lists

587instance ToJSVal [JSVal] where

588 toJSVal = toJSVal . array

589 {-# INLINE toJSVal #-}

590

591instance ToJSVal [JSM JSVal] where

592 toJSVal = toJSVal . array

593 {-# INLINE toJSVal #-}

594

595instance ToJSVal [Double] where

596 toJSVal = toJSVal . array

597 {-# INLINE toJSVal #-}

598

599instance ToJSVal [Float] where

600 toJSVal = toJSVal . array

601 {-# INLINE toJSVal #-}

602

603instance ToJSVal [Int] where

604 toJSVal = toJSVal . array

605 {-# INLINE toJSVal #-}

606

607instance ToJSVal [JSString] where

608 toJSVal = toJSVal . array

609 {-# INLINE toJSVal #-}

610

611instance ToJSVal [String] where

612 toJSVal = toJSVal . array

613 {-# INLINE toJSVal #-}

614

615instance ToJSVal [Text] where

616 toJSVal = toJSVal . array

617 {-# INLINE toJSVal #-}

618

619instance ToJSVal [Bool] where

620 toJSVal = toJSVal . array

621 {-# INLINE toJSVal #-}

622

623-- | JavaScript's global object

624global :: JSM Object

625#ifdef ghcjs_HOST_OS

626global = liftIO js_window

627{-# INLINE global #-}

628foreign import javascript unsafe "$r = window"

629 js_window :: IO Object

630#else

631global = do

632 gctxt <- ask

633 result <- liftIO $ jscontextgetglobalobject gctxt

634 Object <$> makeNewJSVal result

635{-# INLINE global #-}

636#endif

637

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

639#if !defined(ghcjs_HOST_OS)

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

641copyPropertyNames this = do

642 gctxt <- ask

643 this' <- makeObject this

644 withObject this' $ \rthis ->

645 liftIO $ jsobjectcopypropertynames gctxt rthis

646{-# INLINE copyPropertyNames #-}

647

648-- | Get the number of names in a property name array

649propertyNamesCount :: MonadIO m => JSPropertyNameArray -> m CSize

650propertyNamesCount names = liftIO $ jspropertynamearraygetcount names

651{-# INLINE propertyNamesCount #-}

652

653-- | Get a name out of a property name array

654propertyNamesAt :: MonadIO m => JSPropertyNameArray -> CSize -> m JSString

655propertyNamesAt names index = liftIO $ jspropertynamearraygetnameatindex names index >>= makeNewJSString

656{-# INLINE propertyNamesAt #-}

657

658-- | Convert property array to a list

659propertyNamesList :: MonadIO m => JSPropertyNameArray -> m [JSString]

660propertyNamesList names = do

661 count <- propertyNamesCount names

662 mapM (propertyNamesAt names) $ enumFromTo 0 (count - 1)

663{-# INLINE propertyNamesList #-}

664#endif

665

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

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

668#ifdef ghcjs_HOST_OS

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

670{-# INLINE propertyNames #-}

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

672 js_propertyNames :: Object -> IO JSArray

673#else

674propertyNames this = copyPropertyNames this >>= propertyNamesList

675{-# INLINE propertyNames #-}

676#endif

677

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

679properties :: MakeObject this => this -> JSM [JSVal]

680properties this = propertyNames this >>= mapM (this !)

681

682-- | Call a JavaScript object as function. Consider using '#'.

683objCallAsFunction :: MakeArgs args

684 => Object

685 -> Object

686 -> args

687 -> MutableJSArray

688 -> JSM JSVal

689#ifdef ghcjs_HOST_OS

690objCallAsFunction f this args exceptions = do

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

692 liftIO $ js_apply f this rargs exceptions

693{-# INLINE objCallAsFunction #-}

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

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

696#else

697objCallAsFunction f this args exceptions = do

698 gctxt <- ask

699 rargs <- makeArgs args

700 result <-

701 withObject f $ \rfunction ->

702 withObject this $ \rthis ->

703 withJSVals rargs $ \rargs' ->

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

705 jsobjectcallasfunction gctxt rfunction rthis (fromIntegral largs) pargs exceptions

706 makeNewJSVal result

707{-# INLINE objCallAsFunction #-}

708#endif

709

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

711--

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

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

714objCallAsConstructor :: MakeArgs args

715 => Object

716 -> args

717 -> MutableJSArray

718 -> JSM JSVal

719#ifdef ghcjs_HOST_OS

720objCallAsConstructor f args exceptions = do

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

722 liftIO $ js_new f rargs exceptions

723foreign import javascript unsafe "\

724 try {\

725 switch($2.length) {\

726 case 0 : $r = new $1(); break;\

727 case 1 : $r = new $1($2[0]); break;\

728 case 2 : $r = new $1($2[0],$2[1]); break;\

729 case 3 : $r = new $1($2[0],$2[1],$2[2]); break;\

730 case 4 : $r = new $1($2[0],$2[1],$2[2],$2[3]); break;\

731 case 5 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4]); break;\

732 case 6 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5]); break;\

733 case 7 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5],$2[6]); break;\

734 default:\

735 var ret;\

736 var temp = function() {\

737 ret = $1.apply(this, $2);\

738 };\

739 temp.prototype = $1.prototype;\

740 var i = new temp();\

741 if(ret instanceof Object)\

742 return ret;\

743 i.constructor = $1;\

744 return i;\

745 }\

746 }\

747 catch(e) {\

748 $3[0] = e;\

749 }"

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

751#else

752objCallAsConstructor f args exceptions = do

753 gctxt <- ask

754 rargs <- makeArgs args

755 result <-

756 withObject f $ \rfunction ->

757 withJSVals rargs $ \rargs' ->

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

759 jsobjectcallasconstructor gctxt rfunction (fromIntegral largs) pargs exceptions

760 makeNewJSVal result

761#endif

762

763nullObject :: Object

764#ifdef ghcjs_HOST_OS

765nullObject = Object nullRef

766#else

767nullObject = Object . unsafePerformIO $ newForeignPtr_ nullPtr

768#endif