d7c49fb · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Add WithJSContext

d7c49fbRyan Trinkle10 years ago

src/Foreign/JavaScript/TH.hs+59−10

compare with develop

unifiedsplit

@@ -296,18 +296,13 @@ foreign import javascript unsafe "function(){ return $1(arguments); }" funWithAr

296

297#else

298

299−askJSContext :: MonadIO m => WithWebView x m JSContextRef

300−askJSContext = do

301− wv <- askWebView

302− liftIO $ webFrameGetGlobalContext =<< webViewGetMainFrame (unWebViewSingleton wv)

303−

304-- | Make a JS string available that is not wrapped up as a JSValueRef

299-- | Make a JS string available that is not wrapped up as a JSValueRef

305withJSStringRaw :: MonadAsyncException m => String -> (JSStringRef -> m r) -> m r

300withJSStringRaw :: MonadAsyncException m => String -> (JSStringRef -> m r) -> m r

306withJSStringRaw str a = do

301withJSStringRaw str a = do

307 bracket (liftIO $ jsstringcreatewithutf8cstring str) (liftIO . jsstringrelease) $ \strRef -> do

302 bracket (liftIO $ jsstringcreatewithutf8cstring str) (liftIO . jsstringrelease) $ \strRef -> do

308 a strRef

303 a strRef

309

304

310−fromJSNumberRaw :: MonadIO m => JSValueRef -> WithWebView x m Double

305+fromJSNumberRaw :: (MonadIO m, HasJSContext m) => JSValueRef -> m Double

311fromJSNumberRaw val = do

306fromJSNumberRaw val = do

312 jsContext <- askJSContext

307 jsContext <- askJSContext

313 liftIO $ jsvaluetonumber jsContext val nullPtr --TODO: Exceptions

308 liftIO $ jsvaluetonumber jsContext val nullPtr --TODO: Exceptions

@@ -324,15 +319,70 @@ instance MonadIO m => HasJS (JSCtx_JavaScriptCore x) (WithWebView x m) where

324 wv <- askWebView

319 wv <- askWebView

325 liftIO $ runWithWebView a wv

320 liftIO $ runWithWebView a wv

326

321

322+newtype WithJSContext x m a = WithJSContext { unWithJSContext :: ReaderT JSContextRef m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)

323+

324+runWithJSContext :: WithJSContext x m a -> JSContextRef -> m a

325+runWithJSContext = runReaderT . unWithJSContext

326+

327+class Monad m => HasJSContext m where

328+ askJSContext :: m JSContextRef

329+

330+instance MonadIO m => HasJSContext (WithWebView x m) where

331+ askJSContext = do

332+ wv <- askWebView

333+ liftIO $ webFrameGetGlobalContext =<< webViewGetMainFrame (unWebViewSingleton wv)

334+

335+instance Monad m => HasJSContext (WithJSContext x m) where

336+ askJSContext = WithJSContext ask

337+

338+lowerWithJSContext :: (HasJSContext m, MonadIO m) => WithJSContext x IO a -> m a

339+lowerWithJSContext a = do

340+ c <- askJSContext

341+ liftIO $ runWithJSContext a c

342+

343+liftWithWebViewThroughWithJSContext :: (HasJSContext m, HasWebView m, MonadIO m, MonadTrans t, Monad m1)

344+ => ((t1 -> t m1 a) -> WithJSContext x IO b)

345+ -> (t1 -> WithWebView (WebViewPhantom m) m1 a)

346+ -> m b

347+liftWithWebViewThroughWithJSContext f a = do

348+ wv <- askWebView

349+ lowerWithJSContext $ f $ \b' -> lift $ runWithWebView (a b') wv

350+

327instance MonadJS (JSCtx_JavaScriptCore x) (WithWebView x IO) where

351instance MonadJS (JSCtx_JavaScriptCore x) (WithWebView x IO) where

352+ forkJS a = do

353+ wv <- askWebView

354+ liftIO $ forkIO $ runWithWebView a wv

355+ mkJSFun a = do

356+ wv <- askWebView

357+ lowerWithJSContext $ mkJSFun $ \args -> lift $ runWithWebView (a args) wv

358+ runJS expr args = lowerWithJSContext $ runJS expr args

359+ mkJSUndefined = lowerWithJSContext mkJSUndefined

360+ isJSNull = lowerWithJSContext . isJSNull

361+ isJSUndefined = lowerWithJSContext . isJSUndefined

362+ fromJSBool = lowerWithJSContext . fromJSBool

363+ fromJSString = lowerWithJSContext . fromJSString

364+ fromJSArray = lowerWithJSContext . fromJSArray

365+ fromJSUint8Array = lowerWithJSContext . fromJSUint8Array

366+ fromJSNumber = lowerWithJSContext . fromJSNumber

367+ freeJSFun = lowerWithJSContext . freeJSFun

368+ withJSBool = liftWithWebViewThroughWithJSContext . withJSBool

369+ withJSString = liftWithWebViewThroughWithJSContext . withJSString

370+ withJSNumber = liftWithWebViewThroughWithJSContext . withJSNumber

371+ withJSArray = liftWithWebViewThroughWithJSContext . withJSArray

372+ withJSUint8Array = liftWithWebViewThroughWithJSContext . withJSUint8Array

373+ withJSNode = liftWithWebViewThroughWithJSContext . withJSNode

374+ setJSProp propName valRef objRef = lowerWithJSContext $ setJSProp propName valRef objRef

375+ getJSProp propName objRef = lowerWithJSContext $ getJSProp propName objRef

376+

377+instance MonadJS (JSCtx_JavaScriptCore x) (WithJSContext x IO) where

328 runJS (JSFFI body) args = do

378 runJS (JSFFI body) args = do

329 jsContext <- askJSContext

379 jsContext <- askJSContext

330 withJSArray args $ \(JSRef_JavaScriptCore this) -> liftIO $ do

380 withJSArray args $ \(JSRef_JavaScriptCore this) -> liftIO $ do

331 result <- bracket (jsstringcreatewithutf8cstring body) jsstringrelease $ \script -> jsevaluatescript jsContext script this nullPtr 1 nullPtr

381 result <- bracket (jsstringcreatewithutf8cstring body) jsstringrelease $ \script -> jsevaluatescript jsContext script this nullPtr 1 nullPtr

332 return $ JSRef_JavaScriptCore result --TODO: Protect and unprotect result

382 return $ JSRef_JavaScriptCore result --TODO: Protect and unprotect result

333 forkJS a = do

383 forkJS a = do

334− wv <- askWebView

384+ c <- askJSContext

335− liftIO $ forkIO $ runWithWebView a wv

385+ liftIO $ forkIO $ runWithJSContext a c

336 mkJSUndefined = do

386 mkJSUndefined = do

337 jsContext <- askJSContext

387 jsContext <- askJSContext

338 fmap JSRef_JavaScriptCore $ liftIO $ jsvaluemakeundefined jsContext

388 fmap JSRef_JavaScriptCore $ liftIO $ jsvaluemakeundefined jsContext

@@ -393,14 +443,13 @@ instance MonadJS (JSCtx_JavaScriptCore x) (WithWebView x IO) where

393 jsContext <- askJSContext

443 jsContext <- askJSContext

394 liftIO $ jsvaluetonumber jsContext val nullPtr --TODO: Exceptions

444 liftIO $ jsvaluetonumber jsContext val nullPtr --TODO: Exceptions

395 mkJSFun a = do

445 mkJSFun a = do

396− wv <- askWebView

397 jsContext <- askJSContext

446 jsContext <- askJSContext

398 cb <- liftIO $ mkJSObjectCallAsFunctionCallback $ \_ _ _ argc argv _ -> do --TODO: Use the exception pointer to handle haskell exceptions

447 cb <- liftIO $ mkJSObjectCallAsFunctionCallback $ \_ _ _ argc argv _ -> do --TODO: Use the exception pointer to handle haskell exceptions

399 args <- forM [0..fromIntegral (argc-1)] $ \n -> do

448 args <- forM [0..fromIntegral (argc-1)] $ \n -> do

400 x <- peekElemOff argv n

449 x <- peekElemOff argv n

401 jsvalueprotect jsContext x

450 jsvalueprotect jsContext x

402 return $ JSRef_JavaScriptCore x --TODO: Unprotect eventually

451 return $ JSRef_JavaScriptCore x --TODO: Unprotect eventually

403− unJSRef_JavaScriptCore <$> runWithWebView (a args) wv

452+ unJSRef_JavaScriptCore <$> runWithJSContext (a args) jsContext

404 cbRef <- liftIO $ jsobjectmakefunctionwithcallback jsContext nullPtr cb

453 cbRef <- liftIO $ jsobjectmakefunctionwithcallback jsContext nullPtr cb

405 liftIO $ jsvalueprotect jsContext cbRef

454 liftIO $ jsvalueprotect jsContext cbRef

406 return $ JSFun $ JSRef_JavaScriptCore cbRef

455 return $ JSFun $ JSRef_JavaScriptCore cbRef